Einzelnen Beitrag anzeigen

hoedlmoser

Registriert seit: 15. Mär 2010
1 Beiträge
 
Delphi 7 Enterprise
 
#20

Re: Einfach verkettete Listen

  Alt 17. Mär 2010, 10:39
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);
  Mit Zitat antworten Zitat