Поиск файлов на винчестере в Delphi

Хотя я и не очень хороший "Делфер", но я очень люблю программировать в 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;

end.

Источник: http://delphid.dax.ru

16.02.2006