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:\myfile.log');
  List1.Free;
end;
end.
KLOPEKSAsked:
Who is Participating?
 
MikProgCommented:

   procedure SeekAndDestroy(PathList, Extensions: TStrings) :)
   var
     Subpaths: TStringList;
          procedure GetFileList(Path);
          var
             List1: TStringList;
             List2 : TStringList;
         begin
           List1:= TStringList.Create;
          {fill list1 with filenames using Path and  Extension variable}
           List2:= TStringList.Create;
           List2.CommaText := ProcessFiles(List1);
           List2.SaveToFile('c:\myfile.log');
           List1.Free;
           List2.Free;
          end;
  begin
   { For Each PathList string }
      GetFileList(PathList[i])  
      Subpaths:=TStringList.Create;
      {Fill Subpaths with subdirs names of PathList[i] directory}
      SeekAndDestroy(Subpaths,Extensions);
  end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    List1: TStringList;
    List2 : TStringList;
begin
{Fill List1 with path's to search. Noone of them can't be sub of another}
{Fill List2 with extensions}
  SeekAndDestroy(List1, List2);
end.
0
 
esoftbgCommented:
What you want is very close to:
http://experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20932619.html

Download from:        http://www.geocities.com/esoftbg/ee/Q_20932619.zip working example of above question
0
 
kretzschmarCommented:
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],faanyfile,srec) = 0 then
    begin
    repeat
      If Not(srec.attr and fadirectory > 0) then
      begin
        ResultList.Add(Path+SRec.Name)
      end;
    Until findnext(srec) <> 0;
    end;
    FindClose(SRec);
    { SubDirectories }
    If IncludeSubDirs then
    begin
    if FindFirst(Path+'*.*',FaAnyFile,Srec) = 0 then
    begin
      repeat
        // StartRecursion
        if not(Srec.Name[1] = '.') and (srec.attr and fadirectory > 0)then
          FindFile(Path + Srec.Name + '\' + FileName,IncludeSubDirs,FileMasks,ResultList)
      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.Checked,memo1.lines,listbox1.items);
    showmessage(inttostr(listbox1.Items.Count)+' files found');
  end;
end;

end.

meikl ;-)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.