Pesquisa em diretório e subdiretórios

[Thales Pontes Martins]

Pesquisa em diretório e subdiretórios:

Muitas pessoas precisam de fazer operações em arquivos de uma pasta e também subpastas então aqui está um procedimento que faz uma busca num diretório e notifica uma função de callback com os dados necessários ->

uses SysUtils, Windows;

type
  PSearchRec = ^TSearchRec;
  TSearchDirCallBack =
  Procedure(FileName : string; Rec : PSearchRec; lpData : pointer;
            count, depth : cardinal; var Cancel : Boolean);
function SearchDir(Dir : String; lpFunc : TSearchDirCallBack; lpData : pointer) : cardinal;

implementation

function SearchDir(Dir : String; lpFunc: TSearchDirCallBack; lpData : pointer) : cardinal;
var
  depth, count : cardinal;
  cancel : boolean;

function vldir(dr : string) : boolean;
begin
  result:=((trim(dr) <> '..') and (trim(dr) <> '.'));
end;

procedure Search(dirname : string);
var
  rec : TSearchRec;
begin
  if (cancel) then exit;
  inc(depth);
  if (FindFirst(dirname+'\*',faReadOnly or faanyfile or favolumeid or
  faHidden or faSysFile or faDirectory or faArchive,rec)<>0) then
  begin
    SysUtils.FindClose(rec);
    dec(depth);
    exit;
  end;
  repeat
    if ((rec.Attr and fadirectory)<>0) then
    begin
      if vldir(rec.Name) then
      Search(dirname+'\'+rec.name);
    end;
    inc(count);
    if (vldir(rec.Name)) then
    lpFunc(dirname+'\'+rec.Name,@rec,lpData,count,depth,cancel);
    if (cancel) then break;
  until (findnext(rec) <> 0);
  SysUtils.FindClose(rec);
  dec(depth);
end;

begin
  if (@lpFunc = nil) then exit;
  cancel:=false;
  count:=0;
  depth:=0;
  while (dir[length(dir)] = '\') or (dir[length(dir)] = '/')
  do delete(dir,length(dir),1);
  if not(Directoryexists(dir)) then
  begin
    result:=1;
    exit;
  end;
  Search(dir);
  if (count = 0) then result:=2 else result:=0;
end;

Parametros: Dir : String, diretório onde se vai fazer a busca. lpFunc : TSearchDirCallBack, endereço do procedimento que será notificado a cada arquivo encontrado. lpData : Pointer, qualquer ponteiro para quaisquer dados que se queira que a função passe para a função de CallBack, pode ser nil. Valor de retorno: 0 : A busca foi executada com sucesso. 1 : Diretório passado como parametro não existente. 2 : Nenhum arquivo encontrado dentro do diretório. A função de CallBack: Procedure(FileName : string; Rec : PSearchRec; lpData : pointer; count, depth : cardinal; var Cancel : Boolean); Parametros: FileName : String, Nome do arquivo encontrado com caminho completo. Rec : PSearchRec, Ponteiro para uma estrutura TSearchRec na qual está sendo executada a busca. lpData : Pointer, 3º parametro da função SearchDir repassado. count : Cardinal, Quantos arquivos já foram achados. depth : Cardinal, Profundidade atual da busca. cancel : Boolean, Variável booleana que indica se a busca deve ser cancelada, se quiser cancelar é só colocar cancel:=true;. Exemplo de uso ->

Procedure CallBack(FileName : string; Rec : PSearchRec; lpData : pointer;
            count, depth : cardinal; var Cancel : Boolean);
begin
  Form1.Memo1.Lines.Add(FileName);
  Form1.Caption:='depth = '+inttostr(depth)+'       count = '+inttostr(count);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SearchDir('C:\windows',@CallBack,nil);
end;

Esse código aí enche o memo do form com todos os arquivos dentro da pasta windows e subpastas. Se você colocar c:\Arquivos de programas vai ficar 3 horas vendo nome, e se colocar c:, pode sair pra dar uma volta e voltar quando o mundo tiver acabado que talvez já tenha terminado. Inclusive com isso pode-se fácilmente fazer uma pesquisa que nem a do windows, iniciar->pesquisar.

Não sei se isso já existia em alguma unit do Delphi. Não que eu visse.

Autor: Thales Pontes Martins.

Abraço.