FindFirst, FindNext y FindClose: se utilizan para obtener el contenido de un path, carpeta o directorio (contenido = archivos y directorios).
La primera función, FindFirst, inicia la búsqueda, la segunda función, FindNext la continúa y finalmente el procedimiento FindClose, la finaliza.
function FindFirst(
const Path: RawByteString;
Attr: LongInt;
out Rslt: TRawbyteSearchRec
):LongInt;
El tipo
RawByteString es un string que no tiene asociado ningún código de página.
Attr: es un campo de bit y se maneja con operaciones bit a bit, "Bitwise operation", no obstante se puede utilizar perfectamente sin tener conocimientos al respecto pero sabiendo al menos de que se trata. Para ello debemos hacer uso de las constantes que comienzan por "fa" por "File attributes".
Const
{ File attributes }
faReadOnly = $00000001;
faHidden = $00000002 platform;
faSysFile = $00000004 platform;
faVolumeId = $00000008 platform deprecated;
faDirectory = $00000010;
faArchive = $00000020;
faNormal = $00000080;
faTemporary = $00000100 platform;
faSymLink = $00000400 platform;
faCompressed = $00000800 platform;
faEncrypted = $00004000 platform;
faVirtual = $00010000 platform;
faAnyFile = $000001FF;
El parámetro tipo
out: es muy parecido a usar var, también es pasado por referencia, la diferencia es que el valor inicial (si es que lo tiene) se descarta. Si no está inicializado el valor, el compilador tampoco enviará una advertencia.
TRawbyteSearchRec es un registro:
type TRawbyteSearchRec = record
Time: LongInt; // Last modification timestamp
Size: Int64; // File size in bytes
Attr: LongInt; // File attributes
Name: RawByteString; // File name (single byte version)
ExcludeAttr: LongInt; // For internal use only
FindHandle: Pointer; // Native file search handle. For internal use only, treat as opaque
Mode: TMode; // File permissions (mode, Unix only)
end;
El resultado de la función: 0 (cero) si encuentra un archivo o un valor distinto a cero en caso contrario.
function FindNext(
var Rslt: TRawbyteSearchRec
):LongInt;
Como la búsqueda ya fue iniciada por FindFirst, no necesita ni el path ni attr y como vemos, el resultado en lugar de out es
var. Generalmente se la utiliza como condicional para un ciclo repeat until:
until FindNext(Arch)<>0;
Devuelve 0 (cero) en caso de haber encontrado una coincidencia y un valor distinto de cero en caso contrario, igual que FindFirst.
procedure FindClose(
var F: TRawbyteSearchRec
);
Al igual que las funciones FindFirst y FindNext, el procedimiento FindClose recibe por referencia el registro TRawbyteSearchRec y finaliza la serie de llamadas FindFirst/FindNext. Siempre debe utilizarse para evitar fugas de memoria.
Como ejemplo tendremos un
TShellTreeView cuyo evento OnClick mostrará los archivos de la carpeta en un TMemo. Además un par de TCheckBox para mostrar u ocultar en el listado (TMemo) los archivos ocultos y/o subdirectorios o subcarpetas. Unos TLabel para información de la cantidad de archivos mostrados y su tamaño.
procedure TForm1.arbolClick(Sender: TObject);
begin
if not Assigned(arbol.Selected) then Exit;
Label1.Caption:=arbol.Path;
MostrarArchivos;
end;
La función
Assigned:
function Assigned(
P: Pointer
):Boolean;
Comprueba si el valor del puntero no es nil y devuelve TRUE, caso contrario devuelve FALSE. Sería lo mismo que:
if arbol.Selected=nil then Exit;
procedure TForm1.MostrarArchivos;
var
Arch:TSearchRec;
den:String='';
linea:String='';
begin
TotArchivos:=0;
TotCarpetas:=0;
TotTamanio:=0;
Memo1.Clear;
opciones:=GetOpciones;
case opciones of
0 : if FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit; //Si encontró devuelve 0 cero.
1 : if FindFirst(arbol.Path+'*',faDirectory,Arch)<>0 then Exit;
2 : if FindFirst(arbol.Path+'*',not faHidden and not faDirectory,Arch)<>0 then Exit;
3 : if FindFirst(arbol.Path+'*',faHidden and not faDirectory,Arch)<>0 then Exit;
end;
repeat
if ((Arch.Name<>'.') and (Arch.Name<>'..')) then
begin
linea:=Format('%0:-40s',[' '+Arch.Name]);
if (Arch.Attr and faDirectory)<>0 then
begin
linea:=linea+Format('%0:12s',['[Dir]']);
Inc(TotCarpetas);
end
else
begin
linea:=linea+Format('%8.2n',[Tamanio(den,Arch.Size)])+Format('%0:4s',[den]);
Inc(TotArchivos);
TotTamanio:=TotTamanio+Arch.Size;
end;
linea:=linea+Format('%0:20s',[DateTimeToStr(FileDateToDateTime(Arch.Time))]);
Memo1.Lines.Add(linea);
end;
lTotArch.Caption:=IntToStr(TotArchivos);
lTam.Caption:=FormatFloat('0.00',(Tamanio(den,TotTamanio)))+' '+den;
lTotSubDir.Caption:=IntToStr(TotCarpetas);
until FindNext(Arch)<>0;
FindClose(Arch);
end;
function TForm1.GetOpciones: Byte;
begin
if (cbDirectorios.Checked and cbOcultos.Checked) then Result:=0;
if (cbDirectorios.Checked and not(cbOcultos.Checked)) then Result:=1;
if ((not(cbDirectorios.Checked)) and (not(cbOcultos.Checked))) then Result:=2;
if ((not(cbDirectorios.Checked)) and cbOcultos.Checked) then Result:=3;
end;
Lo primero importante que hace el procedimiento MostrarArchivos es llamar a la función GetOpciones para saber la selección del usuario en cuanto a qué mostrar. Con el resultado obtenido se continúa con el CASE OF y la primera (y única) llamada a FindFirst, esto es importante, si debemos utilizar nuevamente FindFirst, antes debemos utilizar FindClose.
FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit;
He visto varios ejemplos así: If FindFirst('*',faAnyFile and faDirectory,... etc.
faAnyFile no es necesario.
Otra aclaración: es común pensar que FindFirst se fija en que se cumpla lo especificado en attr para devolver un resultado, pues esto no es tan así, attr son valores adicionales, significa que el resultado será un archivo normal o que tenga los atributos especificados en attr. Por eso, al llamar a FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch) si encuentra un archivo normal, devolverá 0 (cero) y el registro Arch con la información del mismo.
repeat
...
until FindNext(Arch)<>0;
FindClose(Arch);
Al primer ciclo de repeat until entramos con el registro que completó FindFirst, en las siguientes iteraciones lo hacemos con el registro que devolvió FindNext y finalmente cerramos la búsqueda. Todo esto se ejecuta cada vez que se cambia de directorio en el árbol (que solo muestra directorios).
Todo el código:
unit principal;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, LCLIntf, Graphics, Dialogs, ShellCtrls, Buttons,
StdCtrls, ComCtrls, ExtCtrls, Interfaces;
type
{ TForm1 }
TForm1 = class(TForm)
BSalir: TBitBtn;
cbOcultos: TCheckBox;
cbDirectorios: TCheckBox;
Label1: TLabel;
Label2: TLabel;
lTotArch: TLabel;
Label4: TLabel;
lTotSubDir: TLabel;
lTam: TLabel;
arbol: TShellTreeView;
Memo1: TMemo;
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
procedure arbolClick(Sender: TObject);
procedure BSalirClick(Sender: TObject);
procedure cbDirectoriosChange(Sender: TObject);
procedure cbOcultosChange(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure SetPath;
procedure MostrarArchivos;
{//0 Dir y Oc - 1 Dir - 2 No Dir y No Oc - 3 No Dir y Oc}
function GetOpciones:Byte;
function Tamanio(var sDenominacion: String; nByte: Int64):Single;
public
end;
var
Form1: TForm1;
APath:String;
ARoot:String;
ind:Integer;
opciones:Byte;
TotArchivos:Integer=0;
TotCarpetas:Integer=0;
TotTamanio:Int64=0;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
SetPath;
arbol.Path:=APath; //le agrega un pathdelimiter al final de aPath
MostrarArchivos;
Label1.Caption:=arbol.Path;
end;
procedure TForm1.MostrarArchivos;
var
Arch:TSearchRec;
den:String='';
linea:String='';
begin
TotArchivos:=0;
TotCarpetas:=0;
TotTamanio:=0;
Memo1.Clear;
opciones:=GetOpciones;
case opciones of
0 : if FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit; //Si encontró devuelve 0 cero.
1 : if FindFirst(arbol.Path+'*',faDirectory,Arch)<>0 then Exit;
2 : if FindFirst(arbol.Path+'*',not faHidden and not faDirectory,Arch)<>0 then Exit;
3 : if FindFirst(arbol.Path+'*',faHidden and not faDirectory,Arch)<>0 then Exit;
end;
repeat
if ((Arch.Name<>'.') and (Arch.Name<>'..')) then
begin
linea:=Format('%0:-40s',[' '+Arch.Name]);
if (Arch.Attr and faDirectory)<>0 then
begin
linea:=linea+Format('%0:12s',['[Dir]']);
Inc(TotCarpetas);
end
else
begin
linea:=linea+Format('%8.2n',[Tamanio(den,Arch.Size)])+Format('%0:4s',[den]);
Inc(TotArchivos);
TotTamanio:=TotTamanio+Arch.Size;
end;
linea:=linea+Format('%0:20s',[DateTimeToStr(FileDateToDateTime(Arch.Time))]);
Memo1.Lines.Add(linea);
end;
lTotArch.Caption:=IntToStr(TotArchivos);
lTam.Caption:=FormatFloat('0.00',(Tamanio(den,TotTamanio)))+' '+den;
lTotSubDir.Caption:=IntToStr(TotCarpetas);
until FindNext(Arch)<>0;
FindClose(Arch);
end;
function TForm1.GetOpciones: Byte;
begin
if (cbDirectorios.Checked and cbOcultos.Checked) then Result:=0;
if (cbDirectorios.Checked and not(cbOcultos.Checked)) then Result:=1;
if ((not(cbDirectorios.Checked)) and (not(cbOcultos.Checked))) then Result:=2;
if ((not(cbDirectorios.Checked)) and cbOcultos.Checked) then Result:=3;
end;
function TForm1.Tamanio(var sDenominacion: String; nByte: Int64): Single;
CONST
KBytes=1024;
MBytes=1024*1024;
GBytes=1024*1024*1024;
TBytes=1024*1024*1024*1024;
PBytes=1024*1024*1024*1024*1024;
begin
case nByte of
0..KBytes-1 : begin
sDenominacion:='B';
Result:=nByte;
end;
KBytes..MBytes-1 : begin
sDenominacion:='KB';
Result:=nByte/KBytes;
end;
MBytes..GBytes-1 : begin
sDenominacion:='MB';
Result:=nByte/MBytes;
end;
GBytes..TBytes-1 : begin
sDenominacion:='GB';
Result:=nByte/GBytes;
end;
TBytes..PBytes-1 : begin
sDenominacion:='TB';
Result:=nByte/TBytes;
end;
else
begin
sDenominacion:='??';
Result:=1;
end;
end;
end;
procedure TForm1.SetPath;
begin
{$IFDEF WINDOWS}
APath:=ExtractFilePath(Application.Location);
{$ELSE}
APath:=GetEnvironmentVariable('HOME');
ARoot:=APath;
//arbol.Root:=ARoot; Si queremos que la raíz del árbol sea la home del usuario.
{$ENDIF}
end;
procedure TForm1.BSalirClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.cbDirectoriosChange(Sender: TObject);
begin
MostrarArchivos;
end;
procedure TForm1.cbOcultosChange(Sender: TObject);
begin
MostrarArchivos;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:=caFree;
end;
procedure TForm1.arbolClick(Sender: TObject);
begin
if not Assigned(arbol.Selected) then Exit;
Label1.Caption:=arbol.Path;
MostrarArchivos;
end;
end.
Descargar todo el proyecto:
Mostrar archivos con FindFirst.7z
