Q: I need to process certain files (*.ssd) in a user selected directory and every nested directory thereafter using Delphi. Anyone has any pointers to give me? What calls to use (my main concern is how to recognize a subdirectory while scanning a directory), may be a fragment of code that does something similar?
A: FindFirst and FindNext are the key functions. Here is an implementation of their use:
unit Dirlist1;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) ListBox1: TListBox; Edit1: TEdit; Label1: TLabel; Label2: TLabel; Edit2: TEdit; Button1: TButton; Button2: TButton; procedure Button2Click(Sender: TObject); procedure Button1Click(Sender: TObject); private Function LogFiles( Const path: String; Const SRec: TSearchRec ): Boolean; { Private-Declaration } public { Public-Declaration } end;
var
Form1: TForm1;
implementation
Type TLogFunct = Function( Const path: String; Const SRec: TSearchRec ): Boolean of Object; {$R *.DFM}
Procedure FindRecursive( Const path: String; Const mask: String; LogFunction: TLogFunct ); 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 ); (* phase 1, look for normal files *) retval := FindFirst( path+mask, faAnyFile, SRec ); While retval = 0 Do Begin If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then (* we found a file, not a directory or volume label, log it. Bail out if the log function returns false. *) If not LogFunction( path, SRec ) Then Begin Result := False; Break; End;
retval := FindNext( SRec ); End; FindClose( SRec ); If not Result Then Exit;
(* Phase II, look for subdirectories and recurse thru them *) retval := FindFirst( path+'*.*', faDirectory, SRec ); While retval = 0 Do Begin If (SRec.Attr and faDirectory) < > 0 Then (* we have a directory *) 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; 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;
Function TForm1.LogFiles( Const path: String; Const SRec: TSearchRec ): Boolean; Begin Listbox1.Items.Add( path+SRec.Name ); Result := True; (* proceeed with recursion *) End;
procedure TForm1.Button2Click(Sender: TObject); begin Application.Terminate; end;
procedure TForm1.Button1Click(Sender: TObject); begin ListBox1.Clear; Listbox1.Perform( WM_SETREDRAW, 0, 0 ); FindRecursive( Edit1.Text, Edit2.Text, LogFiles ); Listbox1.Perform( WM_SETREDRAW, 1, 0 );
Listbox1.Refresh; end;
end.
---- dirlist1.dfm -----
object Form1: TForm1 Left = 260 Top = 222 Width = 642 Height = 300 Caption = 'Recursive Directory Scan' Font.Color = clWindowText Font.Height = -17 Font.Name = 'System' Font.Style = [] PixelsPerInch = 120 Position = poScreenCenter TextHeight = 20 object Label1: TLabel Left = 480 Top = 24 Width = 116 Height = 20 Caption = '&Path to search'
FocusControl = Edit1 end object Label2: TLabel Left = 480 Top = 96 Width = 74 Height = 20 Caption = '&File Mask' FocusControl = Edit2 end object ListBox1: TListBox Left = 16 Top = 24 Width = 449 Height = 225 ItemHeight = 20 TabOrder = 0 end object Edit1: TEdit Left = 480 Top = 48 Width = 137 Height = 29 TabOrder = 1 end object Edit2: TEdit Left = 480 Top = 120
Width = 137 Height = 29 TabOrder = 2 end object Button1: TButton Left = 480 Top = 168 Width = 137 Height = 33 Caption = '&Search' Default = True TabOrder = 3 OnClick = Button1Click end object Button2: TButton Left = 480 Top = 216 Width = 137 Height = 33 Caption = 'Close' TabOrder = 4 OnClick = Button2Click end end
|