Поиск файлов на винчестере в Delphi 
 


 delphid.dax.ru 
 WinSov.com 


Хотя я и не очень хороший "Делфер", но я очень люблю программировать в 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.
 