Listar una unidad completa y guardarla en fichero de texto
 

Hola :D

¿Cómo están?

Ando buscando código o alguna utilidad de código abierto del tipo: {$APPTYPE CONSOLE}, que se asemeje al tree.com o tree.exe (ms-dios) de windows, para que muestre el contenido en ascii y en forma de raíz de los directorios y ficheros contenidos en una unidad cualquiera, y a ser posible que me lo guarde en un fichero de texto en el lugar del disco duro que yo le indique.

Gracias anticipadas :D

Bueno, para listar todos los archivos, te recomiendo las funciones FindFirst, FindNext, FindClose. Busca en la ayuda de Delphi (hasta trae ejemplos de cómo usarlas).

Bueno, he hecho un par de cosas parecidas por ahí, si eso inténtalo y si no te sale, pues miras este post otra vez a ver si he publicado el código ;)


Salu2.

Bueno, logré esto:

Código Delphi [-]
program listador;
{$APPTYPE CONSOLE}

uses Windows, SysUtils;

var
  Txt: TextFile;
  Nivel: Integer;

Function Espacios(Cantidad: Integer): String;
var
  S: String;
begin
  S:='';
  While Cantidad>0 do
    begin
      S:=S+'  ';
      Dec(Cantidad);
    end;
  Result:=S;
end;

Procedure Lista(Ruta: String);
var
  R: Integer;
  Info: TSearchRec;
