unit PageStrParser;
interface
{$DEFINE UseStateInstanceCache }
uses
Classes
{$IFDEF UseStateInstanceCache}
, Generics.Collections
{$ENDIF};
type
TPageStrParser =
class;
TPageStrParserStateClass =
class of TPageStrParserState;
TPageStrParserState =
class
private
FParser : TPageStrParser;
procedure ChangeState( NewState : TPageStrParserStateClass );
procedure AddCharToCurrPage1( Ch : Char );
procedure AddCharToCurrPage2( Ch : Char );
procedure AddCurrPagesToList;
public
constructor Create( AParser : TPageStrParser );
procedure ProcessChar( Ch : Char; Pos : Integer );
virtual;
abstract;
end;
TPageStrParser =
class
private
FState : TPageStrParserState;
{$IFDEF UseStateInstanceCache}
FStateCache : TDictionary<TPageStrParserStateClass, TPageStrParserState>;
{$ENDIF}
FCurrPageFrom :
string;
FCurrPageTo :
string;
FPageList : TStrings;
function GetState : TPageStrParserStateClass;
procedure SetState(
const Value : TPageStrParserStateClass );
protected
procedure AddCharToCurrPage1( Ch : Char );
procedure AddCharToCurrPage2( Ch : Char );
procedure AddCurrPagesToList;
property State : TPageStrParserStateClass
read GetState
write SetState;
public
constructor Create;
destructor Destroy;
override;
procedure ExtractPages(
const s :
string;
const aPageList : TStrings );
end;
implementation
uses
SysUtils;
type
TPageStrParserPageFromStartState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserPageFromState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserPageFromEndState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserPageToStartState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserPageToState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserPageToEndState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
TPageStrParserErrorState =
class( TPageStrParserState )
public
procedure ProcessChar( Ch : Char; Pos : Integer );
override;
end;
resourcestring
EParserError = '
Error in line at position %d: Invalid or Unexpected Char "%s"';
{ TPageStrParser }
procedure TPageStrParser.AddCharToCurrPage1( Ch : Char );
begin
FCurrPageFrom := FCurrPageFrom + Ch;
end;
procedure TPageStrParser.AddCharToCurrPage2( Ch : Char );
begin
FCurrPageTo := FCurrPageTo + Ch;
end;
procedure TPageStrParser.AddCurrPagesToList;
var
lFrom, lTo : Integer;
lPage : Integer;
lPageNr :
string;
begin
lFrom := StrToInt( FCurrPageFrom );
lTo := StrToIntDef( FCurrPageTo, lFrom );
if lFrom <= lTo
then
for lPage := lFrom
to lTo
do
begin
lPageNr := IntToStr( lPage );
FPageList.Add( lPageNr );
end
else
for lPage := lFrom
downto lTo
do
begin
lPageNr := IntToStr( lPage );
FPageList.Add( lPageNr );
end;
FCurrPageFrom := '
';
FCurrPageTo := '
';
end;
constructor TPageStrParser.Create;
begin
inherited;
{$IFDEF UseStateInstanceCache}
FStateCache := TObjectDictionary<TPageStrParserStateClass, TPageStrParserState>.Create( [doOwnsValues] );
{$ENDIF}
end;
destructor TPageStrParser.Destroy;
begin
{$IFDEF UseStateInstanceCache}
FStateCache.Free;
{$ELSE}
FState.Free;
{$ENDIF}
inherited;
end;
procedure TPageStrParser.ExtractPages(
const s :
string;
const aPageList : TStrings );
var
i : Integer;
Ch : Char;
begin
FPageList := aPageList;
FPageList.BeginUpdate;
try
FPageList.Clear;
State := TPageStrParserPageFromStartState;
FCurrPageFrom := '
';
FCurrPageTo := '
';
for i := 1
to Length( s )
do
begin
Ch := s[i];
FState.ProcessChar( Ch, i );
if State = TPageStrParserErrorState
then
FState.ProcessChar( Ch, i );
end;
if FCurrPageFrom <> '
'
then
AddCurrPagesToList;
finally
FPageList.EndUpdate;
end;
end;
function TPageStrParser.GetState : TPageStrParserStateClass;
begin
Result := TPageStrParserStateClass( FState.ClassType );
end;
procedure TPageStrParser.SetState(
const Value : TPageStrParserStateClass );
begin
{$IFDEF UseStateInstanceCache}
if FStateCache.ContainsKey( Value )
then
FState := FStateCache.Items[Value]
else
begin
FState := Value.Create( Self );
FStateCache.Add( Value, FState );
end;
{$ELSE}
FState.Free;
FState := Value.Create( Self );
{$ENDIF}
end;
{ TPageStrParserState }
procedure TPageStrParserState.AddCharToCurrPage1( Ch : Char );
begin
FParser.AddCharToCurrPage1( Ch );
end;
procedure TPageStrParserState.AddCharToCurrPage2( Ch : Char );
begin
FParser.AddCharToCurrPage2( Ch );
end;
procedure TPageStrParserState.AddCurrPagesToList;
begin
FParser.AddCurrPagesToList;
end;
procedure TPageStrParserState.ChangeState( NewState : TPageStrParserStateClass );
begin
FParser.State := NewState;
end;
constructor TPageStrParserState.Create( AParser : TPageStrParser );
begin
inherited Create;
FParser := AParser;
end;
{ TPageStrParserErrorState }
procedure TPageStrParserErrorState.ProcessChar( Ch : Char; Pos : Integer );
begin
raise Exception.Create( Format( EParserError, [Pos, Ch] ) );
end;
{ TPageStrParserPageFromStartState }
procedure TPageStrParserPageFromStartState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
;
'
0' .. '
9' :
begin
AddCharToCurrPage1( Ch );
ChangeState( TPageStrParserPageFromState );
end;
else
ChangeState( TPageStrParserErrorState );
end;
end;
{ TPageStrParserPageFromState }
procedure TPageStrParserPageFromState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
ChangeState( TPageStrParserPageFromEndState );
'
0' .. '
9' :
begin
AddCharToCurrPage1( Ch );
end;
'
-' :
begin
ChangeState( TPageStrParserPageToStartState );
end;
'
;', '
,' :
begin
AddCurrPagesToList;
ChangeState( TPageStrParserPageFromStartState );
end;
else
ChangeState( TPageStrParserErrorState );
end;
end;
{ TPageStrParserPageFromEndState }
procedure TPageStrParserPageFromEndState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
;
'
-' :
ChangeState( TPageStrParserPageToStartState );
'
,', '
;' :
begin
AddCurrPagesToList;
ChangeState( TPageStrParserPageFromStartState );
end
else
ChangeState( TPageStrParserErrorState );
end;
end;
{ TPageStrParserPageToStartState }
procedure TPageStrParserPageToStartState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
;
'
0' .. '
9' :
begin
AddCharToCurrPage2( Ch );
ChangeState( TPageStrParserPageToState );
end;
else
ChangeState( TPageStrParserErrorState );
end;
end;
{ TPageStrParserPageToState }
procedure TPageStrParserPageToState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
ChangeState( TPageStrParserPageToEndState );
'
0' .. '
9' :
begin
AddCharToCurrPage2( Ch );
end;
'
;', '
,' :
begin
AddCurrPagesToList;
ChangeState( TPageStrParserPageFromStartState );
end;
else
ChangeState( TPageStrParserErrorState );
end;
end;
{ TPageStrParserPageToEndState }
procedure TPageStrParserPageToEndState.ProcessChar( Ch : Char; Pos : Integer );
begin
case Ch
of
'
' :
;
'
,', '
;' :
begin
AddCurrPagesToList;
ChangeState( TPageStrParserPageFromStartState );
end
else
ChangeState( TPageStrParserErrorState );
end;
end;
end.