Advertisement
miguelhosttimer

dazer buscar em todo hd delphi arquivo

May 19th, 2024
125
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.28 KB | None | 0 0
  1.  unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.Dialogs, Vcl.ExtCtrls, ShellAPI;
  8.  
  9. type
  10.   TSearchThread = class(TThread)
  11.   private
  12.     FFileName: string;
  13.     FSearchPath: string;
  14.     FFoundFiles: TStringList;
  15.     FStatusText: string;
  16.     FDirectoriesSearched: Integer;
  17.     procedure UpdateUI;
  18.     procedure UpdateStatus;
  19.     procedure FindFiles(const FileName, SearchPath: string);
  20.   protected
  21.     procedure Execute; override;
  22.   public
  23.     constructor Create(const FileName, SearchPath: string);
  24.     destructor Destroy; override;
  25.   end;
  26.  
  27.   TForm1 = class(TForm)
  28.     Button1: TButton;
  29.     Edit1: TEdit;
  30.     Memo1: TMemo;
  31.     Label1: TLabel;
  32.     Label2: TLabel;  // Adicione este rótulo ao seu formulário
  33.     procedure Button1Click(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormDestroy(Sender: TObject);
  36.   private
  37.     FSearchThread: TSearchThread;
  38.   public
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44. implementation
  45.  
  46. {$R *.dfm}
  47.  
  48. { TSearchThread }
  49.  
  50. constructor TSearchThread.Create(const FileName, SearchPath: string);
  51. begin
  52.   inherited Create(False);
  53.   FreeOnTerminate := True;
  54.   FFileName := FileName;
  55.   FSearchPath := SearchPath;
  56.   FDirectoriesSearched := 0;
  57.   FFoundFiles := TStringList.Create;
  58. end;
  59.  
  60. destructor TSearchThread.Destroy;
  61. begin
  62.   FFoundFiles.Free;
  63.   inherited;
  64. end;
  65.  
  66. procedure TSearchThread.FindFiles(const FileName, SearchPath: string);
  67. var
  68.   SR: TSearchRec;
  69. begin
  70.   if FindFirst(SearchPath + '*' + FileName + '*', faAnyFile, SR) = 0 then
  71.   begin
  72.     repeat
  73.       FFoundFiles.Add(SearchPath + SR.Name);
  74.     until FindNext(SR) <> 0;
  75.   end;
  76.   FindClose(SR);
  77.  
  78.   if FindFirst(SearchPath + '*.*', faDirectory, SR) = 0 then
  79.   begin
  80.     repeat
  81.       if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
  82.       begin
  83.         Inc(FDirectoriesSearched);
  84.         FStatusText := 'Procurando em: ' + SearchPath + SR.Name;
  85.         Synchronize(UpdateStatus);
  86.         FindFiles(FileName, SearchPath + SR.Name + '\');
  87.       end;
  88.     until FindNext(SR) <> 0;
  89.   end;
  90.   FindClose(SR);
  91. end;
  92.  
  93. procedure TSearchThread.Execute;
  94. begin
  95.   FindFiles(FFileName, FSearchPath);
  96.   Synchronize(UpdateUI);
  97. end;
  98.  
  99. procedure TSearchThread.UpdateUI;
  100. var
  101.   i: Integer;
  102. begin
  103.   for i := 0 to FFoundFiles.Count - 1 do
  104.   begin
  105.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' encontrado ' + FFoundFiles[i]);
  106.   end;
  107.   if FFoundFiles.Count = 0 then
  108.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' não encontrado.');
  109.  
  110.   // Atualize o Label2 com a quantidade de arquivos encontrados
  111.   Form1.Label2.Caption := 'Quantidade de arquivos encontrados: ' + IntToStr(FFoundFiles.Count);
  112. end;
  113.  
  114. procedure TSearchThread.UpdateStatus;
  115. begin
  116.   Form1.Label1.Caption := FStatusText;
  117. end;
  118.  
  119. { TForm1 }
  120.  
  121. procedure TForm1.Button1Click(Sender: TObject);
  122. begin
  123.   FSearchThread := TSearchThread.Create(Edit1.Text, 'C:\');
  124. end;
  125.  
  126. procedure TForm1.FormCreate(Sender: TObject);
  127. begin
  128.   FSearchThread := nil;
  129. end;
  130.  
  131. procedure TForm1.FormDestroy(Sender: TObject);
  132. begin
  133.   if Assigned(FSearchThread) then
  134.   begin
  135.     FSearchThread.Terminate;
  136.     FSearchThread := nil;
  137.   end;
  138. end;
  139.  
  140. end.
  141.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement