AGB  ·  Datenschutz  ·  Impressum  







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

Ordentlicher Dateibaum

Ein Thema von R56 · begonnen am 16. Mai 2012 · letzter Beitrag vom 17. Mai 2012
 
busybyte

Registriert seit: 15. Sep 2006
165 Beiträge
 
#8

AW: Ordentlicher Dateibaum

  Alt 17. Mai 2012, 14:52
Wie hä?
Hast dich schonmal mit Treenodes beschäftigt?
Der Datapointer kann viele Probleme lösen wenn man mit dem Node weitere Informationen transportieren will.
Hier mal ein Überblick was so alles interessant sein könnte, auch wenn der Code nicht perfekt ist, kannst vieleicht was davon gebrauchen.
Delphi-Quellcode:
const faNewAnyFileEx = FaAnyFile or $00000080;

Type

  PDatenTr=^TDatenTr;
  TDatenTr = record
   DTRDisplayName,DTROriginName,DTRMediaType,
   DTRSerial:WideString;
   DTRFolderList:TList;
   DTRAllSize:int64;
  end;

PFileItem = ^TFileItem;
  TFileItem = record
    OriginName,DisplayName,
    TypeName,Path: WideString;

    Attributes:Integer;
    Size:int64;
    SizeS:String;
    Struct:TWin32FindData platform;
    FolderLevel,ImageIndex:Longint;
  end;


PFolderItem = ^TFolderItem;
  TFolderItem = record
    OriginName,DisplayName,
    TypeName,Path: WideString;

    FileList:TList;

    Attributes: Integer;
    Size:int64;
    SizeS:String;
    Struct:TWin32FindData platform;
    FolderLevel,Index,Absoluteindex,ImageIndex:Longint;
    end;


TGetDirsResult=Record
  FolderCnt,Filecnt:Longint;
  AllSize:int64;
  end;

Var
BreakScan,isClosing:Boolean;
CurrentOut:WideString;

FDT:PDatenTr;
_Absoluteindex,_Foldercnt,_Filecnt:Longint;
_AllSize:int64;

Function ScanDrive(ADrv,ADirectory: Widestring; Var AFolderList:Tlist;Level_,Index_:Longint;FolderItem_:PFolderItem):TGetDirsResult;
var SR: TSearchRec;
   NewNode: TTreeNode;
  Tmp2:String;
   L1:Longint;
   P:Longint;
   FileItem:PFileItem;
   FolderItem:PFolderItem;
   W:Widestring;