begin
  //Listar directorios
  R:=FindFirst(Ruta + '*', faDirectory, Info);
  while R=0 do
    begin
      If not (Info.Name[1]='.') then  //No sabes la que arma con los directorios '.' y '..'
        begin
          WriteLn(Espacios(Nivel) + '|- ' + Info.Name);
          WriteLn(Txt, Espacios(Nivel) + '|- ' + Info.Name);
          Inc(Nivel);
          Lista(Ruta+Info.Name+'\');
          Dec(Nivel);
        end;
      R:=FindNext(Info);
    end;
  FindClose(Info);
  //Fin listar directorios

  // Listar archivos
  R:=FindFirst(Ruta + '*', faAnyFile, Info);
  while R=0 do
    begin
      WriteLn(Espacios(Nivel) + '|- ' + Info.Name + '  [Tamaño: ' + IntToStr(Info.Size) + ' Bytes]');
      WriteLn(Txt, Espacios(Nivel) + '|- ' + Info.Name + '  [Tamaño: ' + IntToStr(Info.Size) + ' Bytes]');
      R:=FindNext(Info);
    end;
  FindClose(Info);
  //Fin listar archivos
end;

{ La aplicación debe recibir dos parámetros:
  -El primero será la ruta donde buscar ("C:\", "D:\Mis aplicaciones"...)
  -El segundo, el fichero de texto donde se guardarán los datos
}

begin
  Nivel:=0;
  AssignFile(Txt, ParamStr(2));
  Rewrite(Txt);
  Lista(ParamStr(1));
  CloseFile(Txt);
end.

Pero tiene dos fallos. El primero es que al listar los directorios también lista los archivos. El segundo es que, al listar los archivos... ¡también aparecen los directorios!

¿Alguien sabe por qué pasa eso?


Salu2.

P.D.: También faltaría retocar el código un poco para que el árbol quede más bonito.

Echaré un vistazo
 

Muchas gracias :)

Al listar los directorios muestra los archivos porque tras encontrar el primer directorio no compruebas que los siguientes archivos que encuentre sean directorios. Vamos que ésta línea:

Código Delphi [-]
If not (Info.Name[1]='.') then

debería ser así:

Código Delphi [-]
      If (not (Info.Name[1]='.')) and ((Info.Attr and faDirectory)<>0) then

Y al listar los archivos se muestran los directorios porque tienes faAnyFile que lo muestra todo. Aquí o usas

Código Delphi [-]
R:=FindFirst(Ruta + '*', faReadOnly or faHidden or faSysFile or faArchive, Info);

o bien:

Código Delphi [-]
R:=FindFirst(Ruta + '*', faAnyFile xor faDirectory, Info);

bueno, o evidentemente

Código Delphi [-]
R:=FindFirst(Ruta + '*', $2F, Info);

Por cierto, antes de cada impresión en archivo sería mejor comprobar que existe el segundo parámetro por que si se usa el ejecutable sin ese nombre de archivo, imprime en pantalla todos los archivos (y directorios) dos veces. Retocando un poco el código que subiste antes, queda algo así:

Código Delphi [-]
program listador;
{$APPTYPE CONSOLE}
uses Windows, SysUtils;
var
  Txt: TextFile;
  Nivel: Integer;
  Atributos: Integer;
Function Espacios(Cantidad: Integer): String;
var
  S: String;
begin
  S:='';
  While Cantidad>0 do
    begin
      S:=S+'  ';
      Dec(Cantidad);
    end;
  Result:=S;
end;
procedure Tree(const folder: TFileName);
var
  SearchRec: TSearchRec;
begin
  (*Busca todos los archivos dentro del directorio recibido*)
  if FindFirst(folder + '*', atributos, SearchRec) = 0 then begin
    try
      repeat
        if (SearchRec.Attr and faDirectory = 0) or
           (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          begin
            WriteLn(Espacios(Nivel) + '|- ' + SearchRec.Name + '  [Size: ' + IntToStr(SearchRec.Size) + ' Bytes]');
            if ParamStr(2)<>'' then
              WriteLn(Txt, Espacios(Nivel) + '|- ' + SearchRec.Name + '  [Tamaño: ' + IntToStr(SearchRec.Size) + ' Bytes]');
          end
      until FindNext(SearchRec) <> 0;
    except
      FindClose(SearchRec);
      raise;
    end;
    FindClose(SearchRec);
  end;
  (*Busca los subdirectorios dentro del directorio recibido*)
  if FindFirst(folder + '*', atributos
      Or faDirectory, SearchRec) = 0 then
  begin
    try
      repeat
        if ((SearchRec.Attr and faDirectory) <> 0) and
           (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          begin
            WriteLn(Espacios(Nivel) + '|- ' + SearchRec.Name);
            if ParamStr(2)<>'' then
              WriteLn(Txt, Espacios(Nivel) + '|- ' + SearchRec.Name);
            Inc(Nivel);
            Tree(folder + SearchRec.Name + '\');
            Dec(Nivel);
          end;
      until FindNext(SearchRec) <> 0;
    except
      FindClose(SearchRec);
      raise;
    end;
    FindClose(SearchRec);
  end;
end;
{ La aplicación debe recibir dos parámetros:
  -El primero será la ruta donde buscar ("C:\", "D:\Mis aplicaciones"...)
  -El segundo, el fichero de texto donde se guardarán los datos
}
begin
  Nivel:=0;
  atributos:= faReadOnly or faHidden or faSysFile or faArchive;
  AssignFile(Txt, ParamStr(2));
  Rewrite(Txt);
  WriteLn(txt,ParamStr(1));
  if ParamStr(2)<>'' then
    WriteLn(txt,ParamStr(1));
  Tree(ParamStr(1)+'\');
  CloseFile(Txt);
end.

No tiene mucho sentido, ya que la búsqueda la realizo con faDirectory.

En cuanto a lo de faAnyFile, :D, no me había fijado en que también entraban los directorios.

En cuanto a lo de comprobar el segundo parámetro, en fin, también se debería comprobar el primero. Pero, de todas formas, era un código de ejemplo, para que el amigo Rolo lo completara, y pillara el uso de FindFirst, FindNext, FindClose (espero que sí :)).

¿Y a qué se debe eso de cambiar "Ruta" por "Folder", "Lista" por "Tree", "Info" por "SearchRec", listar primero los archivos y la condición de mi bucle? El idioma oficial de los foros (y lo pone en la guía de estilo) es el castellano :D


Salu2, y gracias por las correcciones (Rolo, ya tienes el programa 100% funcional ;))

Está en inglés y en orden archivos, directorios porque lo copié de un código mío que tenía a mano al que le quité unas líneas que no venían al caso y le metí las tuyas de imprimir. El nombre "Tree" era que como tenía a la vez tú procedimiento y el mio en el programa fue el primero que me vino (porque era el programa que quería emular Rolo).
¿Si no de qué le iba a meter el except / try? :p

En cuanto a lo de la búsqueda por faDirectory, sí, la lógica dice que no debería hacer falta, pero debe ser que el FindNext cambia los atributos de búsqueda o algo así raro, pero sé (empíricamante) que esa línea es necesaria.

Saludos.

Nuevamente mil gracias a los dos :D