Datei suchen u. Path dann in die Registry schreiben

[MathiasSimmack]

Also ich habe eine Funktion geschrieben, die "Suchen" heißt und so deklariert ist:

Code:

procedure Suchen(const szSearchFile: string);

In dieser ... hm, eigentlich ist´s ja eine: Prozedur stecken die Routinen

• DriveExists
• IsHD
• scanit

als untergeordnete Funktionen/Prozeduren. Ach was soll´s. So sieht sie komplett aus:

Code:

procedure Suchen(const szSearchFile: string);
var
  Found            : boolean;
  iFiles, iFolders : integer;

  function DriveExists(DriveByte: Byte): Boolean;
  begin
    Result := GetLogicalDrives and (1 shl DriveByte) <> 0;
  end;

  function IsHD(DriveByte: Byte): boolean;
  begin
    case GetDriveType(pchar(CHR(DriveByte + BYTE('A')) + ':\')) of
      // Festplatten
      DRIVE_FIXED,
      // gemappte Netzlaufwerke
      DRIVE_REMOTE,
      // CD-ROM-Laufwerke
      DRIVE_CDROM:
        Result := true;
      else
        Result := false;
    end;
  end;

  procedure scanit(orgPath: string);
  var
    path : string;
    res  : integer;
    ds   : TSearchRec;
  begin
    path := GetCurrentDir;
    res  := FindFirst('*.*',faAnyFile,ds);
    while(res = 0) do
      begin
        // Anzeige des aktuellen Dateinamens/Verzeichnisses
        // im Label der Form
        Form1.Label1.Caption := path + '\' + ds.Name;

        // ist der Dateiname mit dem Suchnamen identisch?
        if(ds.Attr and faDirectory = 0) then
          begin
            inc(iFiles);
            if(lowercase(ds.Name) = lowercase(szSearchFile)) then Found := true;
          end
        // Nein, es ist aber ein Unterverzeichnis.
        // Also, rein da, & weitersuchen!
        else if(ds.Attr and faDirectory <> 0) and
          (ds.Name <> '.') and (ds.Name <> '..') then
        begin
          inc(iFolders);
          SetCurrentDir(ds.Name);
          scanit(orgPath);
        end;

        // die Suche ist beendet!
        if(Found) then break;

        res := FindNext(ds);
      end;
    FindClose(ds); Application.ProcessMessages;

    if(path <> orgPath) then ChDir('..');
  end;

var
  i       : integer;
  dwTime  : dword;
begin
  found         := false;
  iFiles        := 0;
  iFolders      := 0;
  Screen.Cursor := crHourglass;

  dwTime        := GetTickCount;

  // da üblicherweise die Buchstaben A & B für Disketten
  // reserviert sind, kann die Schleife bei C beginnen
  // 2 + 65 (ASCII-Code für A) = 67 (ASCII-Code für C)
  for i  := 2 to 25 do
    // Laufwerk muss existieren und dem
    // gewünschten Typ entsprechen
    if(DriveExists(i)) and (IsHD(i)) then
      // es muss möglich sein, auf das Laufwerk
      // zu wechseln
      if(SetCurrentDir(CHR(i + BYTE('A')) + ':\')) then
        begin
          // rekursive Suchfunktion aufrufen
          scanit(CHR(i + BYTE('A')) + ':\');

          // die Suche abbrechen, wenn die Datei
          // gefunden wurde
          if(found) then break;
        end;

  dwTime               := GetTickCount - dwTime;
  Form1.Label2.Caption := inttostr(dwTime) + ' msec';
  Form1.Label3.Caption := inttostr(iFiles) + ' Dateien, ' +
    inttostr(iFolders) + ' Ordner durchsucht';

  Screen.Cursor := crDefault;
  // nichts gefunden, Label leeren
  if(not(found)) then Form1.Label1.Caption := '';
  Form1.Button2.Enabled := found;
end;

Und du rufst bei deinem Suchen-Button nur diese Funktion auf:

Code:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Suchen('Kundendaten.mdb');
end;

Ich habe noch drei Labels. Label1 ist das, wo bei dir dann wohl auch der Name angezeigt werden soll. Die beiden anderen sind nur zur Anzeige der Zeit und der Anzahl der Dateien/Ordner, weil ich halt wissen wollte, wie lange das dauert.