begin
 while BreakScan or isClosing
  do exit;

  W:='\\';
  P:=Pos(W,ADirectory);
  Delete(ADirectory,P,1);

  if FindFirst(ADrv+ADirectory+'*', faNewAnyFileEx, SR) = 0 then begin
    try
      repeat
      if ((SR.Name <> '.') and (SR.Name <> '..')) then
        begin
         if ((SR.Attr and faDirectory) <> 0) then
          begin
          inc(_Absoluteindex);
          FolderItem := New(PFolderItem);
          FolderItem.FileList:=TList.Create;
          with FolderItem^ do
          begin
          FolderLevel:=Level_;
          Index:=Index_;
          Absoluteindex:=_Absoluteindex;
          OriginName:=SR.Name;
          DisplayName:=OriginName;
          Struct:=SR.FindData;
          Path:=ADirectory;
          end;
          AFolderList.Insert(_Absoluteindex,FolderItem);

         inc(_FolderCnt);

          if isClosing or breakscan then
           begin
           FindClose(SR);
           exit;
           end;

         CurrentOut:=ADrv+ADirectory+SR.Name;
         Index_:=Index_+1;
         ScanDrive(ADrv,ADirectory+SR.Name+'\',AFolderList,Level_+1,0,FolderItem);
         end

          else
           begin
             FileItem := New(PFileItem);
            _AllSize:=_AllSize+SR.Size;
             FileItem.OriginName := SR.Name;
             FileItem.DisplayName:=FileItem.OriginName;
             FileItem.FolderLevel:=Level_-1;
             FileItem.Path:=ADirectory;
             FileItem.Struct:=SR.FindData;
             FolderItem_.FileList.Add(FileItem);
             inc(_Filecnt);

          if isClosing or breakscan then
           begin
           FindClose(SR);
           exit;
           end;

           CurrentOut:=ADrv+ADirectory+SR.Name;

           end;
       end;
      until FindNext(SR) <> 0;
    finally
    FindClose(SR);
    end;
  end;
end;


Function GetNextFolderLevel(Absoluteindex:Longint;FolderList:TList):TList;
Var
L1,L2,cnt2:Longint;
BaseItem,NextItem:PFolderItem;
BL:integer;
begin
Result:=TList.Create;
 try
  begin
  L1:=FolderList.Count;
  L2:=L1-1;
   while (Absoluteindex>L1-2) do
    Exit;

   BaseItem:=PFolderItem(FolderList[Absoluteindex]);
   BL:=BaseItem.FolderLevel+1;

      for cnt2 := Absoluteindex+1 to L2 - 1 do
       begin
       NextItem:=PFolderItem(FolderList[cnt2]);
        if (NextItem.FolderLevel=BL) then
         Result.Add(NextItem);
       if (NextItem.FolderLevel<BL) then
        Exit;
       end;

  end;
 Except
 Result.Free;
 end;

end;



Function GetPFoldersLeveled(Level:Longint;FolderList:TList):TList;
Var
L1,cnt1:Longint;
Item:PFolderItem;
begin
 while not Assigned(FolderList) do
  Exit;
Result:=TList.Create;
 try
  begin
  cnt1:=0;
   while (cnt1<FolderList.Count) do
    begin
     Item:=PFolderItem(FolderList[cnt1]);
      if Assigned(Item) and (Item.FolderLevel=Level) then
       Result.Add(Item);
    cnt1:=cnt1+1;
    end;
  end;
 Except
 Result.Free;
 end;
end;


Procedure MaxLevel2(MaxLevel_:integer;Tree_:TTreeview;Src_:PFolderitem;NextList:TList;
                     TargetNode_: TTreeNode;DTRFolderList:TList);
var
i: LongInt;
Tmp:TTreenode;
L1:Longint;
NextItem:PFolderItem;
begin
tmp :=Tree_.Items.AddChild(TargetNode_,Src_.DisplayName);

tmp.Data:=Src_; //Alle Daten des Ordners als Pointer(PFolderitem) anhängen !

L1:=NextList.Count;
 if (L1>0) then
  Tmp.HasChildren:=True;

 if (MaxLevel_>Src_.FolderLevel) then
  begin
   for i := 0 to L1-1 do
    begin
    NextItem:=PFolderItem(NextList[i]);
    MaxLevel2(MaxLevel_,Tree_,NextItem,GetNextFolderLevel(Nextitem.Absoluteindex,DTRFolderList) ,
              Tmp,DTRFolderList);
    end;
  end;
end;




Procedure BuildTV(aTV:TTreeview;aDTR:PDatenTr);
Var
Folderitem:PFolderItem;
L1,cnt1:Longint;
BaseList,NextList:TList;
AktNode_:TTreenode;
begin
if Assigned(aDTR) then
 with PDatenTr(aDTR)^ do
 begin
 BaseList:=GetPFoldersLeveled(0,DTRFolderList);
 Aktnode_:=aTV.items.AddChild(nil,'Datenträger:');
 L1:=BaseList.Count;
   for cnt1:= 0 to L1-1 do
    begin
    Folderitem:=PFolderItem(BaseList[cnt1]);
    NextList:=GetNextFolderLevel(Folderitem.Absoluteindex,DTRFolderList);
    MaxLevel2(2,aTV,FolderItem,NextList,AktNode_,DTRFolderList); //Maximal 2. Level anzeigen wegen Performance
    end;
  BaseList.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
FolderItem:PFolderItem;
begin
FDT:=New(PDatenTr);
FolderItem:=New(PFolderItem);
Folderitem.FileList:=TList.Create;
FDT.DTRFolderList:=TList.Create;
FDT.DTRFolderList.Add(Folderitem);
_Absoluteindex:=-1;
ScanDrive('F:\','',FDT.DTRFolderList,0,0,Folderitem);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
BuildTV(Treeview1,FDT);
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
isClosing:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Interval:=100;
Label1.Caption:=CurrentOut;
end;
I love DiscCat

Geändert von busybyte (17. Mai 2012 um 17:34 Uhr)
  Mit Zitat antworten Zitat
 


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 05:25 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