cxregexpr.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,586 行 · 第 1/5 页

    function Decimal(AToken: Char): Boolean;
    function EmptyStream: Boolean;
    function CreateLexem(ALine: Integer; AChar: Integer; ACode: Integer;
        AValue: string): TcxLexem;
    function GetLexem(var ALexem: TcxLexem): Boolean;
    function GetToken(out AToken: Char): Boolean;
    function GetStream: TStream;
    function Hexadecimal(AToken: Char): Boolean;
    function LookToken(out AToken: Char; APtr: Integer): Boolean;
    function ParseAlt(AAlt: TcxRegExprParserAlt; Global: Boolean = True): Boolean;
    function ParseBlock: TcxRegExprParserBlockItem;
    function ParseEnumeration: TcxRegExprParserSimpleItem;
    procedure ParseExpr;
    procedure ParseQuantifier(var A: Integer; var B: Integer);
    procedure ScanASCII(ALine: Integer; AChar: Integer);
    procedure ScanClass;
    procedure ScanExpr;
    procedure ScanEscape(ALine: Integer; AChar: Integer);
    function ScanInteger(ALine: Integer; AChar: Integer; var AToken: Char): Boolean;
    procedure ScanQuantifier;
    procedure ScanString;
    procedure SetUpdateOn(AUpdateOn: Boolean);
    function Space(AToken: Char): Boolean;
    procedure SymbolDelete;
    procedure SymbolUpdate(ASymbol: Char);
    procedure TestCompiledStatus;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Compile(AStream: TStream);
    function IsCompiled: Boolean;
    function IsFinal: Boolean;
    function IsStart: Boolean;
    function Next(var AToken: Char): Boolean;
    function NextEx(const AString: string): string;
    function Prev: Boolean;
    function Print: string;
    procedure Reset;
    property CaseInsensitive: Boolean read FCaseInsensitive write FCaseInsensitive;
    property Stream: TStream read GetStream;
    property UpdateOn: Boolean read FUpdateOn write SetUpdateOn;
    property OnSymbolDelete: TcxSymbolDeleteEvent read FOnSymbolDelete write FOnSymbolDelete;
    property OnSymbolUpdate: TcxSymbolUpdateEvent read FOnSymbolUpdate write FOnSymbolUpdate;
  end;

  function IsTextFullValid(const AText, AMask: string): Boolean;
  function IsTextValid(const AText, AMask: string): Boolean;

implementation

{ TcxRegExprError }

constructor TcxRegExprError.Create(ALine, AChar: Integer; AMessage: string);
begin
  inherited Create;
  FLine := ALine;
  FChar := AChar;
  FMessage := AMessage;
end;

function TcxRegExprError.Clone: TcxRegExprError;
begin
  Result := TcxRegExprError.Create(FLine, FChar, FMessage);
end;

function TcxRegExprError.GetFullMessage: string;
begin
  Result := '';
  if FLine > 0 then
  begin
    Result := Result + cxGetResourceString(@scxRegExprLine) + IntToStr(FLine);
    if FChar > 0 then
      Result := Result + ', ' + cxGetResourceString(@scxRegExprChar) + IntToStr(FChar);
    Result := Result + ': ';
  end;
  Result := Result + FMessage;
end;

{ TcxRegExprErrors }

constructor TcxRegExprErrors.Create;
begin
  inherited Create;
  FErrors := TList.Create;
end;

destructor TcxRegExprErrors.Destroy;
begin
  Clear;
  FErrors.Free;
  inherited Destroy;
end;

procedure TcxRegExprErrors.Add(AError: TcxRegExprError);
begin
  FErrors.Add(AError);
end;

procedure TcxRegExprErrors.Clear;
var
  I: Integer;
begin
  for I := 0 to FErrors.Count - 1 do
    TcxRegExprError(FErrors[I]).Free;
  FErrors.Clear;
end;

function TcxRegExprErrors.Clone: TcxRegExprErrors;
var
  I: Integer;
begin
  Result := TcxRegExprErrors.Create;

  for I := 0 to Count - 1 do
    Result.Add(Items[I].Clone); 
end;

function TcxRegExprErrors.GetCount: Integer;
begin
  Result := FErrors.Count;
end;

function TcxRegExprErrors.GetItems(Index: Integer): TcxRegExprError;
begin
  Result := TcxRegExprError(FErrors[Index]);
end;

{ EcxRegExprError }

constructor EcxRegExprError.Create(AErrors: TcxRegExprErrors);
begin
  FErrors := AErrors;
