> Maybe a little bit more:
>
> ide/cleandirdlg.pas
>
> function TCleanDirectoryDialog.SearchFilesToDelete(var List: TStrings):
> boolean;
>
> This will not only search recursively, it ahs an include and exclude
> filters.
> The central function is the sub function SearchInDirectory, which is
> probably what you are searching.
>
Thank you for this, it got me some of the way in fact, I started with
SearchFilesToDelete and began to try and abstract it into a general use
function (with which I will probably implement a component later) keeping
the source as intact as I could throughout.
First difficulty is that it uses a LOT of outside units which are not by
default in the path, adding synedit as a requirement got me some of the way
but there are at least one function I couldn't find at all
(SimpleSyntaxToRegExpr), and I have NO idea
what it is using macros for, or whether that is important, for now I commented
that line which still lets it compile.
So the thing compiles, I set up a small test project with a button and a memo
on the form, and hooked up this little onClick for the button to test:
procedure TForm1.Button1Click(Sender: TObject);
Var Files : TStringList;
begin
Files := TStringLIst.Create;
If SearchFiles(Files,'/home/silentcoder','*','*.txt') then
memo1.lines.assign (files);
Files.Free;
end;
Right now though, when I click the button, I get an exception:
TRegExpr(Comp):?+"(Follows nothing(pos 1).
(That by the way makes me think that the lack of
SimpleSyntaxToRegExpr is at fault)
===================
The stack trace output shows:
$08217DCC TREGEXPR__ERROR, line 4295 of synregexpr.pas
$08213D9D TREGEXPR__PARSEATOM, line 2771 of synregexpr.pas
$08212D76 TREGEXPR__PARSEPIECE, line 2252 of synregexpr.pas
$08212CA3 TREGEXPR__PARSEBRANCH, line 2154 of synregexpr.pas
$08212A88 TREGEXPR__PARSEREG, line 2086 of synregexpr.pas
$082127CD TREGEXPR__COMPILEREGEXPR, line 1980 of synregexpr.pas
$08212329 TREGEXPR__COMPILE, line 1763 of synregexpr.pas
$082123D5 TREGEXPR__ISPROGRAMMOK, line 1788 of synregexpr.pas
$08216324 TREGEXPR__EXECPRIM, line 3742 of synregexpr.pas
$08216300 TREGEXPR__EXEC, line 3730 of synregexpr.pas
$081E22A3 FILEMATCHES, line 63 of util.pas
$081E217E SEARCHINDIRECTORY, line 93 of util.pas
$081E1D5B SEARCHFILES, line 152 of util.pas
$08075CB7 TFORM1__BUTTON1CLICK, line 36 of unit1.pas
$081077F6 TCONTROL__CLICK, line 1859 of ./include/control.inc
$08157E5D TBUTTONCONTROL__CLICK, line 57 of ./include/buttoncontrol.inc
$081597F1 TCUSTOMBUTTON__CLICK, line 187 of ./include/buttons.inc
Here is my current uses:
uses
Classes, SysUtils,Process,IPHtml,Graphics, FileUtil,SynRegExpr;
And here is my resulting function so far:
function SearchFiles(var List: TStrings;DirName : String;filter,exclude :
String): boolean;
function SearchFiles(var List: TStrings;DirName : String;filter,exclude :
String): boolean;
var
RemoveFilterRegExpr: TRegExpr;
KeepFilterRegExpr: TRegExpr;
function FileMatches(const Filename: string): boolean;
var
ShortFilename: String;
begin
Result:=false;
ShortFilename:=ExtractFilename(Filename);
if (RemoveFilterRegExpr=nil)
or not RemoveFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
if (KeepFilterRegExpr<>nil)
and KeepFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
if FileIsText(Filename) then exit;
Result:=true;
end;
function SearchInDirectory(const MainDirectory: string;
Lvl: integer): boolean;
var
FileInfo: TSearchRec;
FullFilename: String;
begin
Result:=false;
if (not DirPathExists(MainDirectory)) or (Lvl>20) then exit;
if SysUtils.FindFirst(MainDirectory+GetAllFilesMask,
faAnyFile,FileInfo)=0
then begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
then continue;
FullFilename:=MainDirectory+FileInfo.Name;
if (FileInfo.Attr and faDirectory)>0 then begin
if true then begin
// search recursively
if not SearchInDirectory(AppendPathDelim(FullFilename),Lvl+1) then
break;
end;
end else begin
if FileMatches(FullFilename) then
List.Add(FullFilename);
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
Result:=true;
end;
function SetupFilter(var Filter: TRegExpr; SimpleSyntax: boolean;
const FilterAsText: string): boolean;
var
Expr: String;
begin
Result:=false;
if FilterAsText='' then begin
Filter:=nil;
Result:=true;
exit;
end;
Filter:=TRegExpr.Create;
// if SimpleSyntax then
// Expr:=SimpleSyntaxToRegExpr(FilterAsText)
// else
Expr:=FilterAsText;
try
Filter.Expression:=Expr;
Result:=true;
except
on E: Exception do begin
writeln('Invalid Mask',
'The mask "'+FilterAsText+'" is not a valid expression.');
end;
end;
end;
var
Directory: String;
begin
Result:=false;
RemoveFilterRegExpr:=nil;
KeepFilterRegExpr:=nil;
List:=nil;
try
// get directory
Directory:=DirName;
//if (Macros<>nil) and (not Macros.SubstituteStr(Directory)) then exit;
Directory:=AppendPathDelim(Directory);
// setup filters
SetupFilter(RemoveFilterRegExpr,false,
Filter);
if length(exclude) <> 0 then
SetupFilter(KeepFilterRegExpr,false,
exclude);
// search files
List:=TStringList.Create;
if not SearchInDirectory(Directory,0) then exit;
Result:=true;
finally
RemoveFilterRegExpr.Free;
//KeepFilterRegExpr.Free;
if not Result then begin
List.Free;
List:=nil;
end;
end;
end;
=====================
Any idea what else I need to change to make this general-use version
of the function work ?
Ciao
A.J.
--
A.J. Venter
Chief Software Architect, OpenLab International
www.getopenlab.com
+27 82 726 5103
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
