Jump to content
Fórum Script Brasil
  • 0

Pesquisa em diretório e subdiretórios


Thales Pontes Martins
 Share

Question

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.

Link to comment
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      151k
    • Total Posts
      649.1k
×
×
  • Create New...