end;

{ TcxLexems }

constructor TcxLexems.Create;
begin
  inherited Create;
  FLexems := TList.Create;
end;

destructor TcxLexems.Destroy;
begin
  Clear;
  FLexems.Free;
  inherited Destroy;
end;

procedure TcxLexems.Add(ALexem: TcxLexem);
var
  LexemP: PcxLexem;
begin
  New(LexemP);
  LexemP^ := ALexem;
  FLexems.Add(LexemP);
end;

procedure TcxLexems.Clear;
var
  I: Integer;
begin
  for I := 0 to FLexems.Count - 1 do
    Dispose(PcxLexem(FLexems[I]));
  FLexems.Clear;
end;

function TcxLexems.GetCount: Integer;
begin
  Result := FLexems.Count;
end;

function TcxLexems.GetItems(Index: Integer): TcxLexem;
begin
  Result := PcxLexem(FLexems[Index])^;
end;

{ TcxRegExprSymbol }

constructor TcxRegExprSymbol.Create(AValue: Char);
begin
  inherited Create;
  FValue := AValue;
end;

function TcxRegExprSymbol.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  if ACaseInsensitive then
  begin
    Result := AnsiUpperCase(AToken) = AnsiUpperCase(FValue);
    if Result then
      AToken := FValue;
  end
  else
    Result := AToken = FValue;
end;

function TcxRegExprSymbol.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprSymbol.Create(FValue);
end;

{ TcxRegExprTimeSeparator }

function TcxRegExprTimeSeparator.Check(var AToken: Char;
  ACaseInsensitive: Boolean): Boolean;
begin
  Result := AToken = Value;
end;

function TcxRegExprTimeSeparator.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprTimeSeparator.Create;
end;

function TcxRegExprTimeSeparator.Value: Char;
begin
  Result := TimeSeparator;
end;

{ TcxRegExprDateSeparator }

function TcxRegExprDateSeparator.Check(var AToken: Char;
  ACaseInsensitive: Boolean): Boolean;
begin
  Result := AToken = Value;
end;

function TcxRegExprDateSeparator.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprDateSeparator.Create;
end;

function TcxRegExprDateSeparator.Value: Char;
begin
  Result := DateSeparator;
end;

{ TcxRegExprSubrange }

constructor TcxRegExprSubrange.Create(AStartValue, AFinishValue: Char);
begin
  inherited Create;
  FStartValue := AStartValue;
  FFinishValue := AFinishValue;
end;

function TcxRegExprSubrange.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  Result := (AToken >= FStartValue) and (AToken <= FFinishValue);
end;

function TcxRegExprSubrange.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprSubrange.Create(FStartValue, FFinishValue);
end;

{ TcxRegExprEnumeration }

constructor TcxRegExprEnumeration.Create(AInverse: Boolean = False);
begin
  inherited Create;
  FInverse := AInverse;
end;

{ TcxRegExprUserEnumeration }

constructor TcxRegExprUserEnumeration.Create(AInverse: Boolean);
begin
  inherited Create(AInverse);

  FItems := TList.Create;
end;

destructor TcxRegExprUserEnumeration.Destroy;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    Item(I).Free;
  FItems.Free;
  inherited Destroy;
end;

procedure TcxRegExprUserEnumeration.Add(AItem: TcxRegExprItem);
begin
  FItems.Add(AItem);
end;

function TcxRegExprUserEnumeration.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    if Item(I).Check(AToken, ACaseInsensitive) then
    begin
      Result := not FInverse;
      Exit;
    end;

  Result := FInverse;
end;

function TcxRegExprUserEnumeration.Item(AIndex: Integer): TcxRegExprItem;
begin
  Result := TcxRegExprItem(FItems[AIndex]);
end;

function TcxRegExprUserEnumeration.Clone: TcxRegExprItem;
var
  I: Integer;
begin
  Result := TcxRegExprUserEnumeration.Create(FInverse);

  for I := 0 to FItems.Count - 1 do
    TcxRegExprUserEnumeration(Result).Add(Item(I).Clone);
end;

{ TcxRegExprDigit }

constructor TcxRegExprDigit.Create(AInverse: Boolean);
begin
  inherited Create(AInverse); 
end;

function TcxRegExprDigit.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  if (AToken >= '0') and (AToken <= '9') then
    Result := not FInverse
  else
    Result := FInverse;
end;

function TcxRegExprDigit.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprDigit.Create(FInverse);
end;

