Хотя я и не очень хороший "Делфер", но я очень люблю программировать в Delphi, делать маленькие полезные программки для себя и своего компьютера. Недавно я узнал как производить поиск файлов на компьютере, причем поиск файлов производится не в отдельном каталоге, а на всем винчестере и в процессе поиска возможно следить за поиском. Процедуре поиска я нашел очень широкое применение, например, у меня на компьютере имеется папка с исходниками по Delphi и в этой папки очень много лишних файлов, которые занимают место на винчестере и при помощи процедуры поиска я удаляю ненужные файлы (*.cfg; *.~dfm; *.~pas и др.).
Начнем с описания процедуры FindResursive( Const path: String; Const mask: String) где переменная Path - каталог в котором будет производится поиск ('c:'), а Mask - название файла или его часть ('*.exe' или '*.*' или 'project.dpr').
В самой процедуре будем использовать только одну (не считая вложенные функции)переменную, которая будет носить полное название найденного файла. А найденные файлы будем записывать в ListBox. Данную процедуру будем вызывать при нажатии кнопки.
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;
end.
|