Dateien, Ordner und Laufwerke

Die Volume-ID eines Laufwerks ermitteln

Die Funktion "VolumeID" gibt die Volume-ID, also den Namen einer Partition zurück:


function VolumeID(DriveChar: Char): string;
var
  OldErrorMode      : Integer;
  NotUsed, VolFlags : DWORD;
  Buf               : array [0..MAX_PATH] of Char;
begin
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    GetVolumeInformation(PChar(DriveChar + ':\'), Buf, 
                         sizeof(Buf), nil, NotUsed, VolFlags, 
                         nil, 0);
    Result := Format('[%s]',[Buf]);
  finally
    SetErrorMode(OldErrorMode);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption:=VolumeID('c');
end;

Wie kann man aus einem Delphi-Programm eine Diskette formatieren?

Dieses Beispiel demonstriert das "stille" Formatieren eines Datenträgers. Die Routine ruft das DOS-Programm Format.com auf, darum erscheint kein Windows-Formatier-Dialog, es wird auch kein DOS-Fenster geöffnet. Nach dem Aufruf des Formatierprogramms wartet die Routine, bis das Formatieren beendet ist und prüft schließlich noch, ob die Formatierung erfolgreich war:


function TMainform.Diskette_formatieren(Laufwerk: String): Integer;
var
  Befehl              : String;
  Datei               : TextFile;
  TempDateiName       : Array [0..255] of Char;
  TempVerzeichnis     : Array [0..255] of Char;
  StartupInfo         : TStartupInfo;
  ProcessInfo         : TProcessInformation;
  SektorenProCluster  : Integer;
  BytesProSektor      : Integer;
  FreieCluster        : Integer;
  ClusterInsgesamt    : Integer;
  Temp                : Integer;
begin
  // Datei zum Beantworten der Abfragen von FORMAT.EXE
  // im Temp-Verzeichnis anlegen.
  GetTempPath(255, TempVerzeichnis);
  GetTempFileName(TempVerzeichnis, 'TMP', 0, TempDateiName);

  // Antwort-Datei erzeugen
  AssignFile(Datei, TempDateiName);
  Rewrite(Datei);             // Antwort-Datei erzeugen und öffnen
  Writeln(Datei, #13#10);     // 1. Return ("Diskette einlegen ...")
  Writeln(Datei, #13#10);     // 2. Return (Diskettenbezeichnung)
  Writeln(Datei, 'n'#13#10);  // keine weitere Diskette
  CloseFile(Datei);           // Datei schließen

  // Befehlszeile zum Aufrufen von FORMAT.COM
  // command.com /c  = automatisch nach Beendigung schließen
  // format ...  /u  = unbedingt formatieren
  // format ...  /c  = defekte Sektoren prüfen
  Befehl := 'command.com /c format '+Laufwerk+' /u /c < '+TempDateiName;

  // StartupInfo initialisieren.
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);

  // DOS-Fenster soll nicht angezeigt werden.
  StartupInfo.dwFlags := StartF_UseShowWindow;
  StartupInfo.wShowWindow := SW_Hide;

  // Formatieren
  if CreateProcess(nil, PChar(Befehl), nil, nil,
                   False, 0, nil, 'c:\',
                   StartupInfo,
                   ProcessInfo) then begin
    // Warten bis Format beendet ist.
    WaitForSingleObject(ProcessInfo.hProcess, Infinite);
    CloseHandle(ProcessInfo.hProcess);
  end;

  // Antwort-Datei wieder löschen
  DeleteFile(TempDateiName);

  // War das Formatieren erfolgreich?
  if GetDiskFreeSpace(PChar(Laufwerk), SektorenProCluster,
                      BytesProSektor, FreieCluster, 
                      ClusterInsgesamt) then begin           
    // Anzahl defekter Sektoren berechnen
    Temp := FreieCluster * SektorenProCluster * BytesProSektor;
    Result := (1457664 - Temp) div BytesProSektor;
  end
  else              
    // Diskette nicht eingelegt oder unformatiert
    Result := - 1;
end; {Gerd Kayser}

Ermitteln von kurzen und langen Dateinamen

Mit der Funktion GetShortPathName ermittelt man aus einem langen Windows 95-Dateinamen den kurzen DOS-Dateinamen im Format 8.3:


function ShortFilename(LongName:string):string;
var ShortName : PChar;
begin
  ShortName:=StrAlloc(Max_Path);
  GetShortPathName(PChar(LongName), ShortName, Max_Path);
  Result:=string(ShortName);
  StrDispose(ShortName);
end;

In LongName wird der (lange) Original-Dateinamen als PCHAR-String übergeben, der kurze 8.3-dateiname wird als Wert der Funktion zurückgegeben. MaxLength ist die maximal erlaubte Dateinamensgröße. Der Pfad muß mit übergeben werden und wird auch wieder in Result zurückgegeben.

Zur Ermittlung eines langen Dateinamens aus einem kurzen (bzw. abgekürzten) empfiehlt sich diese Funktion, die auf der FindFirst-Routine basiert:


function GetLongPathName(APath:String):String;
var
  i : Integer;
  h : THandle;
  Data : TWin32FindData;
  IsBackSlash : Boolean;
begin
  APath:=ExpandFileName(APath);
  i:=Pos('\',APath);
  Result:=Copy(APath,1,i);
  Delete(APath,1,i);
  repeat
    i:=Pos('\',APath);
    IsBackSlash:=i>0;
    if Not IsBackSlash then 
      i:=Length(APath)+1;
    h:=FindFirstFile(PChar(Result+Copy(APath,1,i-1)),Data);
    if h<>INVALID_HANDLE_VALUE then begin
      try
        Result:=Result+Data.cFileName;
        if IsBackSlash then 
          Result:=Result+'\';
      finally
        Windows.FindClose(h);
      end;
    end
    else begin
      Result:=Result+APath;
      Exit;
    end;
    Delete(APath,1,i);
  until Length(APath)=0;
end; {Peter Haas}
Diese Routine liefert die langen Namen zu Dateien und Verzeichnissen zurück. Diese sollten dazu existieren.

Wie prüfe ich, ob der User einen gültigen Dateinamen eingegeben hat?

Einfach testen, ob eines der folgenden Zeichen im Dateinamen (hier:Filename) enthalten ist:


const
  {fuer 8.3-Dateinamen im DOS-Format:}
  ShortForbiddenChars : 
    set of char=[';','=','+','<','>','|','"','[',']',' ','\',#39];
  {fuer lange Dateinamen im Win95-Format:}
  LongForbiddenChars : 
    set of char=['<','>','|','"','\'];

procedure TForm1.Edit1Change(Sender: TObject);
var NameValid : boolean;
    Filename  : string;
    i               : word;
begin
  Filename:=Edit1.Text;
  NameValid:=true;
  if CheckBoxLong.Checked then begin
    for i:=1 to length(Filename) do
      if Filename[i] in LongForbiddenChars then
        NameValid:=false;
  end
  else begin
    for i:=1 to length(Filename) do
      if Filename[i] in ShortForbiddenChars then
        NameValid:=false;
  end;
  if not NameValid then
    ShowMessage('Ungültig!');
end;

Wie kürzt man einen Dateipfad ab, daß er eine bestimmte Länge nicht überschreitet?

Ab Delphi 3 gibt es dafür die undokumentierte Funktion "MinimizeName" aus der Unit "FileCtrl":


PathName:=Appication.Exename;
Label1.Caption:=MinimizeName(PathName,       {Der abzukürzende Pfadname}
                             Label1.Canvas,  {Die Referenz-Zeichenfläche}
                             Label1.Width);  {Die maximale Ausgabe-Breite}
Zur Berechnung der maximal erlaubten Buchstabenzahl für den verkürzten Pfadnamen benötigt die Funktion die Zeichenfläche (und damit die für diese Zeichenfläche eingestellte Schriftart), auf der der Text ausgegeben werden soll und die Breite des Ausgaberechtecks.

Die Verkürzung eines Pfadnamens kann dann z.B. so aussehen:
C:\Programme\Borland\Delphi3\Projekte\Demos wird zu
C:\...\Projekte\Demos

Für ältere Delphiversionen kann man meine Komponente TSRLabel von meiner Komponentenseite benutzen.

Wie erstelle ich eine Dateiliste mit den registrierten Icons und Dateibeschreibungen?

Diese Unit demonstriert, wie ein TListView mit den Dateiennamen aus einem beliebigen Verzeichnis, sowie mit den damit assoziierten Icons und Dateibeschreibungen gefüllt wird.

Sie können auch ein komplettes Beispielprojekt (3 kB) mit dieser Unit vom Server laden.

Wie kann man Dateien löschen, kopieren oder verschieben?

1.) Dateien löschen
Dazu gibt es mehere Möglichkeiten:


var Dateiname : string;

{Möglichkeit 1: DeleteFile}
if not DeleteFile(Dateiname) then
  ShowMessage('Datei "'+Dateiname+'" konnte nicht gelöscht werden!');

{Möglichkeit 2: Erase}
var F : File;
begin
AssignFile(F,Dateiname);
{$I-}
Erase(F);
{$I+}
if IOResult<>0 then
  ShowMessage('Datei "'+Dateiname+'" konnte nicht gelöscht werden!');
Die 3. Möglichkeit ist die API-Funktion SHFileOperation, mit dieser können Dateien auch in den Papierkorb verschoben werden. Außerdem kann man die Standard-Windows-Fortschrittanzeige anzeigen. Der Gebrauch von SHFileOperation, sowie SHBrowseForFolder wird in dieser Unit demonstriert.

Sie können auch ein komplettes Beispielprojekt (5 kB) mit dieser Unit vom Server laden.

2.) Dateien kopieren oder verschieben
Auch dazu gibt es mehere Möglichkeiten:


{Möglichkeit 1: CopyFile}
var Quelldatei, Zieldatei : string;

if not CopyFile(PChar(Quelldatei), PChar(Zieldatei), true) then
  ShowMessage('Datei "'+Quelldatei+'" konnte nicht kopiert werden!');

{Möglichkeit 2: Per TFileStream}
FUNCTION QuickCopy ( Quelle, Ziel : STRING ) : BOOLEAN;
VAR
  S, T: TFileStream;
BEGIN
  Result := TRUE;
  S := TFileStream.Create( Quelle, fmOpenRead );
  TRY
    TRY
      T := TFileStream.Create( Ziel, fmOpenWrite OR fmCreate );
    EXCEPT
      Screen.Cursor := crDefault;
      MessageDlg('Fehler beim Erzeugen der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
      Result := FALSE;
    END;
    TRY
      TRY
        T.CopyFrom( S, S.Size ) ;
        if Config.CopyDat then
          FileSetDate( T.Handle, FileGetDate( S.Handle ) )
        else
          FileSetDate( T.Handle, DateTimeToFileDate(Now) );
        { Dateizeit setzen }
      EXCEPT
        Screen.Cursor := crDefault;
        MessageDlg('Fehler beim Kopieren der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
        Result := FALSE
      END;
    FINALLY
      T.Free
    END;
  FINALLY
    S.Free
  END
END; {QuickCopy}
Möchte man eine Datei verschieben, muß man die Quelldatei(en) anschließend noch löschen.

Die 3. Möglichkeit ist die API-Funktion SHFileOperation, mit dieser kann man auch die Standard-Windows-Fortschrittanzeige anzeigen. Der Gebrauch von SHFileOperation, sowie SHBrowseForFolder wird in dieser Unit demonstriert.

Sie können auch ein komplettes Beispielprojekt (5 kB) mit dieser Unit vom Server laden.

Wie kann man das Änderungsdatum von Dateien ermitteln?

Die einfachste Variante heißt FileAge:


var DOSDatum  : integer;
    WinDatum  : TDateTime;
    Dateiname : string;

DOSDatum:=FileAge(Dateiname);
WinDatum:=FileDateToDateTime(DOSDatum);
Eine andere Möglichkeit ist FindFirst:

function Dateidatum(Dateiname:string):TDateTime;
var SR : TSearchRec;
begin
  if FindFirst(Dateiname,faAnyFile,SR)=0 then begin
    Result:=FileDateToDateTime(SR.Time);
    FindClose(SR);
  end;
end;

Verschiedene Funktionen, um nicht nur das Datum der letzten Änderung zu ermitteln oder zu ändern, sondern auch das Erstellungsdatum einer Datei findet man in dieser Datei von Peter Haas.

Wie kann man die Größe von Dateien ermitteln?

Man kann die Datei als File of Byte öffnen und dann die Dateigröße mit der FileSize-Funktion ermitteln, oder man benutzt die FindFirst-Funktion:


Function MyFileSize(Filename:string):integer;
var SR : TSearchRec;
begin
  if FindFirst(Filename, faAnyFile, SR)=0 then begin
    Result:=SR.Size;
    FindClose(SR);
  end
  else
    Result:=-1;
end; {MyFileSize}

Wie kann man alle Dateien eines Ordners mitsamt der Unterverzeichnisse ermitteln?

Diese Funktion liest rekursiv alle Dateinamen eines Ordners und dessen Unterverzeichnisse in eine Stringliste ein und gibt außerdem als Result die Gesamtgröße des Verzeichnisbaumes zurück:


var  VerzListe : TStringList;

function VerzGroesse(Verzeichnis:string):longint;
var SR      : TSearchRec;
    Groesse : longint;
begin
  Groesse:=0;
  if Verzeichnis[length(Verzeichnis)]<>'\' then
    Verzeichnis:=Verzeichnis+'\';
  if FindFirst(Verzeichnis+'*.*',$3F,SR)=0 then begin
    repeat
      if ((SR.Attr and faDirectory)>0) and (SR.Name<>'.') and (SR.Name<>'..') then
        Groesse:=Groesse+VerzGroesse(Verzeichnis+SR.Name)
      else
        Groesse:=Groesse+SR.Size;
      if (SR.Name<>'.') and (SR.Name<>'..') then
        VerzListe.Add(Verzeichnis+SR.Name);
    until FindNext(SR)<>0;
    FindClose(SR);
  end;
  Result:=Groesse;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  VerzListe:=TStringList.Create;
  Label1.Caption:=IntToStr(VerzGroesse('C:\Programme'))+' Byte';
  ListBox1.Items.Assign(VerzListe);
  VerzListe.Free;
end;

Wie man einen Verzeichnisbaum in ein TTreeView einliest

Die Funktion "Verzeichnisse_Einlesen" liest rekursiv alle Ordner eines Verzeichnisbaumes und optional auch alle Dateien als Baumstruktur in ein TTreeView ein:


{Aufrufbeispiel:}
  TreeView1.Items.Clear;
  Verzeichnisse_Einlesen(TreeView1,'C:\',nil,false);

procedure Verzeichnisse_Einlesen(Tree : TTreeView; 
                                 Verzeichnis : String;
                                 Eintrag : TTreeNode; 
                                 Mit_Dateien : Boolean);

Var SearchRec   : TSearchRec;
    EintragTemp : TTreeNode;

begin
  Tree.Items.BeginUpdate;
  if Verzeichnis[length(Verzeichnis)]<>'\' then 
    Verzeichnis:=Verzeichnis+'\';
  if FindFirst(Verzeichnis+ '*.*', faDirectory, SearchRec)=0 then begin
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) 
       and (SearchRec.Name[1] <> '.') then begin
 
        //Eintrag ist ein Verzeichnis
        if (SearchRec.Attr and faDirectory > 0) then
          //zum aktuellen Eintrag hinzufügen
          Eintrag := Tree.Items.AddChild(Eintrag, SearchRec.Name);

        //Eintrag merken
        EintragTemp := Eintrag.Parent;

        //auf Untereinträge prüfen
        Verzeichnisse_Einlesen(Tree, 
                               Verzeichnis + SearchRec.Name, 
                               Eintrag,
                               Mit_Dateien);

        //Eintrag wiederholen
        Eintrag := EintragTemp;
      end
      else
        //Eintrag ist eine Datei
        if Mit_Dateien then
          if SearchRec.Name[1] <> '.' then
            Tree.Items.AddChild(Eintrag, SearchRec.Name);
    until FindNext(SearchRec)<>0;
    FindClose(SearchRec);
  end;
  Tree.Items.EndUpdate;
end; {Michael Geisler}

Wie kann man Dateien in einem Verzeichnisbaum suchen?

Diese Unit zeigt, wie man rekursiv eine bestimmte Datei in einem Verzeichnisbaum sucht. Die Funktion der rekursiven Suche in der Unit demonstriert dieses Beispielprojekt.

Wie löscht man nur bestimmte Dateien in allen Unterverzeichnissen?

Die Prozedur "DeleteFiles" löscht alle Dateien, deren Name einer vorgegebenen Maske entspricht, in einem bestimmten Verzeichnis und optional in allen daran anhängenden Unterverzeichnissen:


procedure DeleteFiles(const Path, Mask: string; SubDirectories: Boolean);
var
  Result: integer;
  SR: TSearchRec;
begin
  if FindFirst(Path + Mask, faAnyFile - faDirectory, SR) = 0 then begin
    repeat
      if not SysUtils.DeleteFile (Path + SR.Name) then begin
        FileSetAttr(Path + SR.Name, 0); {Alle Dateiattribute löschen}
        SysUtils.DeleteFile(Path + SR.Name);
      end;
    until FindNext(SR) <> 0;
    SysUtils.FindClose(SR);
  end;
  { Rekursiv durch alle Unterverzeichnisse }
  if SubDirectories then begin
    if SysUtils.FindFirst(Path + '*.*', faDirectory, SR) then begin
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') then begin
          FileSetAttr(Path + SR.Name, faDirectory);
          DeleteFiles(Path + SR.Name + '\', Mask, true);
          RmDir(Path + SR.Name); {Leeres Verzsichnis löschen}
        end;
      until FindNext(SR) <> 0;
      SysUtils.FindClose(SR);
    end;
  end;
end; {Angepasst für Win NT von Marco Klemm}
Und so löscht man z.B. alle Dateien mit der Endung ".txt" im Verzeichnis "C:\Temp" und allen Unterverzeichnissen von "C:\Temp":

DeleteFiles ('C:\Temp\', '*.txt', true);

Wie stelle ich fest, ob ein bestimmter Laufwerkstyp (z.B. CD-ROM) vorhanden ist?

Diese Funktion erstellt eine Stringliste mit allen Laufwerksbuchstaben eines bestimmten Typs und gibt als Result die Anzahl der vorhandenen Laufwerke zurück:


var DriveList : TStringList;
    LWCount   : byte;

function GetDrives(DriveType:integer):byte;
var Drives  : array [1..255] of char;
    LWListe : TStringList;
    i         : byte;
    Len     : DWord;
begin
  LWListe:=TStringList.Create;
  {Alle Laufwerke ermitteln}
  Len:=GetLogicalDriveStrings(255,@Drives);
  for i:=1 to Len-2 do
    if (i mod 4)=1 then
      LWListe.Add(copy(Drives,i,3));
  {Laufwerke des angegebenen Typs zählen}
  Result:=0;
  DriveList.Clear;
  for i:=0 to LWListe.Count-1 do begin
    if GetDriveType(PChar(LWListe[i]))=DriveType then begin
      Result:=Result+1;
      DriveList.Add(copy(LWListe[i],1,2))
    end;
  end;
  LWListe.Destroy;
end;

DriveList:=TStringLIst.Create;
{Wechselplatten:}
LWCount:=GetDrives(DRIVE_REMOVABLE);
{Festplatten:}
LWCount:=GetDrives(DRIVE_FIXED);
{Netzlaufwerke:}
LWCount:=GetDrives(DRIVE_REMOTE);
{CD-ROM:}
LWCount:=GetDrives(DRIVE_CDROM);
{RAM-Disks:}
LWCount:=GetDrives(DRIVE_RAMDISK);

{..Mach' was mit der DriveList..}
DriveList.Free;

Wie stelle ich fest, ob eine Diskette im Laufwerk steckt?

Die Funktion "DiskSize" gibt als Größe -1 zurück, wenn kein Datenträger vorhanden ist. Um keine System-Fehlermeldung zu erhalten, benutzt man die API-Funktion "SetErrorMode":


procedure TForm1.Button1Click(Sender: TObject);
var
  ErrorMode: word;
begin
  {Meldung eines kritischen Systemfehlers vehindern}
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    if DiskSize(1) = -1 then
      ShowMessage('Drive not ready');
  finally
    {ErrorMode auf den alten Wert setzen}
    SetErrorMode(ErrorMode);
  end;
end;

Wie ermittelt man das mit einem Dateitypen verknüpfte Programm?

Die Funktion GetExeForExtension funktioniert sowohl unter Win3.x, als auch unter Win9x. Sie findet das mit einem Dateitypen verknüpfte Programm, indem man ihr die Dateiendung übergibt. Unter Win9x wird das Programm aus der Registry ausgelesen, unter Win3.x aus der Systemdatei Win.ini.


uses
{$IFDEF WIN32}
  Registry; {Unter Win9x benutzen wir die Registry}
{$ELSE}
  IniFiles; {Unter Win3.x benutzen wir die Datei win.ini}
  const MAX_PATH = 144;
{$ENDIF}

function GetExeForExtension(Ext:string):string;
var
{$IFDEF WIN32}
  reg            : TRegistry;
  s              : string;
{$ELSE}
  WinIni         : TIniFile;
  WinIniFileName : array[0..MAX_PATH] of char;
  s              : string;
{$ENDIF}
begin
{$IFDEF WIN32}
  s:='';
  reg:=TRegistry.Create;
  reg.RootKey:=HKEY_CLASSES_ROOT;
  if reg.OpenKey('.'+ext+'\shell\open\command', false) then
   begin
    {The open command has been found}
    s:=reg.ReadString('');
    reg.CloseKey;
  end
  else begin
    {perhaps there is a system file pointer}
    if reg.OpenKey('.'+ext, false) then begin
      s:=reg.ReadString('');
      reg.CloseKey;
      if s<>'' then begin
        {A system file pointer was found}
        if reg.OpenKey(s+'\shell\open\command', false) then
          {The open command has been found}
          s:=reg.ReadString('');
        reg.CloseKey;
      end;
    end;
  end;
  {Delete any command line, quotes and spaces}
  if Pos('%', s)>0 then
    Delete(s, Pos('%', s), length(s));
  if ((length(s)>0) and (s[1]='"')) then
    Delete(s, 1, 1);
  if ((length(s)>0) and (s[length(s)]='"')) then
    Delete(s, Length(s), 1);
  while ((length(s)>0) and
   ((s[length(s)]=#32) or (s[length(s)] = '"'))) do
    Delete(s, Length(s), 1);
{$ELSE}
  GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
  StrCat(WinIniFileName, '\win.ini');
  WinIni:=TIniFile.Create(WinIniFileName);
  s:=WinIni.ReadString('Extensions', ext, '');
  WinIni.Free;
  {Delete any command line}
  if Pos(' ^', s)>0 then
    Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
  Result:=s;
end; {Johannes..}
Um z.B. das mit GIF-Dateien verknüpfte Programm zu ermitteln, übergibt man der Routine die Dateiendung "gif":

ShowMessage(GetAssociatedProgram('gif'));
Um das mit einer existierenden Datei verknüpfte Programm zu ermitteln, kann man sich der API-Funkiton FindExecutable bedienen:

function GetExeForFile(const FileName: String): String;
var x: Integer;
begin
  SetLength(Result, MAX_PATH);
  if FindExecutable(PChar(FileName), nil, PChar(Result))>=32
  then SetLength(Result, StrLen(PChar(Result)))
  else Result:=inttostr(x);
end; {Michael Winter}

Wie verknüpft man ein eigenes Programm mit einem bestimmten Dateitypen?

Ich habe ein Delphi-Programm, daß für bestimmte Dateien zuständig sein soll (*.xyz). Wie bringe ich jetzt Windows am einfachsten bei, daß bei einem Doppelklick automatisch mein Programm aufgerufen werden soll ?

Diese Funktion RegistriereAnwendung für 32Bit-Windows von Edmund Matzke nimmt alle erforderlichen Einträge in der Windows-Registrierdatenbank vor.


uses Registry;

function RegistriereAnwendung(extension, 
                              typename, 
                              commandKey, 
                              command: PChar): boolean;
var key: HKey;
begin
  Result := false;
  if RegCreateKey(HKEY_CLASSES_ROOT, extension, key) = ERROR_SUCCESS then begin
    if RegSetValue(key, nil, REG_SZ, typename, 0) = ERROR_SUCCESS then begin
      RegCloseKey(key);
      if RegCreateKey(HKEY_CLASSES_ROOT, commandKey, key) = ERROR_SUCCESS then begin
        if RegSetValue(key, nil, REG_SZ, command, 0) = ERROR_SUCCESS then begin
          RegCloseKey(key);
          Result := true; // hat geklappt
        end
        else begin
          RegCloseKey(key);
          RegDeleteKey(HKEY_CLASSES_ROOT, extension);
        end;
      end 
      else
        RegDeleteKey(HKEY_CLASSES_ROOT, extension);
    end 
    else begin
      RegCloseKey(key);
      RegDeleteKey(HKEY_CLASSES_ROOT, extension);
    end;
  end;
end; {Edmund Matzke}
Und hier das ganze noch für 16Bit-Windows, da gehören die Einträge in die Datei "Win.ini":

uses IniFiles;

function RegistriereAnwendung(extension,
                              command: string): boolean;
var
  WinIni         : TIniFile;
  WinIniFileName : array[0..MAX_PATH] of char;
  s              : array[0..64] of char;
begin
  GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
  StrCat(WinIniFileName, '\win.ini');
  try
    WinIni := TIniFile.Create(WinIniFileName);
    WinIni.WriteString('Extensions',
                       extension,
                       command+' ^.'+extension);
    WinIni.Free;
    Result:=true;
    StrCopy(S, 'Extensions');
    SendMessage(HWND_BROADCAST, WM_WININICHANGE,
                0, LongInt(@S));
  except
    Result:=false;
  end;
end;
Und so ruft man die Funktionen auf:

{Win32:}
RegistriereAnwendung('.xyz', 'MeinProggy',
                     'MeinProggy\DefaultIcon', PChar(Application.ExeName + ',0'));

{Win16:}
RegistriereAnwendung('.xyz', Application.ExeName);

Um ein Programm bei einem Doppelklick auf eine verknüpfte Datei zu starten und die Datei im Programm zu öffnen, benutzt man z.B. im OnCreate-Ereignis des Programm-Hauptformulars die Funktionen ParamCount und ParamString:


procedure TMainForm.FormCreate(Sender: TObject);
begin
  if ParamCount>0 then
    Datei_laden(ParamStr(1)); // Den Code zum Laden der Daten ausführen
end;

Falls eine laufende Instanz eines Programms eine verknüpfte Datei öffnen soll, muß das Programm auf eine Message reagieren:


type
  TMainForm = class(TForm)
  Private
    procedure NeedFileOpen(var Msg: tMessage); Message wmMainInstanceOpenFile;

[..]

procedure TMainForm.NeedFileOpen(var Msg: tMessage);
var Path : string;
    PC   : array[0..MAX_PATH] of Char;
begin
  GlobalGetAtomName(Msg.wParam, PC, MAX_PATH);
  Path := Trim(StrPas(PC));
  Datei_laden(Path); // Den Code zum Laden der Daten ausführen
end;

Dieser Aufstand ist nötig, falls dein Programm das Starten mehrerer Instanzen verhindert. Sollte das Programm bereits laufen, kann es nachträglich die Daten laden.

Wie kann ich die Versionsnummer einer Datei (z.B. einer DLL) auslesen?

Benutze die API-Funktion "GetFileVersionInfo":


function GetBuildInfo(const AFilename:String; var V1,V2,V3,V4:Word):Boolean;
var
   VerInfoSize  : Integer;
   VerValueSize : DWord;
   Dummy        : DWord;
   VerInfo      : Pointer;
   VerValue     : PVSFixedFileInfo;
begin
  VerInfoSize:=GetFileVersionInfoSize(PChar(AFilename),Dummy);
  Result:=False;
  if VerInfoSize<>0 then begin
    GetMem(VerInfo,VerInfoSize);
    try
      if GetFileVersionInfo(PChar(AFilename),0,VerInfoSize,VerInfo) then begin
        if VerQueryValue(VerInfo,'\',Pointer(VerValue),VerValueSize) then
         with VerValue^ do begin
          V1:=dwFileVersionMS shr 16;
          V2:=dwFileVersionMS and $FFFF;
          V3:=dwFileVersionLS shr 16;
          V4:=dwFileVersionLS and $FFFF;
        end;
        Result:=True;
      end;
    finally
      FreeMem(VerInfo,VerInfoSize);
    end;
  end;
end; {Peter Haas}
Peter Haas bietet auf seiner Homepage auch ein erweitertes Demo zum Download an.

Fortgeschrittene Anwendung der SHBrowseForFolder-API-Funktion

Mit der API-Funktion "SHBrowseForFolder" kann man sich einen Dialog zur Verzeichnisauswahl anzeigen lassen. Ein Anwendungsbeispiel findet man in der Demo-Unit zur SHFileOperation-Funktion. Thorsten Vitt erklärt auf seiner Delphi-Tips-Seite, wie man ein Root-Verzeichnis bestimmen und bei der Anzeige des Dialogs einen Ordner vorwählen kann.

Auf der Grundlage seines Artikels habe ich ein Beispiel-Projekt erstellt, welches die in Thorstens Artikel beschriebenen Funktionen demonstriert. Das Projekt benötigt eine installierte RxLibrary, weil ich ausnahmsweise mal andere, als die Delphi-Standard-Komponenten verwendet habe. Man kann aber auch einfach diese Unit des Beispiel-Projekts in ein eigenes Projekt einbinden.

Erzeugen von Programmgruppen und Verknüpfungen

- DDE mit dem Programm-Manager in Win 3.x

In Windows 3.x erzsugt man Programmgruppen und Verknüpfunden per DDE-Konversation mit dem Progrmm-Manager. Dazu kann man einfach eine DDEClient-Komponente (System, DdeClientItem) auf das Formular setzen. Mit dieser baut man dann die DDE-Verbindung zum Programm-Manager auf, um eine Programmgruppe und eine Verlknüpfung zu erstellen:


Var Macro : String;
      Cmd: array[0..255] of Char;
      NewPrg,Desc : String;
Begin    { Create the group, does nothing if it existst }
  Name := 'StartUp';
  Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10;
  StrPCopy (Cmd, Macro);
  DDEClient.OpenLink;
  if not DDEClient.ExecuteMacro(Cmd, False) then
    MessageDlg(<ErrorMsg>, mtInformation, [mbOK], 0);
  { Then you add you program }
  NewPrg := 'C:\HELLO.EXE';    {Full path of the program you}
  Desc := 'Say Hello';   {Description that appears under the icon}
  Macro := '[AddItem('+NewPrg+','+Desc+')]'+ #13#10;
  StrPCopy (Cmd, Macro);
  if not f1_.DDEClient.ExecuteMacro(Cmd, False) then
    MessageDlg(<errorMsg>,mtInformation, [mbOK], 0); 
    { To make sure the group is saved }
  StrPCopy (Cmd,'[ShowGroup(nonexist,1)]');
  DDEClient.ExecuteMacro(Cmd, False);
   { Now... this part doesn't work and I don't know why }
   { Anybody who knows why is welcome }
  StrPCopy (Cmd,'[reload()]');
  DDEClient.ExecuteMacro(Cmd, False);
  { and close the link }
  DDEClient.CloseLink;
End;
Das "DeleteGroup"-Kommando weist den Program Manager an, eine existierende Gruppe zu löschen. Die Syntax für das "DeleteGroup"-Kommando sieht so aus:

DeleteGroup(GroupName)
Das "DeleteItem"-Kommando weist den Program Manager an, eine existierende Verknüpfung aus der aktuellen Gruppe zu löschen. Die Syntax für das "DeleteItem"-Kommando sieht so aus:

DeleteItem(ItemName)
Hier ist noch eine Prozedur, die eine Liste aller existiernden Gruppen vom Programm Manager abfragt. Diese Prozedur benutzt dazu die DDEClientConv-Komponente:

{This example needs a listbox called AllGroups}

procedure GetGroups(Sender: TObject);
var Thedata: pchar;  {pchar that holds the groups}
    dat: char;      {used to process each group}
    charcount: word;
    Theitem,theline: string;
begin {get allgroups items}
  charcount:=0;
  TheData:= DDEClientConv2.RequestData('Groups');
  theline:='';
  repeat
    application.processmessages;
    dat:=Thedata[charcount]; {get character from the Thedata}
    if (dat=chr(10)) {or (dat=chr(13))} then begin
      while Pos(char(10), Theline) > 0 do
        delete(Theline,pos(char(10),Theline),1);
      while Pos(char(13), Theline) > 0 do
        delete(Theline,pos(char(13),Theline),1);
      If theline='' then 
        continue;
      allgroups.items.add(theline); {Allgroups is a LISTBOX}
      theline:='';
    end;
    Theline:=theline+dat;
    inc(charcount);
  until charcount >= strlen(Thedata);
  strdispose(Thedata);
end;

Win32-API-Funktionen

Eine Textdatei mit den Win32-API-Funktionen zur Erstellung von Verknüpfungen (Shortcuts) und Programmgruppen kann hier geladen werden. Eine Delphi-Klasse zum Herumspielen mit Shell-Links findet man auf der Homepage von Thorsten Vitt.

Wie kann man aus einer *.lnk die Informationen zur eigentlichen Datei entnehmen?

Du mußt die Units ComObj, ActiveX und ShlObj einbinden. Dann kann man über die IShellLink-Schnittstelle die Informationen zum Linkfile abfragen. Diese Funktion liefert z.B. den Namen der EXE-Datei, auf die die Verknüpfung verweist:


function GetExeFromLink(LinkFile:string):string;
var
  IU         : IUnknown;
  SL         : IShellLink;
  PF         : IPersistFile;
  FindDate   : TWin32FindData;
  TargetFile : array[0..MAX_PATH] of char;
begin
  { Herstellen des IShellLink und IPersistFile zum Zugriff auf
    die .LNK Datei. }
  IU := CreateComObject(CLSID_ShellLink);
  SL := IU as IShellLink;
  PF := SL as IPersistFile;
  { .LNK Datei in IPersistFile Objekt laden. }
  PF.Load(PWideChar(LinkFile), STGM_READ);
  { Den Link durch Aufruf der Resolve-Methode auflösen }
  SL.Resolve(0, SLR_ANY_MATCH or SLR_NO_UI);
  { Jetzt kommt man an die Infos }
  SL.GetPath(TargetFile, MAX_PATH, FindDate, SLGP_UNCPRIORITY);
  { Zieldatei ausgeben }
  Result:=string(TargetFile);
end; {Oliver Stoer}

Wenn es nur um den Namen der verknüpften EXE-Datei geht, kann man diesen auch einfacher mit FindExecutable ermitteln:


function GetExeFromLink(LinkFile:string):string;
var
  FDir,
  FName,
  ExeName : PChar;
  z       : integer;
begin
  {Speicher für die PChar-Variablen allozieren}
  ExeName:=StrAlloc(255);
  FName:=StrAlloc(255);
  FDir:=StrAlloc(255);

  StrPCopy(FName, ExtractFileName(FileName));
  StrPCopy(FDir, ExtractFilePath(FileName));
  z:=FindExecutable(FName, FDir, ExeName);
  if z>32 then
    Result:=StrPas(ExeName)
  else
    Result:='';

  {Speicher der PChar-Variablen freigeben}
  StrDispose(FDir);
  StrDispose(FName);
  StrDispose(ExeName);
end; {Michael Hanel}

Wie kann man den Eigenschaften-Dialog des Windows-Explorers für Dateien anzeigen?

Dazu benutzt man die "TShellExecuteInfo"-Datenstruktur der API-Funktion "ShellExecuteEx":


function ShowProperties(hWndOwner: HWND; const FileName: string;
                        Registerkarte: PChar): Boolean;
var Info: TShellExecuteInfo;
begin
  { Fill in the SHELLEXECUTEINFO structure }
  with Info do begin
    cbSize := SizeOf(Info);
    fMask := SEE_MASK_NOCLOSEPROCESS or
             SEE_MASK_INVOKEIDLIST or
             SEE_MASK_FLAG_NO_UI;
    wnd  := hWndOwner;
    lpVerb := 'properties';
    lpFile := pChar(FileName);
    lpParameters := registerkarte;
    lpDirectory := nil;
    nShow := 0;
    hInstApp := 0;
    lpIDList := nil;
  end;

  { Call Windows to display the properties dialog. }
  Result := ShellExecuteEx(@Info);
end; {Frank Wunderlich}

Der Aufruf der Funktion sieht dann so aus:

ShowProperties(HInstance, PCHAR(Dateiname), 'Freigabe'); 'Freigabe' steht für die Caption der Registerseite, Dateiname ist der Name der Datei mit komplettem Pfad.

Wie kann man die Schublade eines Ein CD-Laufwerks öffnen und schließen?

Dazu benutzt man die "MCISendString"-Funktion aus der Unit "MMSystem":


uses MMSystem;

// Schublade öffnen:
procedure TMainForm.MItemCDEjectClick(Sender: TObject);
var Befehl  : string;
    ErrCode : integer;
    ErrStr  : array [0..255] of char;
begin
  Befehl := 'open '+Config.Laufwerk+' type cdaudio alias geraet';
  MCISendString(PChar(Befehl), nil, 0, 0);
  ErrCode:=MCISendString('set geraet door open wait', nil, 0, 0);
  MCISendString('close geraet', nil, 0, 0);
  if ErrCode <> 0 then begin
    MCIGetErrorString(ErrCode, ErrStr, 255);
    StatusBar.Panels[1].Text:=ErrStr;
  end;
end;

// Schublade schließen:
procedure TMainForm.MItemCDCloseClick(Sender: TObject);
var Befehl  : string;
    ErrCode : integer;
    ErrStr  : array [0..255] of char;
begin
  Befehl := 'open '+Config.Laufwerk+' type cdaudio alias geraet';
  MCISendString(PChar(Befehl), nil, 0, 0);
  ErrCode:=MCISendString('set geraet door closed wait',nil, 0, 0);
  MCISendString('close geraet', nil, 0, 0);
  if ErrCode <> 0 then begin
    MCIGetErrorString(ErrCode, ErrStr, 255);
    StatusBar.Panels[1].Text:=ErrStr;
  end;
end;