Ordentlicher Dateibaum

[busybyte]

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;