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

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

Добавлено: 04 Августа 2018 08:38:39 Добавил: Андрей Ковальчук Нравится 0

Добавить