{-----------------------------------------------------------------------------
   Unit Name: RecurseDir
   Purpose  : Help recursing files
   Author   : Vesa Lappalainen
   Date     : 19.6.2002
   Changed  :
   Todo     :
-----------------------------------------------------------------------------}

unit RecurseDir;

interface

type TRecurseScanProc = procedure (name:string;var cont:boolean;obj:TObject);

procedure ScanFilesRecurse(dir:string;mask:string;proc:TRecurseScanProc;obj:TObject=nil);
procedure ScanFiles(dir:string;mask:string;proc:TRecurseScanProc;obj:TObject=nil);

procedure DeleteFiles(dir:string;mask:string);
procedure DeleteFilesRecurse(dir:string;mask:string);
function FindOneFile(dir:string;mask:string):string;
function FindLastFileRecurse(dir:string; mask:string):string;


implementation
uses SysUtils,kstring;


procedure DoOneDirPureMask(dir:string;mask:string;proc:TRecurseScanProc;var cont:boolean;obj:TObject=nil);
var sr: TSearchRec;
begin
try
  if FindFirst(dir+'\'+mask,faAnyFile,sr) <> 0 then exit;
  repeat
    proc(dir+'\'+sr.Name,cont,obj);
    if ( not cont ) then break;
  until (FindNext(sr) <> 0);
finally FindClose(sr); end;
end;

procedure DoOneDir(dir:string;mask:string;proc:TRecurseScanProc;var cont:boolean;obj:TObject=nil);
var puremask : string;
begin
  while ( mask <> '' ) do begin
    puremask := Separate(mask,';');
    DoOneDirPureMask(dir,puremask,proc,cont,obj);
  end;
end;


procedure DoScanFilesRecurse(dir:string;mask:string;proc:TRecurseScanProc;var cont:boolean;obj:TObject=nil);
var sr: TSearchRec;
begin
  DoOneDir(dir,mask,proc,cont,obj);
  if ( not cont ) then exit;
try
  if FindFirst(dir+'\*.*',faAnyFile,sr) <> 0 then exit;
  repeat
    if ( sr.Name <> '.' ) and ( sr.Name <> '..' ) and ( sr.Attr And faDirectory = faDirectory ) then
      DoScanFilesRecurse(dir+'\'+sr.Name,mask,proc,cont,obj);
      if ( not cont ) then break;
  until FindNext(sr) <> 0;
finally FindClose(sr);end;
end;

procedure ScanFilesRecurse(dir:string;mask:string;proc:TRecurseScanProc;obj:TObject=nil);
var cont:boolean;
begin
  cont := true;
  DoScanFilesRecurse(dir,mask,proc,cont,obj);
end;

procedure ScanFiles(dir:string;mask:string;proc:TRecurseScanProc;obj:TObject=nil);
var cont:boolean;
begin
  cont := true;
  DoOneDir(dir,mask,proc,cont,obj);
end;

procedure DeleteOneFile(name:string;var cont:boolean;obj:TObject);
begin
  DeleteFile(name);
end;

procedure DeleteFiles(dir:string;mask:string);
begin
  ScanFiles(dir,mask,DeleteOneFile);
end;

procedure DeleteFilesRecurse(dir:string;mask:string);
begin
  ScanFilesRecurse(dir,mask,DeleteOneFile);
end;

type TOneFile = class
       name:string;
       date: TDateTime;
     end;

procedure FoundOneFile(name:string;var cont:boolean;obj:TObject);
begin
  TOneFile(obj).name := name;
  cont := false;
end;

function FindOneFile(dir:string;mask:string):string;
var ofile : TOneFile;
begin
  Result := '';
  ofile := TOneFile.Create;
  ofile.name := '';
  ScanFilesRecurse(dir,mask,FoundOneFile,ofile);
  Result := ofile.name;
  ofile.Free;
end;


procedure CheckLastOneFile(name:string;var cont:boolean;obj:TObject);
var di : integer; f : TOneFile; d :TDateTime;
begin
  di := FileAge(name);
  if ( di < 0 ) then exit;
  d := FileDateToDateTime(di);
  f := TOneFile(obj);
  if ( d > f.date ) then begin
    f.date := d;
    f.name := name;
  end;
end;

function FindLastFileRecurse(dir:string; mask:string):string;
var last : TOneFile;
begin
  last := TOneFile.Create;
  last.name := '';
  last.date := 0;
  ScanFilesRecurse(dir,mask,CheckLastOneFile,last);
  Result := last.name;
  last.Free;
end;

end.