AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Alle Laufwerke schnell durchsuchen!

Ein Thema von Douglas Quintaine · begonnen am 21. Jun 2009 · letzter Beitrag vom 21. Jun 2009
Antwort Antwort
Douglas Quintaine
(Gast)

n/a Beiträge
 
#1

Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:30
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;
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#2

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:42
Es wäre hilfreich zu wissen, an welcher der beiden Funktionen es liegt

Mach mal in der Like-Funktion nach dem Resutl := false am Anfang direkt ein exit rein. Dann solltest du zwar keiune Liste bekommen, aber wenn es nur marginal schneller wird, dürfte es an der anderen Funkjtion liegen.
  Mit Zitat antworten Zitat
Douglas Quintaine
(Gast)

n/a Beiträge
 
#3

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:45
Durch das Exit; isser nach 10 Sekunden fertig und hat logischerweise nichts gefunden...
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.017 Beiträge
 
Delphi 12 Athens
 
#4

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:46
Die Größe des Laufwerks ist ja vollkommen egal ... wieviele Dateien und Verzeichnisse befinden sich den auf dem Laufwerk?


[add]
Zitat von Douglas Quintaine:
Durch das Exit; isser nach 10 Sekunden fertig und hat logischerweise nichts gefunden...
dann liegt es wohl am Like
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Douglas Quintaine
(Gast)

n/a Beiträge
 
#5

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:48
Bei mir um die 300k Dateien und 10k Ordner. Das Programm soll aber auf anderen PCs die noch mehr vollgemüllt sind trotzdem irgendwie schnell Suchergebnisse aufdecken.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.017 Beiträge
 
Delphi 12 Athens
 
#6

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 17:59
Wieviele Dateien gibt es zu finden?

Wenn es etwas mehr sind, dann würde ich die Fundergebnise sofort auswerten
und nicht erst alle suchen und in einer Liste zwischenspeichern.


'ne einfache Suche mit MSDN-Library durchsuchenFindFirstFile hat hier grad 80.000 Objekte in knapp 5 Sekunden durchsucht.
schneller ginge es nur, wenn man z.B. die MFT direkt ausließe.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Satty67

Registriert seit: 24. Feb 2007
Ort: Baden
1.566 Beiträge
 
Delphi 2007 Professional
 
#7

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 18:00
Wenn nur eine bestimmte Datei gesucht wird, warum die Suchmaske von FindFirst/FindNext nicht gleich richtig initialisieren und Like ganz weglassen? Denkfehler... ohne Like (Einzelprüfung) geht rekusive Suche nicht, da für SubDirs ja alle Ordner gelistet werden müssen.

Laufwerke, dessen FAT nicht im Cache ist, brauchen beim ersten durchsuchen aber immer etwas länger.

Für jedes Laufwerk, das durchsucht werden soll aufrufen.
Delphi-Quellcode:
procedure FindFiles(const StartDir, Filter : String; SubDirs : Boolean; ResultList : TStringList);
var
  SR : TSearchrec;
  Found : Integer;
  Dir : String;
begin
  Dir := IncludeTrailingPathDelimiter(StartDir);
  Found := FindFirst(Dir + '*.*', faAnyFile, SR);
  while Found = 0 do begin
    if SubDirs
    and (SR.Attr and faDirectory = faDirectory)
    and (SR.Name[1] <> '.') then
      FindFiles(Dir + SR.Name, Filter, SubDirs, ResultList);

    if Like(SR.Name, Filter) then
      ResultList.Add(Dir + SR.Name);

    Found := FindNext(SR);
  end;
  FindClose(SR);
end;
  Mit Zitat antworten Zitat
Douglas Quintaine
(Gast)

n/a Beiträge
 
#8

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 18:36
Ah ok, danke. Das muss ich mir mal genauer ansehen.

Grundsätzlich sollen alle vorhandenen Laufwerke durchsucht werden. Daher tue ich mich schwer diese zu finden. Spontane Idee war ja:
Delphi-Quellcode:
for i := 65 to 90 do
    if DirectoryExists(chr(i)+':') then FindAllFiles(tclient, chr(i)+':', 'xxx.dll', true, false);
Also alles von A:-Z: durchgehen. Problem dabei: Bei Wechseldatenträgern wie Kartenlesern wirft er mir generell eine Exception. Selbst wenn ich versuche diese mit try...except abzufangen. Selbst wenn ich das Programm außerhalb der IDE starte, wirft er mir diese Exceptions. :-/

Zitat:
---------------------------
Windows - Kein Datenträger
---------------------------
Exception Processing Message c0000013 Parameters 75b0bf9c 4 75b0bf9c 75b0bf9c
---------------------------
Abbrechen Wiederholen Weiter
---------------------------
  Mit Zitat antworten Zitat
Satty67

Registriert seit: 24. Feb 2007
Ort: Baden
1.566 Beiträge
 
Delphi 2007 Professional
 
#9

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 18:46
Oben hab ich einen bösen Denkfehler drin, das funktioniert so nicht! Mal sehen wer es zuerst merkt...

Drives bekommt man evtl. so:
Delphi-Quellcode:
type
  TDriveTypes = set of (dtUnknown, dtNoRoot, dtRemovable,
                        dtFixed, dtRemote, dtCDROM, dtRamdisk);

function GetDriveList(IncludeTypes : TDriveTypes): String;
var
  c : Char;
begin
  for c := 'Ato 'Zdo begin
    case GetDriveType(PChar(c+':\')) of
      DRIVE_NO_ROOT_DIR : if dtNoRoot in IncludeTypes then Result := Result + c;
      DRIVE_REMOVABLE : if dtRemovable in IncludeTypes then Result := Result + c;
      DRIVE_FIXED : if dtFixed in IncludeTypes then Result := Result + c;
      DRIVE_REMOTE : if dtRemote in IncludeTypes then Result := Result + c;
      DRIVE_CDROM : if dtCDROM in IncludeTypes then Result := Result + c;
      DRIVE_RAMDISK : if dtRamdisk in IncludeTypes then Result := Result + c;
    else
      // DRIVE_UNKNOWN
      if dtUnknown in IncludeTypes then Result := Result + c;
    end;
  end;
end;
€: meine Funktion oben geändert, da rekursive Suche ja kein gefiltertes Suchergebnis gebrauchen kann (findet sonst Unterordner nicht)

€2: Mein System hab' ich mal nach "readme.*" durchsucht. Total 1,25 Mio Dateien... beim ersten mal 2-3 Minuten, danach immer 5-10 Sekunden.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.017 Beiträge
 
Delphi 12 Athens
 
#10

Re: Alle Laufwerke schnell durchsuchen!

  Alt 21. Jun 2009, 18:55
wenn es dir nur um die Laufwerke mit einem Laufwerksbuchstaben geht > MSDN-Library durchsuchenGetLogicalDriveStrings
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:53 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz