[DELPHI] LISTANDO OS DIRETÓRIOS, SUBDIRETÓRIOS E OS ARQUIVOS

//uses SysUtils, Windows, FileCtrl

function TfrmWindows.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
      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);
    FindClose(Rec);
    dec(depth);
  end;
begin
  if (@lpFunc = nil) then
    exit;
  Cancel := false;
  count := 0; // total encontrado
  depth := 0; // profundidade da pesquisa na lista de diretórios
  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;

Procedure CallBack(FileName: string; Rec: PSearchRec; lpData: pointer; count, depth: cardinal; var Cancel: Boolean);
begin
  // filename = endereço completo
  // depth = profundidade da pesquisa na lista de diretórios
  // count = total encontrado
  // rec = item atual
  frmWindows.Memo1.Lines.Add(FileName + ' :: Prof = ' + inttostr(depth) + '  :: ' + ' count = ' + inttostr(count) + ' :: ' + ' rec = ' + Rec.Name + ' :: rec.size ::' + inttostr(Rec.Size));
  frmWindows.Caption := 'Profundidade = ' + inttostr(depth) + '  count = ' + inttostr(count);
end;

procedure TfrmWindows.btnSearchDirClick(Sender: TObject);
var
  path: string;
begin
  if SelectDirectory('Selecione uma pasta', 'C:\', path) then
  begin
    SearchDir(path, @CallBack, nil);
  end;
end;

Gostou? Deixe seu comentário... Convido você a seguir meu blog, sua presença é bem vinda!【ツ】

Nenhum comentário:

Postar um comentário