AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Einfach verkettete Listen

Ein Thema von Luckie · begonnen am 13. Mär 2010 · letzter Beitrag vom 15. Mär 2011
Antwort Antwort
hoedlmoser

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

Re: Einfach verkettete Listen

  Alt 17. Mär 2010, 09: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
Antwort Antwort


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 22:10 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz