Función recursiva en un TreeView

[[Gunman]]

Hola delphiadictos!
Estaba intentando crear una función que mostrase las carpetas de una unidad local en un TreeView. Yo habia hecho esto para experimetar un poco:

procedure LocalTreeListing(const Folder: String; Nodes: TTreeNodes);
var
SearchRec: TSearchRec;
i: Integer;
begin
Nodes.Clear;

SearchRec.ExcludeAttr := 32;
if FindFirst(IncludeTrailingPathDelimiter(Folder)+'*.*', faAnyFile,
SearchRec) = 0 then
repeat
if ((SearchRec.Attr and faDirectory) = faDirectory
and not faHidden) and ((SearchRec.Attr and faSysFile) <> faSysFile) then
Nodes.Add(nil,SearchRec.Name);
{Elimina els items '.' i '..' si el FindFirst els crea}
if (Nodes.Count > 0) and
((Nodes[Nodes.Count-1].Text = '.') or
(Nodes[Nodes.Count-1].Text = '..')) then
Nodes[Nodes.Count-1].Delete;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;

Esto sólo inserta en el TreeView las carpetas de un directorio deseado y esto no me es suficiente.
No tengo ni la mas mínima idea de por donde empezar con la función recursiva, alguien me podria hechar una mano?

[maeyanes]

Puedes probar con este procedimiento:


procedure LocalTreeListing(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRect;
NewNode: TTreeNode;

begin
if FindFirst(IncludeTrailingPathDelimiter(Folder) + '*.*', faDirectory, AFolder) = 0 then
repeat
if (AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
NewNode := Nodes.Add(ParentNode, AFolder.Name);
LocalTreeListing(AFolder.Name, Nodes, NewNode)
end
until
FindNext(AFolder) <> 0;
FindClose(AFolder)
end;


Si te fijas, cada que la búsqueda encuentra un directorio cuyo nombre no es '.' o '..', esta manda a llamar de nuevo al mismo procedimiento, enviando como parámetros el nombre del folder encontrado, la lista de nodos que estamos llenando y el nodo que se agregó, el cual será el padre de los nodos que se agreguen en la llamada recursiva.

Para llamar al procedimiento debes hacer:

MiTreeView.Items.Clear;
LocalTreeListing('Windows', MiTreeView.Items, nil);
// ...


Ya por último te comento que no probé este código, así que probablemente haya uno que otro error.


Saludos...

[[Gunman]]

Gracias maeyanes, me has ayudado a depurar el código de mi procedimiento, pero la verdad es que este código hace exactamente lo mismo que hacia el mio, le he hecho unas modificaciones y se ha quedado así, pero sigue haciendo lo mismo que el mio...
Gracias de todas formas...

procedure TreeListing(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRec;
NewNode: TTreeNode;
begin
if FindFirst(IncludeTrailingPathDelimiter(Folder) + '*.*', faDirectory, AFolder) = 0 then
repeat
if ((AFolder.Attr and faDirectory) = faDirectory) and
((AFolder.Attr and faSysFile) <> faSysFile) and
(AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
NewNode := Nodes.Add(ParentNode, AFolder.Name);
TreeListing(IncludeTrailingPathDelimiter(CurrLocalPath+AFolder.Name) +
'*.*', Nodes, NewNode);
end;
until
FindNext(AFolder) <> 0;
FindClose(AFolder);
end;

[Lepe]

Pedías una función recursiva... y eso tienes :confused:

Pensar en recursivo no es fácil, puedes tomarlo como primer paso para incluir los archivos.


procedure TreeListing(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRec;
NewNode: TTreeNode;
begin
if FindFirst(IncludeTrailingPathDelimiter(Folder) + '*.*', faDirectory+ faAnyFile, AFolder) = 0 then
repeat
if ((AFolder.Attr and faDirectory) = faDirectory) and
((AFolder.Attr and faSysFile) <> faSysFile) and
(AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
NewNode := Nodes.Add(ParentNode, AFolder.Name);
TreeListing(IncludeTrailingPathDelimiter(CurrLocalPath+AFolder.Name) +
'*.*', Nodes, NewNode);
end;

if ((AFolder.Attr and faAnyfile) = faAnyfile)) then
// añadir el nodo de los archivos

until
FindNext(AFolder) <> 0;
FindClose(AFolder);
end;


Fijate que no hay else, esto es para que despues de añadir una carpeta, tambien intente añadir los archivos que haya.

He puesto faAnyFile, tú ajustalo más a lo que quieras.

saludos

[[Gunman]]

Lepe, gracias por tu interés, pero lo que yo quiero no es insertar archivos, mi TreeView sólo muestra carpetas.
Más o menos quiero que me quedé como el ShellTreeView.

[Lepe]

Gracias maeyanes, me has ayudado a depurar el código de mi procedimiento, pero la verdad es que este código hace exactamente lo mismo que hacia el mio, le he hecho unas modificaciones y se ha quedado así, pero sigue haciendo lo mismo que el mio...


Obviamente estas añadiendole tus errores al código que Maeyanes puso de memoria.... ¡¡ y que memoria !! ;) solo tiene un par de detalles, que despues de ejecutar paso a paso se vé claramente.

Por cierto, no te ha ayudado a "depurar el código" sino a trabajar recursivamente.


procedure TForm1.Button3Click(Sender: TObject);

procedure TreeListing(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRec;
NewNode: TTreeNode;
begin
if FindFirst(Folder + '*.*', faDirectory, AFolder) = 0 then
repeat
if ((AFolder.Attr and faDirectory) = faDirectory) and
((AFolder.Attr and faSysFile) <> faSysFile) and
(AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
NewNode := Nodes.AddChild(ParentNode, AFolder.Name);
TreeListing(IncludeTrailingPathDelimiter(Folder+AFolder.Name) +
'*.*', Nodes, NewNode);
end;
until
FindNext(AFolder) <> 0;
FindClose(AFolder);
end;
begin
TreeView1.Items.Clear;
TreeListing(('c:\windows\'),TreeView1.Items,nil);
end;


El primer detalle es que hay que usar AddChild para que los meta dentro.

El segundo, es que al llamar a la función recursiva, hay que DARLE LA RUTA COMPLETA.

Una "manía" mia, es que al llamar a FindFirst, no hace falta usar el includePathDelimiter, ya que siempre se le da la ruta con la barra al final.

saludos

[maeyanes]

Obviamente estas añadiendole tus errores al código que Maeyanes puso de memoria.... ¡¡ y que memoria !! ;) solo tiene un par de detalles, que despues de ejecutar paso a paso se vé claramente.

Y como te darás cuenta, la memoria me falló... jejeje

Se me pasó que el metodo para agregar nodos hijos es AddChild, como bien mencionas más a bajo.


Por cierto, no te ha ayudado a "depurar el código" sino a trabajar recursivamente.

Así es, además que le quité cierto código que sentí estaba de más, mi intención primera era mostrarle como hacer un procedimiento recursivo.



procedure TForm1.Button3Click(Sender: TObject);

procedure TreeListing(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRec;
NewNode: TTreeNode;
begin
if FindFirst(Folder + '*.*', faDirectory, AFolder) = 0 then
repeat
if ((AFolder.Attr and faDirectory) = faDirectory) and
((AFolder.Attr and faSysFile) <> faSysFile) and
(AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
NewNode := Nodes.AddChild(ParentNode, AFolder.Name);
TreeListing(IncludeTrailingPathDelimiter(Folder+AFolder.Name) +
'*.*', Nodes, NewNode);
end;
until
FindNext(AFolder) <> 0;
FindClose(AFolder);
end;
begin
TreeView1.Items.Clear;
TreeListing(('c:\windows\'),TreeView1.Items,nil);
end;

Otro detalle, esta comprobación: ((AFolder.Attr and faDirectory) = faDirectory) and
((AFolder.Attr and faSysFile) <> faSysFile) tal vez esté de más, ya que en la llamada a FindFirst se le está diciendo que solo busque carpetas.



saludos

Saludos... :)

[[Gunman]]

Perdón por estar tanto tiempo sin contestar...
He probado tu truco, Lepe, y funciona perfectamente, sólo hay un problemilla. Por ejemplo, si tengo esta carpeta:
C:\Archivos de Programa\Archivos Comunes\Microsoft Shared
... y hago:

TreeListing('c:\',TreeView1.Items,nil);

Sólo me muestra lo siguiente:
C:\ (<- esto no, es sólo para tener una referencia)
Archivos de Programa
Archivos Comunes
(...)
(...)

Como podría hacer que se mostraran las carpetas dentro de Archivos comunes?

[[Gunman]]

Vale, he avanzado algo... He estado jugando con la propiedad OnExpand del TreeView y se me ha ocurrido esto:

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
CurrentDir := CurrentDir+Node.Text+'\';
TreeListing(CurrentDir,TreeView1.Items,Node);
end;

Ahora sólo hay un problema, al expandir una carpeta se añaden las carpetas y se muestra que se pueden expandir, perfecto, lo que yo queria, pero... ¡Se muestran las mismas carpetas dos veces! unas con la posibilidad de expandir y la otra no... No habria alguna forma de en vez de añadir un item substituirlo si este ya existe?

[[Gunman]]

Hola, ya lo tengo casi... Esto es lo que he hecho:

Variables necesarias:

var
MainFrm: TMainFrm;
CurrentDir, FirstPath: String;


Procedimiento para añadir items al TreeView:

procedure AddFiles(const Folder: string; Nodes: TTreeNodes;
ParentNode: TTreeNode);
var
AFolder: TSearchRec;
NewNode: TTreeNode;
i: Integer;
begin
if FindFirst(Folder + '*.*', faDirectory, AFolder) = 0 then
repeat
if (AFolder.Name <> '.') and (AFolder.Name <> '..') then
begin
if ParentNode <> nil then
begin
for i := 0 to ParentNode.Count-1 do
if (ParentNode.Item[i].Text = AFolder.Name) then
begin
ParentNode.Item.Delete;
end;
end;
NewNode := Nodes.AddChild(ParentNode, AFolder.Name);
AddFiles(IncludeTrailingPathDelimiter(Folder+AFolder.Name) +
'*.*', Nodes, NewNode);
end;
until FindNext(AFolder) <> 0;
FindClose(AFolder);
end;


Procedimiento OnExpand del TreeView1:

procedure TMainFrm.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var
i: Integer;
begin
CurrentDir := FirstPath;
for i := Node.Level downto 0 do
if i = 0 then
CurrentDir := CurrentDir+Node.Text+'\'
else
CurrentDir := CurrentDir+Node.Parent.Text+'\';
ShowMessage(CurrentDir);
AddFiles(CurrentDir,TreeView1.Items,Node);
end;


...y para llamar-lo:

procedure TMainFrm.NewRegisterClick(Sender: TObject);
begin
TreeView1.Items.Clear;
AddFiles('E:\Mis Documentos\Mis archivos recibidos\', TreeView1.Items, nil);
FirstPath := ('E:\Mis Documentos\Mis archivos recibidos\');
end;


Bueno, ahora el problema está en que me hace una excepción en algunos casos: "List index out of bounds (0)" en la línia: [i]if (ParentNode.Item[i].Text = AFolder.Name) then en el procedimient AddFiles.
Como puedo arreglar esto, no sé porqué hace este error...

[Lepe]

Cosas como estas:

if ParentNode <> nil then
begin
for i := 0 to ParentNode.Count-1 do
if (ParentNode.Item[i].Text = AFolder.Name) then
begin
ParentNode.Item.Delete;

En otro sitio te dirían que vale, que no pasa nada. Desde luego, creo que en estos foros buscamos la eficiencia y el buen hacer de las cosas. Es innecesario crear los items, y acto seguirlo eliminarlo porque salen repetidos. Deberás hacer algo al respecto.

En mi opinion, puedes añadir a la rutina recursiva, un parámetro FullDeep:Boolean, si lo pones a true, busca todos los niveles de carpeta, si lo pones a false, solo busca el nombre de las carpetas de primer nivel.

Esto último te sirve para representar los nodos iniciales en el TreeView (FullDeep:=false), despues en el OnExpand, solo haz de llamar a la misma rutina con FullDeep:= True.

saludos

[danilochavez]

Hey guys...somewhere I found a very good and effective algorithm you are trying I guess...

procedure DirectoryTree(Tree:TTreeView;Memo1:TMemo ; RootDirectory:string);
var
sr: TSearchRec;
FileAttrs: Integer;
theRootNode : tTreeNode;
theNode : tTreeNode;

procedure AddDirectories(theNode: tTreeNode; cPath: string);
var
sr: TSearchRec;
FileAttrs: Integer;
theNewNode : tTreeNode;
begin
FileAttrs := faAnyFile; //TSearchRec constant
if FindFirst(cPath+'\*.*', FileAttrs, sr) = 0 then
begin
repeat
if ((sr.Attr and FileAttrs) = sr.Attr) and (copy(sr.Name,1,1) <> '.')
then
begin
theNewNode := Tree.Items.AddChild(theNode,sr.name);
AddDirectories(theNewNode,cPath+'\'+sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;

begin
FileAttrs := faAnyFile; //TSearchRec constant
theRootNode := Tree.Items.AddFirst(nil,RootDirectory);
if FindFirst(RootDirectory+'*.*', FileAttrs, sr) = 0 then
begin
theNode := Tree.Items.GetFirstNode;
AddDirectories(theNode,RootDirectory+sr.Name);
FindClose(sr);
end;
end;