Entwickler-Ecke :: Thema anzeigen - Datei Suche Optimieren

starsurfer - Mo 29.05.06 14:30
Titel: Datei Suche Optimieren

Moin DF´ler,

hier: http://www.delphi-forum.de/viewtopic.php?t=60660 hat user profile icon

BenBE gesagt :

Zitat:

Da lässt sich übrigens einiges rausholen, wenn man weiß, wo man ansetzen kann.

leider weis ich nicht wo :oops: (bzw. das Wissen fehlt:z.B. ka wie ich den dyn. Array ersetzen soll)

Mein akt. Algo braucht für ca 110000 Dateien:
Reine Suche: 2 min 20 sec
Suche+Speichern/Laden der Werte: 4 min

Eine Analyse der Daten ist nocht nicht dabei, d.h. später wirds noch länger dauern also wärs nicht schlecht wenn man die Zeit jetzt schon verkürzen könnte.

Akt Code:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:

type
  TFiles = array of record
   path:string;
   size:integer;
   end;

function IsHardDisk(root:char):boolean;
var szDrive : array[0..5] of Char;
begin
result:=false;
FillChar(szDrive, SizeOf(szDrive), #0);
StrPCopy(szDrive, root);
StrCat(szDrive, ':\');
if GetDriveType(@szDrive)=DRIVE_FIXED then result:=true;
end;

function SearchFiles(Mask:string;AllFolders:boolean):TFiles;
var c:char;
    index:integer;
procedure search(const searchpath:string);
var SR: TSearchRec;
begin
  if FindFirst(searchpath + Mask, faAnyFile - faDirectory, SR) = 0 then
  try
    repeat
      if index>high(result) then
         begin
         setlength(result,length(result)+10000);
         end;
      result[index].path:=searchpath + SR.Name;
      result[index].size:=sr.Size;
      inc(index);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;

  if AllFolders=true then begin
    if FindFirst(searchpath + '*.*', faAnyFile, SR) = 0 then
    try
      repeat
        if ((SR.attr and faDirectory) = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
          search(searchpath + SR.Name + '\');
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;

end;

begin
try
index:=0;
setlength(result,0);
for c:='A' to 'Z' do
    begin
    if IsHardDisk(c)=true then search(c+':\');
    end;
SetLength(Result, index);
except
 showmessage('Search Error');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var newresult,oldresult:TFiles;
    i,j,entries,fsize,slength,t1,t2,t3,t4:integer;
    newdate,olddate:real;
    newfile,oldfile:tfilestream;
    c:char;
    help:string;
begin
t1:=gettickcount;
//load old results
try
oldfile:=tfilestream.create(extractfilepath(application.exename)+'save.hsf',fmopenread);
oldfile.Read(olddate,8);//read date form last checkup
oldfile.Read(entries,4);//read entries form last checkup
setlength(oldresult,entries);
for i:=0 to entries-1 do
    begin
    oldfile.read(slength,4);//read length of path
    for j:=1 to slength do //restore path
        begin
        oldfile.read(c,1);
        help:=help+c;
        end;
    oldresult[i].path:=help; //write path in array
    help:='';
    oldfile.read(oldresult[i].size,4); // read filesize and write size in array 
    end;
finally
oldfile.Free;
end;
//load old results
//scan hard disks
t3:=gettickcount;
newresult:=SearchFiles('*.*',true);
t4:=gettickcount;
//scan hard disks
//save new results
try
newfile:=tfilestream.create(extractfilepath(application.exename)+'save.hsf',fmcreate);
newdate:=now;
newfile.write(newdate,8); //write date 
entries:=length(newresult); //write entries
newfile.Write(entries,4);
for i:=0 to length(newresult)-1 do
    begin
    slength:=length(newresult[i].path);
    newfile.write(slength,4); //write length of path in file
    for j:=1 to slength do //split path
        begin
        c:=newresult[i].path[j];
        newfile.Write(c,1);
        end;
    fsize:=newresult[i].size; 
    newfile.Write(fsize,4);  //write file size
    end;
finally
newfile.Free;
end;
//save new results
//analysis

//analysis
t2:=gettickcount;
showmessage(inttostr(t2-t1)+' ms / '+inttostr(t4-t3)+' ms');
end;

Wo kann man hier was optimieren :?:

Horst_H - Mo 29.05.06 14:55

Hallo,

Wie ich in deinem genannten Beitrag nach BenBe geschrieben habe, dauert bei mir die Suche von etlichen Dateien (ohne Ausgabe) nur 3 Sekunden, dank FastMM4.
...
Du speicherst die Daten recht langsam Zeichen fuer Zeichen.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

for i:=0 to entries-1 do   
  begin   
  oldfile.read(slength,4);//read length of path   
  for j:=1 to slength do //restore path   
    begin   
    oldfile.read(c,1);   
    help:=help+c;   
    end;   
  oldresult[i].path:=help; //write path in array   
  help:='';   
  oldfile.read(oldresult[i].size,4); // read filesize and write size in array    
  end;   
finally  
//ersetzen
for i:=0 to entries-1 do   
  with oldresult[i] do
    begin   
    oldfile.read(slength,4);//read length of path   
    setlenght(path,slength);//oldresult[i].path  
    oldfile.readbuffer(path[1],slength);   
    oldfile.read(size,4); // read filesize and write size in array    
    end;

Gruss Horst

P.S.:
Das ganze hat bei meinen Festplatten C,D,F..K gedauert:
456,985 Sekunden/337,375 Sekunden fuer 1.312.030 Dateien, 81.590.020 Byte in der Datei.

Horst_H - Mo 29.05.06 15:54

Hallo,

ich habe ein Memofeld eingefuegt und nur noch 1 Laufwerk F:(FAT32) mit ~521617 Dateien getestet.(T_ges: 6907 ms/ T_suche 3140 ms )
save.hsf ist 28.951.295 Byte gross.
Das erstmalige Einlesen dauert natuerlich recht lang, da die Daten von der Festplatte geholt werden.
Das zweite Mal ist dann extrem viel schneller und nicht mehr aussagekraeftig :-(
Zumindest ist das Dateilesen und -schreiben erheblich schneller.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

procedure TForm1.Button1Click(Sender: TObject);
var newresult,oldresult:TFiles;
    i,j,entries,fsize,slength,t1,t2,t3,t4:integer;
    newdate,olddate:double;
    newfile,oldfile:tfilestream;
    c:char;
    DatName:string;
begin
t1:=gettickcount;
//load old results
DatName :=extractfilepath(application.exename)+'save.hsf';
if fileExists(DatName) then
  try
  oldfile:=tfilestream.create(DatName,fmopenread);
  oldfile.Read(olddate,8);//read date form last checkup
  oldfile.Read(entries,4);//read entries form last checkup
  setlength(oldresult,entries);
  memo1.lines.Add(Format('Anzahl Dateien %d',[entries]));
  for i:=0 to entries-1 do
  with oldresult[i] do
    begin
    oldfile.read(slength,4);//read length of path
    setlength(path,slength);//oldresult[i].path
    oldfile.readbuffer(path[1],slength);
    oldfile.read(size,4); // read filesize and write size in array
    end;
  with oldresult[entries-1] do
    memo1.lines.Add(Format('%s %d',[path,size]));
finally
oldfile.Free;
end;
//load old results
//scan hard disks
t3:=gettickcount;
newresult:=SearchFiles('*.*',true);
t4:=gettickcount;
//scan hard disks
//save new results
try
newfile:=tfilestream.create(DatName,fmcreate);
newdate:=now;
newfile.write(newdate,8); //write date
entries:=length(newresult); //write entries
newfile.Write(entries,4);
memo1.lines.Add(Format('Anzahl neu eingelesene Dateien %d',[entries]));
with newresult[entries-1] do
   memo1.lines.Add(Format('%s %d',[path,size]));
for i:=0 to entries-1 do
  with newresult[i] do
    begin
    slength:=length(path);
    newfile.write(slength,4); //write length of path in file
    newfile.WriteBuffer(path[1],slength);
    newfile.Write(size,4);  //write file size
    end;
finally
newfile.Free;
end;
//save new results
//analysis
//analysis
t2:=gettickcount;
showmessage(inttostr(t2-t1)+' ms / '+inttostr(t4-t3)+' ms '+IntToStr(length(newresult)));
end;

Gruss Horst
P.S.:
Ein Versuch mit dem nicht mehr zwischengespeichertem Laufwerk D:
1.ster Aufruf:
T_ges 370,031 S / T_Suche 366,234 s 668299 Dateien (Dateigroesse 44.959.864 Byte)
2.ter Aufruf
T_ges 348,797 S / T_Suche 343,843 s

Das liegt wohl daran, dass dies ein NTFS -Laufwerk mit der Windowsinstallation ist.
KernelZeit(WinAPi aufrufe (hier wohl hauptsaechlich Findfirst,FindNext)fuer beide Aufrufe zusammen: 24,687 S
User-Zeit(die eigentliche Verarbeitung im Programm)fuer beide Aufrufe zusammen: 8,25 S
Also arbeitet der Rechner nur 32 Sekunden von 718 fuer das Programm, da es auf Daten wartet.

BenBE - Di 30.05.06 20:56

Zusätzlich zu dem, was Horst bereits ausgeführt hab, schwebte mir in besagtem Thread auch eine andere Optimierung im Kopf rum, die einige Index-Berechnungen der Arrays sowie deren langsame Speicherverwaltung umgeht. Insgesamt benötigt diese Version aber etwas Sorgfalt.

Gegeben ist ein Typ:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

type
    TFileEintrag = packed Record
        Parent: Integer;
        Name: String;
        Size: Int64;
        //...
    end;

Zusätzlich haben wir einen Typ TFileEntryArray und PFileEntryArray:

Delphi-Quelltext

1:
2:
3:
4:

type
    TFileEntryArray = array [0..0] of TFileEntry;
    PFileEntry = ^TFileEntry;
    PFileEntryArray = ^TFileEntryArray;

Wie man leicht erkennt, ist TFileEntryArray statisch ... falsch*!!!

Das ist ein sogar SEHR Dynamischer Typ!

Aber was macht man mit einem Array, was nur einen Eintrag fassen kann?
Man holt sich mehr Speicher als benötigt und kümmert sich selbst drum ^^

Was brauchen wir dafür:
1. Eine Größenangabe
2. Ein wenig Speicher
3. ein paar Pointer *g*

Und nun schreiten wir zur Tat ;-)

Delphi-Quelltext

1:
2:
3:
4:
5:

var 
    Base: PFileEntryArray;
    Curr: PFileEntry;
    EndOfArray: PFileEntry;
    Size: Integer; //Anzahl der Einträge

Und nun zum eigentlichen Source:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

procedure search(const searchpath:string);
var
    SR: TSearchRec;
begin
  if FindFirst(searchpath + Mask, faAnyFile - faDirectory, SR) = 0 then
  try
    repeat
      if Integer(Curr) >= Integer(EndOfArray) then
      begin
          //Get the current index
          Integer(Curr) := (Integer(Curr) - Integer(Base)) div SizeOf(TFileEntry);

          //Double the reserved size
          Base := ReallocMem(Base, 2 * (Integer(EndOfArray) - Integer(Base)));

          //Reset the pointers a bit *g*
          EndOfArray := @(Base^[2 * Integer(Curr)]);
          Curr := @(Base^[Integer(Curr)]);
      end;
      Curr^.path:=searchpath + SR.Name;
      Curr^.size:=sr.Size;
      inc(Curr);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;

  if AllFolders=true then begin
    if FindFirst(searchpath + '*.*', faAnyFile, SR) = 0 then
    try
      repeat
        if ((SR.attr and faDirectory) = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
          search(searchpath + SR.Name + '\');
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;

end;

Dieser Algorithmus funktioniert, wenn man am Anfang mindestens einen Eintrag reserviert hat.

Delphi-Quelltext

1:
2:
3:
4:

Base := GetMemory(SizeOf(TFileEntry));
Curr := Base;
EndOfArray := Curr;
Inc(EndOfArray);

Zu beachten ist eigentlich nur eins: Im Delphi-Source darf in Base keine Element mit einer Konstante <> 0 als Index angesprochen werden. Base^[1] ist daher ungültig, während Idx := 1; Curr := @(Base^[Idx]); gültig ist.

Auf diese Art sparst Du Dir bei linearer Speicherung der Daten im RAM einiges an Berechnungen für die Indizes,, hast aber das Problem, dass Windows ggf. Pagen muss um deinen Speicherblock linear im Speicher halten zu können. Bei ansonsten ausgewogener Programmierung kann man so gegenüber Delphi noch einmal 5-10% an Geschwindigkeit in der Verarbeitung rausholen. Ich muss aber Horst Recht geben, dass bereits bei diesem Algo das Programm auf die Platte wartet.

*Ohne Anwendung von ein paar Tricks geht es an dieser Stelle nicht. Auf jeden Fall MUSS ab hier die Array Bound-Prüfung des Compiler DEAKTIVIERT werden ... frisst eh nur Zeit!

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!