/ Forside / Teknologi / Udvikling / Delphi/Pascal / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
Delphi/Pascal
#NavnPoint
oldwiking 603
jrossing 525
rpje 520
EXTERMINA.. 500
gandalf 460
gubi 270
DJ_Puden 250
PARKENSS 230
technet 210
10  jdjespers.. 200
Ekstrakte direktor struktur med delphi 5
Fra : pp


Dato : 04-06-02 10:39

Hej

Jeg har brug for at trække dir struktur ud med delphi 5

jeg har en struktur med 100.000 filer i 74 mapper og jeg har kun brug for
navnerne på mapperne.
Jeg har brugt vedlagte kode, men det tager 10-15 min kan det evt. gøres
hurtigere?

Mvh Erling


procedure RekFolder(Path : string);
var
SRec: TSearchRec;

begin
// *** Åbning af filstruktur *******
if FindFirst(Path+'*.*', faDirectory , SRec) = 0 then
if (SRec.Attr and faDirectory > 0) then
begin
//Bibliotek
if (SRec.Name <> '.') and (SRec.Name <> '..') then
begin
RekFolder(Path+SRec.Name+'\');// Rekursivt kald

ListBox1.Items.Add(Path+SRec.Name);

end; // if (SRec.Name <> '.')
end; // if SRec.Attr = faDirectory

// *** gennemløb af filstruktur *******
while FindNext(SRec) = 0 do
if (SRec.Attr and faDirectory > 0) then
begin
//Bibliotek
if (SRec.Name <> '.') and (SRec.Name <> '..') then
begin
RekFolder(Path+SRec.Name+'\'); // Rekursion

ListBox1.Items.Add(Path+SRec.Name);

end; // if (SRec.Name <> '.')
end; // if SRec.Attr = faDirectory then

FindClose(SRec);
end;




 
 
Asger Grunnet (05-06-2002)
Kommentar
Fra : Asger Grunnet


Dato : 05-06-02 17:00


pp skrev:
> Hej
>
> Jeg har brug for at trække dir struktur ud med delphi 5
>
> jeg har en struktur med 100.000 filer i 74 mapper og jeg har kun brug for
> navnerne på mapperne.
> Jeg har brugt vedlagte kode, men det tager 10-15 min kan det evt. gøres
> hurtigere?
>
> Mvh Erling

[snip - kode]

Det undrer mig lidt at det tager så lang tid for dig. Da jeg kørte koden
på min computer (med ca. 3000 mapper og 70000 filer), tog det kun
nogle få sekunder.

Hvor er din filstruktur placeret (Harddisk / CD-ROM / Netværk / ...) ?

Jeg har inkluderet en stump kode, der propper navnene på alle
mapper ind i en ListBox. Prøv at køre det, og se om det hjælper på
hastigheden. Advarsel: Proceduren er fyldt med memory-leaks, så
hvis du vælger at bruge den, skal du nok ændre en del...

På min computer var min kode faktisk en smule langsommere end
din, så jeg har ingen anelse om hvorvidt det hjælper. Den eneste
grund jeg har til at tro at det måske kan være tilfældet, er at man i
funktions-kaldet AFolder.EnumObjects kan specificere at man kun
er interesseret i mapper. På den måde behøver man ikke at løbe
igennem alle filerne selv. Det gør systemet for én. Man kan så bare
håbe at systemet gør det på en mindre tidskrævende måde!

Det skal forresten lige nævnes at jeg skrev koden i Delphi 6
(under Windows 2000), men jeg tror ikke at der er kompatibilitets
problemer.

Asger.



uses
ShlObj;

procedure TForm1.GetFolders;

procedure LoopFolders(AFolder : IShellFolder);
var
wIdList : IEnumIDList;
wItemIdList : PItemIdList;
wStrRet : TStrRet;
wName : String;
wFetched : Cardinal;
wSubFolder : IShellFolder;
begin
if AFolder.EnumObjects(Handle, SHCONTF_FOLDERS or
SHCONTF_INCLUDEHIDDEN, wIdList) = NOERROR then
begin
while wIdList.Next(1, wItemIdList, wFetched) = NOERROR do
begin
if AFolder.GetDisplayNameOf(wItemIdList, SHGDN_FORPARSING, wStrRet)
= NOERROR then
begin
case wStrRet.uType of
STRRET_CSTR: wName := wStrRet.cStr;
STRRET_WSTR: wName := wStrRet.pOleStr;
else
wName := '<???>';
end;
ListBox1.Items.Add(wName);
if AFolder.BindToObject(wItemIdList, nil, IID_IShellFolder,
wSubFolder) = NOERROR then LoopFolders(wSubFolder);
end;
end;
end;
end;

var
wDesktop : IShellFolder;
wFolder : IShellFolder;
wItemIdList : PItemIdList;
wBrowseInfo : TBrowseInfo;
wBuffer : array[0..MAX_PATH] of Char;
begin
if SHGetDesktopFolder(wDesktop) = NOERROR then
begin
wBrowseInfo.hwndOwner := Handle;
wBrowseInfo.pidlRoot := nil;
wBrowseInfo.pszDisplayName := @wBuffer;
wBrowseInfo.lpszTitle := PChar('Test');
wBrowseInfo.lpfn := nil;
wItemIdList := SHBrowseForFolder(wBrowseInfo);
if wDesktop.BindToObject(wItemIdList, nil, IID_IShellFolder,
wFolder) = NOERROR then LoopFolders(wFolder);
end;
end;




Søg
Reklame
Statistik
Spørgsmål : 177552
Tips : 31968
Nyheder : 719565
Indlæg : 6408847
Brugere : 218887

Månedens bedste
Årets bedste
Sidste års bedste