Advertisement
miguelhosttimer

fazer buscar disco c

May 19th, 2024
123
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.41 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.   Synchronize(procedure begin Form1.Button1.Enabled := False; end);
  96.   FindFiles(FFileName, FSearchPath);
  97.   Synchronize(UpdateUI);
  98.   Synchronize(procedure begin Form1.Button1.Enabled := True; end);
  99. end;
  100.  
  101. procedure TSearchThread.UpdateUI;
  102. var
  103.   i: Integer;
  104. begin
  105.   for i := 0 to FFoundFiles.Count - 1 do
  106.   begin
  107.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' encontrado ' + FFoundFiles[i]);
  108.   end;
  109.   if FFoundFiles.Count = 0 then
  110.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' não encontrado.');
  111.  
  112.   // Atualize o Label2 com a quantidade de arquivos encontrados
  113.   Form1.Label2.Caption := 'Quantidade de arquivos encontrados: ' + IntToStr(FFoundFiles.Count);
  114. end;
  115.  
  116. procedure TSearchThread.UpdateStatus;
  117. begin
  118.   Form1.Label1.Caption := FStatusText;
  119. end;
  120.  
  121. { TForm1 }
  122.  
  123. procedure TForm1.Button1Click(Sender: TObject);
  124. begin
  125.   FSearchThread := TSearchThread.Create(Edit1.Text, 'C:\');
  126. end;
  127.  
  128. procedure TForm1.FormCreate(Sender: TObject);
  129. begin
  130.   FSearchThread := nil;
  131. end;
  132.  
  133. procedure TForm1.FormDestroy(Sender: TObject);
  134. begin
  135.   if Assigned(FSearchThread) then
  136.   begin
  137.     FSearchThread.Terminate;
  138.     FSearchThread := nil;
  139.   end;
  140. end;
  141.  
  142. end.
  143.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement