KLOPEKS
asked on
how do i do this?
I have a procedure that checks a directory for files with a certain extension, it reads the file and saves contents to another file, how do i efficiently arrange this to check multiple directorys for multiple extensions?
procedure TForm1.Button1Click(Sender : TObject);
var
List1: TStringList;
List2 : TStringList;
begin
List1:= TStringList.Create;
List2:= TStringList.Create;
GetFileList(List1, 'C:\', 'TXT*');
List2.CommaText := ProcessFiles(List1);
List2.SaveToFile('c:\myfil e.log');
List1.Free;
end;
end.
procedure TForm1.Button1Click(Sender
var
List1: TStringList;
List2 : TStringList;
begin
List1:= TStringList.Create;
List2:= TStringList.Create;
GetFileList(List1, 'C:\', 'TXT*');
List2.CommaText := ProcessFiles(List1);
List2.SaveToFile('c:\myfil
List1.Free;
end;
end.
an older sample
which can use multiple filemasks
unit filesearch_with_masks_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
ListBox1: TListBox;
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses filectrl; //just for selectdirectory
procedure FindFile(APath : string;
IncludeSubDirs : Boolean;
FileMasks : TStrings;
ResultList : Tstrings
);
var
srec : TSearchRec;
Path, FileName : String;
i : integer;
begin
path := APath;
if path[length(path)] <> '\' then
path := path + '\';
if not assigned(FileMasks) then
raise exception.Create('No Masks given');
if not assigned(ResultList) then
raise exception.Create('No ResultContainer given');
for i := 0 to filemasks.Count - 1 do
begin
// CurrentDirectory
if findfirst(Path+filemasks[i ],faanyfil e,srec) = 0 then
begin
repeat
If Not(srec.attr and fadirectory > 0) then
begin
ResultList.Add(Path+SRec.N ame)
end;
Until findnext(srec) <> 0;
end;
FindClose(SRec);
{ SubDirectories }
If IncludeSubDirs then
begin
if FindFirst(Path+'*.*',FaAny File,Srec) = 0 then
begin
repeat
// StartRecursion
if not(Srec.Name[1] = '.') and (srec.attr and fadirectory > 0)then
FindFile(Path + Srec.Name + '\' + FileName,IncludeSubDirs,Fi leMasks,Re sultList)
Until findnext(srec) <> 0;
end;
FindClose(SRec);
end;
end;
end;
//usage sample
procedure TForm1.Button1Click(Sender : TObject);
var path : String;
begin
if selectDirectory('Select Directory','',path) then
begin
listbox1.Items.Clear;
findfile(path,checkbox1.Ch ecked,memo 1.lines,li stbox1.ite ms);
showmessage(inttostr(listb ox1.Items. Count)+' files found');
end;
end;
end.
meikl ;-)
which can use multiple filemasks
unit filesearch_with_masks_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
ListBox1: TListBox;
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses filectrl; //just for selectdirectory
procedure FindFile(APath : string;
IncludeSubDirs : Boolean;
FileMasks : TStrings;
ResultList : Tstrings
);
var
srec : TSearchRec;
Path, FileName : String;
i : integer;
begin
path := APath;
if path[length(path)] <> '\' then
path := path + '\';
if not assigned(FileMasks) then
raise exception.Create('No Masks given');
if not assigned(ResultList) then
raise exception.Create('No ResultContainer given');
for i := 0 to filemasks.Count - 1 do
begin
// CurrentDirectory
if findfirst(Path+filemasks[i
begin
repeat
If Not(srec.attr and fadirectory > 0) then
begin
ResultList.Add(Path+SRec.N
end;
Until findnext(srec) <> 0;
end;
FindClose(SRec);
{ SubDirectories }
If IncludeSubDirs then
begin
if FindFirst(Path+'*.*',FaAny
begin
repeat
// StartRecursion
if not(Srec.Name[1] = '.') and (srec.attr and fadirectory > 0)then
FindFile(Path + Srec.Name + '\' + FileName,IncludeSubDirs,Fi
Until findnext(srec) <> 0;
end;
FindClose(SRec);
end;
end;
end;
//usage sample
procedure TForm1.Button1Click(Sender
var path : String;
begin
if selectDirectory('Select Directory','',path) then
begin
listbox1.Items.Clear;
findfile(path,checkbox1.Ch
showmessage(inttostr(listb
end;
end;
end.
meikl ;-)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
https://www.experts-exchange.com/questions/20932619/Search-Replace.html
Download from: http://www.geocities.com/esoftbg/ee/Q_20932619.zip working example of above question