{ TcxRegExprIdLetter }

constructor TcxRegExprIdLetter.Create(AInverse: Boolean);
begin
  inherited Create(AInverse);
end;

function TcxRegExprIdLetter.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  if ((AToken >= 'a') and (AToken <= 'z')) or (AToken = '_') or
      ((AToken >= 'A') and (AToken <= 'Z'))  or
      ((AToken >= '0') and (AToken <= '9')) then
    Result := not FInverse
  else
    Result := FInverse;
end;

function TcxRegExprIdLetter.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprIdLetter.Create(FInverse);
end;

{ TcxRegExprSpace }

constructor TcxRegExprSpace.Create(AInverse: Boolean);
begin
  inherited Create(AInverse);
end;

function TcxRegExprSpace.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  if (AToken = ' ') or (AToken = #0) or (AToken = #9) or
      (AToken = #10) or (AToken = #12) or (AToken = #13) then
    Result := not FInverse
  else
    Result := FInverse;
end;

function TcxRegExprSpace.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprSpace.Create(FInverse);
end;

{ TcxRegExprAll }

function TcxRegExprAll.Check(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
begin
  Result := True;
end;

function TcxRegExprAll.Clone: TcxRegExprItem;
begin
  Result := TcxRegExprAll.Create; 
end;

{ TcxRegExprState }

constructor TcxRegExprState.Create;
begin
  inherited Create;
  FStates := TcxRegExprStates.Create;
end;

destructor TcxRegExprState.Destroy;
begin
  FStates.Free;
  inherited Destroy;
end;

procedure TcxRegExprState.Add(AState: TcxRegExprState);
begin
  States.Add(AState);
end;

procedure TcxRegExprState.Add(AStates: TcxRegExprStates);
begin
  States.Add(AStates);
end;

function TcxRegExprState.Check(var AToken: Char; ACaseInsensitive: Boolean): TcxRegExprStates;
begin
  Result := TcxRegExprStates.Create;
end;

function TcxRegExprState.Clone: TcxRegExprState;
begin
  Result := TcxRegExprState.Create;
end;

function TcxRegExprState.GetAllNextStates: TcxRegExprStates;
var
  I: Integer;
begin
  Result := TcxRegExprStates.Create;

  for I := 0 to States.Count - 1 do
    Result.Add(States[I].GetSelf);
end;

function TcxRegExprState.GetSelf: TcxRegExprStates;
begin
  Result := TcxRegExprStates.Create;

  Result.Add(Self);
end;

function TcxRegExprState.Next(var AToken: Char; ACaseInsensitive: Boolean): TcxRegExprStates;
var
  I: Integer;
begin
  Result := TcxRegExprStates.Create;

  for I := 0 to FStates.Count - 1 do
    Result.Add(FStates[I].Check(AToken, ACaseInsensitive));
end;

{ TcxRegExprSimpleState }

constructor TcxRegExprSimpleState.Create(AValue: TcxRegExprItem);
begin
  inherited Create;

  FValue := AValue;
  FIsFinal := False;
end;

destructor TcxRegExprSimpleState.Destroy;
begin
  if FValue <> nil then
    FValue.Free;

  inherited Destroy;
end;

function TcxRegExprSimpleState.Check(var AToken: Char; ACaseInsensitive: Boolean): TcxRegExprStates;
begin
  Result := TcxRegExprStates.Create;

  if FValue.Check(AToken, ACaseInsensitive) then
    Result.Add(Self);
end;

function TcxRegExprSimpleState.Clone: TcxRegExprState;
begin
  Result := TcxRegExprSimpleState.Create(FValue.Clone);
end;

function TcxRegExprSimpleState.GetSelf: TcxRegExprStates;
begin
  Result := TcxRegExprStates.Create;

  Result.Add(Self);
end;

procedure TcxRegExprSimpleState.SetFinal;
begin
  FIsFinal := True;
end;

{ TcxRegExprBlockState }

function TcxRegExprBlockState.Check(var AToken: Char; ACaseInsensitive: Boolean): TcxRegExprStates;
begin
  Result := Next(AToken, ACaseInsensitive);
end;

function TcxRegExprBlockState.Clone: TcxRegExprState;
begin
  Result := TcxRegExprBlockState.Create;
end;

function TcxRegExprBlockState.GetSelf: TcxRegExprStates;
var
  I: Integer;
begin
  Result := TcxRegExprStates.Create;

  for I := 0 to States.Count - 1 do
    Result.Add(States[I].GetSelf);
end;