Хотя я и не очень хороший "Делфер", но я очень люблю программировать в Delphi, делать маленькие полезные программки для себя и своего компьютера. Недавно я узнал как производить поиск файлов на компьютере, причем поиск файлов производится не в отдельном каталоге, а на всем винчестере и в процессе поиска возможно следить за поиском. Процедуре поиска я нашел очень широкое применение, например, у меня на компьютере имеется папка с исходниками по Delphi и в этой папки очень много лишних файлов, которые занимают место на винчестере и при помощи процедуры поиска я удаляю ненужные файлы (*.cfg; *.~dfm; *.~pas и др.).

Начнем с описания процедуры FindResursive( Const path: String; Const mask: String) где переменная Path - каталог в котором будет производится поиск ('c:\'), а Mask - название файла или его часть ('*.exe' или '*.*' или 'project.dpr'). 

В самой процедуре будем использовать только одну (не считая вложенные функции)переменную, которая будет носить полное название  найденного файла. А найденные файлы будем записывать в ListBox. Данную процедуру будем вызывать при нажатии кнопки. Процедура FindRecursive выглядит следующим образом: 

Procedure FindRecursive( Const path: String; Const mask: String);
 Var
 fullpath: String;
 Function Recurse( Var path: String; Const mask: String ): Boolean;
 Var
 SRec: TSearchRec;
 retval: Integer;
 oldlen: Integer;
 Begin
 Recurse := True;
 oldlen := Length( path );
 retval := FindFirst( path+mask, faAnyFile, SRec );
 While retval = 0 Do Begin
 If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
 form1.ListBox1.items.Add(path+srec.name);
 retval := FindNext( SRec );
 End;
 FindClose( SRec );
 If not Result Then Exit;
 retval := FindFirst( path+'*.*', faDirectory, SRec );
 While retval = 0 Do Begin
 If (SRec.Attr and faDirectory) <> 0 Then
 If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin
 path := path + SRec.Name + '\';
 If not Recurse( path, mask ) Then Begin
 Result := False;
 Break;
 End;
 Delete( path, oldlen+1, 255 );
 End;
 retval := FindNext( SRec );
 End;
 FindClose( SRec );
 End; { Recurse }
 Begin
 If path = '' Then
 GetDir(0, fullpath)
 Else
 fullpath := path;
 If fullpath[Length(fullpath)] <> '\' Then
 fullpath := fullpath + '\';
 If mask = '' Then
 Recurse( fullpath, '*.*' )
 Else
 Recurse( fullpath, mask );
 End;

В целом же программа выглядит так:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
 ListBox1: TListBox;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
Procedure FindRecursive( Const path: String; Const mask: String);
 Var
 fullpath: String;
 Function Recurse( Var path: String; Const mask: String ): Boolean;
 Var
 SRec: TSearchRec;
 retval: Integer;
 oldlen: Integer;
 Begin
 Recurse := True;
 oldlen := Length( path );
 retval := FindFirst( path+mask, faAnyFile, SRec );
 While retval = 0 Do Begin
 If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
 form1.ListBox1.items.Add(path+srec.name); {добавление}
 {очередного найденного файла в ListBox}
 {-------------------------------------}
 {здесь можно производить слежением за выполнение процедуры}
 {например, поставить ProgressBar}
 retval := FindNext( SRec );
 End;
 FindClose( SRec );
 If not Result Then Exit;
 retval := FindFirst( path+'*.*', faDirectory, SRec );
 While retval = 0 Do Begin
 If (SRec.Attr and faDirectory) <> 0 Then
 If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin
 path := path + SRec.Name + '\';
 If not Recurse( path, mask ) Then Begin
 Result := False;
 Break;
 End;
 Delete( path, oldlen+1, 255 );
 End;
 retval := FindNext( SRec );
 End;
 FindClose( SRec );
 End; { Recurse }
 Begin
 If path = '' Then
 GetDir(0, fullpath)
 Else
 fullpath := path;
 If fullpath[Length(fullpath)] <> '\' Then
 fullpath := fullpath + '\';
 If mask = '' Then
 Recurse( fullpath, '*.*' )
 Else
 Recurse( fullpath, mask );
 End;


procedure TForm1.Button1Click(Sender: TObject);
begin
FindRecursive('d:\','*.*'); {вместо 'd:\' можно написать лубой каталог}
end;

Автор: Михаил Христосенко

Получить ссылку на материал