unit MyParser;
interface
uses Windows, Classes, SysUtils, Masks, Forms;
type
EFileFound =
procedure (Search: TSearchRec;
Name:
String)
of object;
EPathEnter =
procedure (Search: TSearchRec; Path:
String;
var DoThis:Boolean)
of object;
EPathExit =
procedure of object;
TFileParser =
class(TComponent)
private
Running :Boolean;
FFiles :
String;
FFileFound :EFileFound;
procedure SetFiles(Value:
String);
protected
procedure Parse(Path:
String);
virtual;
public
constructor Create(AOwner: TComponent);
override;
procedure Execute(Path:
String);
procedure Terminate;
published
property Files :
String read FFiles
write SetFiles;
property OnFileFound:EFileFound
read FFileFound
write FFileFound;
end;
TPathParser =
class(TComponent)
private
Terminated :Boolean;
Running :Boolean;
FFileParser :TFileParser;
FInitPath :
String;
FPathEnter :EPathEnter;
FPathExit :EPathExit;
FStepDown :EPathEnter;
protected
procedure Parse(Path:
String);
virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
procedure Execute;
procedure Terminate;
published
property FileParser :TFileParser
read FFileParser
write FFileParser;
property InitialPath :
String read FInitPath
write FInitPath;
property OnPathEnter :EPathEnter
read FPathEnter
write FPathEnter;
property OnPathExit :EPathExit
read FPathExit
write FPathExit;
property OnStepDown :EPathEnter
read FStepDown
write FStepDown;
end;
Procedure Register;
implementation
Procedure Register;
begin
RegisterComponents('
MyCtrls', [TFileParser, TPathParser]);
end;
{ utils }
function AddPath(s1,s2:
String):
String;
begin
if s1='
'
then Result:=s2
else
if s2='
'
then Result:=s1
else
begin
if s1[Length(s1)]='
\'
then s1:=copy(s1,1,Length(s1)-1);
if s2[1] <>'
\'
then s2:='
\'+s2;
Result:=s1+s2
end;
end;
{ TFileParser -----------------------------------------------------------------}
constructor TFileParser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFiles:='
*.*';
end;
procedure TFileParser.SetFiles(Value:
String);
var
si:Integer;
begin
if FFiles=Value
then exit;
si:=Pos('
\',Value);
if Value= '
'
then Value:='
*.*'
else
if Value='
.'
then Value:='
*.*'
else
if si>0
then Value:=Copy(Value, si+1, 255);
FFiles:=Value;
end;
procedure TFileParser.Parse(Path:
String);
var
Search:TSearchRec;
Status:Integer;
begin
if Path ='
'
then GetDir(0,Path);
if FFiles ='
'
then FFiles:='
*.*';
Status := FindFirst(AddPath(Path, FFiles), faAnyFile, Search);
try
while (Status = 0)
and Running
do
begin
if (Search.Attr
and faDirectory) = 0
then
if (Search.
Name<>'
.')
and (Search.
Name<>'
..')
then
if Assigned(FFileFound)
then
FFileFound(Search, AddPath(Path, Search.
Name));
Status := FindNext(Search);
end;
finally
FindClose(Search);
end;
end;
procedure TFileParser.Execute(Path:
String);
begin
Running:=True;
Parse(Path);
end;
procedure TFileParser.Terminate;
begin
Running:=False;
end;
{ TPathParser ----------------------------------------------------------------}
procedure TPathParser.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove)
and (AComponent = FFileParser)
then
FFileParser :=
nil;
end;
procedure TPathParser.Parse(Path:
String);
var
Search: TSearchRec;
Status: Integer;
DoThis: Boolean;
begin
if Terminated
then exit;
if Path='
'
then GetDir(0,Path);
DoThis:= True;
if Assigned(FPathEnter)
then FPathEnter(Search, Path, DoThis);
if Terminated
then exit;
if Assigned(FileParser)
then
if DoThis
then
if Running
then
FileParser.Execute(Path);
if Terminated
then exit;
//
Status := FindFirst(AddPath(Path, '
*.*'), faDirectory, Search);
try
while (Status = 0)
and Running
do
begin
if (Search.
Name <> '
.')
and (Search.
Name <> '
..')
then
if (Search.Attr
and faDirectory = faDirectory)
then
begin
DoThis:=True;
if Assigned(FStepDown)
then
FStepDown(Search, AddPath(Path, Search.
Name), DoThis);
if DoThis
then
if running
then
Parse(AddPath(Path, Search.
Name));
end;
Status := FindNext(Search);
end;
finally
FindClose(Search);
end;
if Assigned(FPathExit)
then FPathExit;
if Terminated
then exit;
end;
procedure TPathParser.Execute;
begin
Terminated:=False;
Running :=True;
Parse(InitialPath);
end;
procedure TPathParser.Terminate;
begin
Terminated:=True;
Running :=False;
if Assigned(FileParser)
then
FileParser.Terminate;
end;
end.