Kleines Beispiel, ist schon 15 Jahre alt, funktioniert noch immer und vielleicht hilfts weiter...
Delphi-Quellcode:
// Einfach verkettete Liste
type
pDirRec = ^tDirRec;
tDirRec =
record
Path: shortstring;
Next: pDirRec
end;
// Erzeugt eine Liste aller Unterverzeichnisse (ohne Rekursion) eines gegebenen Ordners...
function GetDirList(
const path: shortstring): pDirRec;
var
pCurrent, pNode, pPrev: pDirRec;
sr: TSearchRec;
begin
New(Result);
Result^.Next:=
nil;
//das steht sonst eventuell irgendein Datenmüll drin
if path[length(path)] = '
\'
then Result^.Path:= '
'
else Result^.Path:= '
\';
pNode:= Result;
pPrev:= Result;
repeat
if Findfirst(path + pNode^.Path + '
*.*', faAnyFile, sr) = 0
then begin
repeat
if sr.
Name[1] = '
.'
then continue;
if (sr.Attr
and faDirectory) > 0
then begin
New(pCurrent);
pCurrent^.Path:= pNode^.Path + sr.
name + '
\';
if pNode = Result
then pCurrent^.Next:=
nil
else pCurrent^.Next:= pPrev^.Next;
pPrev^.Next:= pCurrent;
pPrev:= pCurrent;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
pNode:= pNode^.Next;
pPrev:= pNode;
until pNode =
nil;
end;
// ... die man nach Gebrauch wieder freigeben sollte
procedure FreeDirList(pRoot: pDirRec);
var
pCurrent: pDirRec;
begin
pCurrent:= pRoot;
while pCurrent <>
nil do begin
pRoot:= pCurrent^.Next;
Dispose(pCurrent);
pCurrent:= pRoot;
end;
end;
// Verwendung:
var
pRoot, pCurrent: pDirRec;
sr: tSearchRec;
pRoot:= GetDirList('
d:\mssql');
pCurrent:= pRoot;
while pCurrent <>
nil do begin
if Findfirst('
d:\mssql' + pCurrent^.Path + '
*.*', faAnyFile, sr) = 0
then begin
repeat
if sr.
Name[1] = '
.'
then continue;
if (sr.Attr
and faDirectory = 0)
then
Memo1.Lines.Add('
d:\mssql' + pCurrent^.Path + sr.
Name + '
: ' + DateTimeToStr(FileDateToDateTime(sr.Time)));
until FindNext(sr) <> 0;
FindClose(sr);
end;
pCurrent:= pCurrent^.Next;
end;
FreeDirList(pRoot);