Listar una unidad completa y guardarla en fichero de texto

[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.