Alle Laufwerke schnell durchsuchen!

[Douglas Quintaine]

Moin,

folgendes Problem: Ich muss alle Laufwerke / Partitionen nach einer bestimmten Datei durchsuchen und - sollten Dateien gefunden werden - diese auflisten. Aktuell hab ich hier einen sehr unvorteilhaften Code mit zwei Problemen:

• es wird stets nur ein Laufwerk durchsucht, also z.B. C:\. Man können jetzt alle Laufwerke von A-Z durchgehen und suchen, aber wirklich effektiv sollte das nicht sein, oder? Ich fand leider keine Möglichkeit die verfügbaren Laufwerke aufzulisten.
• Das Hauptproblem: Mein aktueller Weg ist sehr langsam. Bei einer 80GB Partition dauert die Suche im Kaltstart um die 2 Minuten.

Kennt jemand bessere Wege und Möglichkeiten diese Suche zu realisieren? Besten Dank!

Delphi-Quellcode:

function Like(const AString, APattern: String): Boolean;
var
  StringPtr, PatternPtr: PChar;
  StringRes, PatternRes: PChar;
begin
  Result:=false;
  StringPtr:=PChar(AString);
  PatternPtr:=PChar(APattern);
  StringRes:=nil;
  PatternRes:=nil;
  repeat
    repeat // ohne vorangegangenes "*"
      case PatternPtr^ of
        #0: begin
          Result:=StringPtr^=#0;
          if Result or (StringRes=nil) or (PatternRes=nil) then
            Exit;
          StringPtr:=StringRes;
          PatternPtr:=PatternRes;
          Break;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
          Break;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          if StringPtr^=#0 then
            Exit;
          if StringPtr^<>PatternPtr^ then begin
            if (StringRes=nil) or (PatternRes=nil) then
              Exit;
            StringPtr:=StringRes;
            PatternPtr:=PatternRes;
            Break;
          end
          else begin
            inc(StringPtr);
            inc(PatternPtr);
          end;
        end;
      end;
    until false;
    repeat // mit vorangegangenem "*"
      case PatternPtr^ of
        #0: begin
          Result:=true;
          Exit;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          repeat
            if StringPtr^=#0 then
              Exit;
            if StringPtr^=PatternPtr^ then
              Break;
            inc(StringPtr);
          until false;
          inc(StringPtr);
          StringRes:=StringPtr;
          inc(PatternPtr);
          Break;
        end;
      end;
    until false;
  until false;
end;

procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  procedure LFindAllFiles(AParentFolder: String);
  var LSearchRec: TSearchRec;
  begin
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
               (IgnoreMaskAtFolderNames or Like(AnsiLowerCase(LSearchRec.Name), Mask)) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(AnsiLowerCase(LSearchRec.Name), Mask) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;

//Suchaufruf
procedure Tfrm1.Button5Click(Sender: TObject);
var
  tclient: TStrings;
begin
  tclient := TStringList.Create;
  FindAllFiles(tclient, 'C:', 'bugsbunny.dll', true, false);
  tclientbox.Items := tclient;
  tclient.Free;
end;