Listar una unidad completa y guardarla en fichero de texto

[Rolo]

Hola

¿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

[ixMike]

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.

[ixMike]

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.

[Rolo]

Muchas gracias

[PeterPunk]

Empezado por ixMike

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?

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.

[ixMike]

Empezado por PeterPunk

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

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

En cuanto a lo de faAnyFile, , 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


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

[PeterPunk]

Empezado por ixMike

¿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

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?

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.

[Rolo]

Nuevamente mil gracias a los dos