home *** CD-ROM | disk | FTP | other *** search
- { *****************************************************
- ThgsParser Component
-
- ThgsParser encapsulates the TCustomParser class and
- provides flexible, reusable parsing through a component.
-
- Paul Warren
- HomeGrown Software Development
- (c) 1998 Langley British Columbia.
- (604) 856-6523
- e-mail: hg_soft@uniserve.com
- Home page: http://users.uniserve.com/~hg_soft
- ***************************************************** }
-
- unit Parsecmp;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
- NewParse;
-
- type
- TParserType = (ptCSV, ptText, ptPascal, ptEnhPas, ptHtml);
- TOnParseEvent = procedure(Sender: TObject; Token: char; var Abort: boolean) of object;
-
- ThgsParser = class(TComponent)
- private
- { private declarations }
- ParserRef: TParserClass;
- FParser: TCustomParser;
- FParserType: TParserType;
- FParseStream: TStream;
- FOnParse: TOnParseEvent;
- procedure SetParseStream(Value: TStream);
- procedure SetOnParse(Value: TOnParseEvent);
- protected
- { protected declarations }
- public
- { public declarations }
- constructor Create(AOwner: TComponent); override;
- property ParseStream: TStream write SetParseStream;
- published
- { published declarations }
- property ParserType: TParserType read FParserType write FParserType default ptHtml;
- property OnParse: TOnParseEvent read FOnParse write SetOnParse;
- end;
-
- procedure Register;
-
- implementation
-
- {$IFDEF WIN32}
- {$R PARSECMP.D32}
- {$ELSE}
- {$R PARSECMP.D16}
- {$ENDIF}
-
- constructor ThgsParser.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FParserType := ptHtml;
- end;
-
- procedure ThgsParser.SetParseStream(Value: TStream);
- var
- Abort: boolean;
- begin
- Abort := false;
- FParseStream := Value; { assign stream - note must be freed by caller }
- case FParserType of { check the parser type }
- { set class reference according to parser type }
- ptCSV: ParserRef := TParserClass(TCSVParser);
- ptText: ParserRef := TParserClass(TTextParser);
- ptPascal: ParserRef := TParserClass(TPasParser);
- ptEnhPas: ParserRef := TParserClass(TEnhPasParser);
- ptHtml: ParserRef := TParserClass(THtmlParser);
- end;
- { create parser instance }
- FParser := ParserRef.Create(FParseStream);
- if Assigned(FOnParse) then FOnParse(FParser, FParser.Token, Abort);
- if Abort then Exit;
- try
- { parse file }
- while FParser.Token <> toEOF do
- begin
- FParser.NextToken;
- if Assigned(FOnParse) then FOnParse(FParser, FParser.Token, Abort);
- if Abort then Break;
- end;
- finally
- FParser.Free; { free parser }
- end;
- end;
-
- procedure ThgsParser.SetOnParse(Value: TOnParseEvent);
- begin
- FOnParse := Value;
- end;
-
- { register component on HomeGrown page }
- procedure Register;
- begin
- RegisterComponents('HomeGrown', [ThgsParser]);
- end;
-
- end.