Advertisement
miguelhosttimer

procurar arquivo em todo hd unidade c

May 16th, 2024
105
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 2.92 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, Vcl.ComCtrls;
  8.  
  9. type
  10.   TSearchThread = class(TThread)
  11.   private
  12.     FFileName: string;
  13.     FSearchPath: string;
  14.     FFoundPath: string;
  15.     FStatusText: string;
  16.     procedure UpdateUI;
  17.     procedure UpdateStatus;
  18.     function FindFile(const FileName, SearchPath: string): string;
  19.   protected
  20.     procedure Execute; override;
  21.   public
  22.     constructor Create(const FileName, SearchPath: string);
  23.   end;
  24.  
  25.   TForm1 = class(TForm)
  26.     Button1: TButton;
  27.     Edit1: TEdit;
  28.     Memo1: TMemo;
  29.     ProgressBar1: TProgressBar;
  30.     Label1: TLabel;
  31.     procedure Button1Click(Sender: TObject);
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure FormDestroy(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.     FSearchThread: TSearchThread;
  37.   public
  38.     { Public declarations }
  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. end;
  57.  
  58. function TSearchThread.FindFile(const FileName, SearchPath: string): string;
  59. var
  60.   SR: TSearchRec;
  61. begin
  62.   Result := '';
  63.   if FindFirst(SearchPath + '*' + FileName + '*', faAnyFile, SR) = 0 then
  64.   begin
  65.     Result := SearchPath + SR.Name;
  66.   end;
  67.   FindClose(SR);
  68.  
  69.   if Result = '' then
  70.   begin
  71.     if FindFirst(SearchPath + '*.*', faDirectory, SR) = 0 then
  72.     begin
  73.       repeat
  74.         if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
  75.         begin
  76.           FStatusText := 'Procurando em: ' + SearchPath + SR.Name;
  77.           Synchronize(UpdateStatus);
  78.           Result := FindFile(FileName, SearchPath + SR.Name + '\');
  79.           if Result <> '' then Break;
  80.         end;
  81.       until FindNext(SR) <> 0;
  82.     end;
  83.     FindClose(SR);
  84.   end;
  85. end;
  86.  
  87. procedure TSearchThread.Execute;
  88. begin
  89.   FFoundPath := FindFile(FFileName, FSearchPath);
  90.   Synchronize(UpdateUI);
  91. end;
  92.  
  93. procedure TSearchThread.UpdateUI;
  94. begin
  95.   if FFoundPath <> '' then
  96.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' foi encontrado em ' + FFoundPath)
  97.   else
  98.     Form1.Memo1.Lines.Add('O arquivo ' + FFileName + ' não foi encontrado.');
  99. end;
  100.  
  101. procedure TSearchThread.UpdateStatus;
  102. begin
  103.   Form1.Label1.Caption := FStatusText;
  104. end;
  105.  
  106. { TForm1 }
  107.  
  108. procedure TForm1.Button1Click(Sender: TObject);
  109. begin
  110.   FSearchThread := TSearchThread.Create(Edit1.Text, 'C:\');
  111. end;
  112.  
  113. procedure TForm1.FormCreate(Sender: TObject);
  114. begin
  115.   FSearchThread := nil;
  116. end;
  117.  
  118. procedure TForm1.FormDestroy(Sender: TObject);
  119. begin
  120.   if Assigned(FSearchThread) then
  121.   begin
  122.     FSearchThread.Terminate;
  123.     FSearchThread := nil;
  124.   end;
  125. end;
  126.  
  127. end.
  128.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement