cxregexpr.pas

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

end;

procedure TcxRegExpr.Clear;
begin
  FStream.Size := 0;
  FErrors.Clear;
  FLexems.Clear;
  FBlocks.Clear;

  if FAutomat <> nil then
    FAutomat.Free;

  FAutomat := nil;
  FIndex := 0;
  FLexemIndex := 0;
  FChar := 0;
  FLine := 1;
  FCompiled := False;
end;

function TcxRegExpr.Decimal(AToken: Char): Boolean;
begin
  if AToken in ['0','1','2','3','4','5','6','7','8','9'] then
    Result := True
  else
    Result := False;
end;

function TcxRegExpr.EmptyStream: Boolean;
var
  AToken: Char;
  I: Integer;
begin
  if FStream.Size = 0 then
    Result := True
  else
  begin
    I := 0;
    while LookToken(AToken, I) do
    begin
      if not Space(AToken) then
      begin
        Result := False;
        Exit;
      end;

      Inc(I);
    end;

    Result := True;  
  end;
end;

function TcxRegExpr.CreateLexem(ALine: Integer; AChar: Integer; ACode: Integer;
    AValue: string): TcxLexem;
begin
  Result.Line := ALine;
  Result.Char := AChar;
  Result.Code := ACode;
  Result.Value := AValue;
end;

function TcxRegExpr.GetLexem(var ALexem: TcxLexem): Boolean;
begin
  if (FLexemIndex >= 0) and (FLexemIndex < FLexems.Count) then
  begin
    ALexem := FLexems[FLexemIndex];
    Inc(FLexemIndex);

    Result := True;  
  end
  else
    Result := False;  
end;

function TcxRegExpr.GetToken(out AToken: Char): Boolean;
begin
  Result := LookToken(AToken, 0);
  if Result then
  begin
    Inc(FIndex);

    if AToken = #13 then
      Inc(FLine);

    if AToken = #10 then
      FChar := 0
    else
      Inc(FChar);
  end;
end;

function TcxRegExpr.GetStream: TStream;
begin
  if FCompiled then
    Result := FStream
  else
    Result := nil;
end;

function TcxRegExpr.Hexadecimal(AToken: Char): Boolean;
begin
  Result := (AToken >= '0') and (AToken <= '9') or
    (AToken >= 'A') and (AToken <= 'F') or
    (AToken >= 'a') and (AToken <= 'f');
end;

function TcxRegExpr.LookToken(out AToken: Char; APtr: Integer): Boolean;
begin
  Result := ((FIndex + APtr) < FStream.Size) and ((FIndex + APtr) >= 0);
  if Result then
    AToken := Char(PByteArray(FStream.Memory)[FIndex + APtr]);
end;

function TcxRegExpr.ParseAlt(AAlt: TcxRegExprParserAlt; Global: Boolean): Boolean;
var
  ALexem: TcxLexem;
  ACurrentItem: TcxRegExprParserItem;

  procedure AddItem(AItem: TcxRegExprParserItem);
  begin
    ACurrentItem := AItem;
    AAlt.Add(AItem);
  end;

  procedure SetQuantifier(AQuantifier: TcxRegExprQuantifier);
  var
    ABlock: TcxRegExprParserBlockItem;
  begin
    if ACurrentItem.NotQuantifier then
      ACurrentItem.SetQuantifier(AQuantifier)
    else
    begin
      ABlock := TcxRegExprParserBlockItem.Create(AQuantifier);
      ABlock.Alts.AddAlt;
      ABlock.Alts.LastAlt.Add(ACurrentItem);
      ACurrentItem := ABlock;
      AAlt.FItems[AAlt.FItems.Count - 1] := ABlock;
    end;
  end;

  function CreateParameterQuantifierBlock(AIndex, ACount: Integer): TcxRegExprParserItem;
  begin
    if AIndex < (ACount - 1) then
    begin
      Result := TcxRegExprParserBlockItem.Create(TcxRegExprQuestionQuantifier.Create);
      with TcxRegExprParserBlockItem(Result).Alts do
      begin
        AddAlt;
        LastAlt.Add(ACurrentItem.Clone);
        LastAlt.Add(CreateParameterQuantifierBlock(AIndex + 1, ACount));
      end;
    end
    else
    begin
      Result := ACurrentItem.Clone;
      Result.SetQuantifier(TcxRegExprQuestionQuantifier.Create);
    end;
  end;

  procedure SetParameterQuantifier(A, B: Integer);
  var
    ABlock: TcxRegExprParserBlockItem;
    AItem: TcxRegExprParserItem;
    I: Integer;
  begin
    if ACurrentItem.CanMissing then
    begin
      FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
          cxGetResourceString(@scxRegExprCantUseParameterQuantifier)));
      Exit;
    end;

    ABlock := TcxRegExprParserBlockItem.Create(TcxRegExprSimpleQuantifier.Create);
    ABlock.Alts.AddAlt;
    for I := 0 to A - 1 do
      ABlock.Alts.LastAlt.Add(ACurrentItem.Clone);
    if B = -1 then
    begin
      AItem := ACurrentItem.Clone;
      AItem.SetQuantifier(TcxRegExprStarQuantifier.Create);
      ABlock.Alts.LastAlt.Add(AItem);
    end
    else if B > A then
      ABlock.Alts.LastAlt.Add(CreateParameterQuantifierBlock(A, B));
    ACurrentItem := ABlock;
    AAlt.LastItem := ABlock;
  end;

  procedure SetQuestionQuantifier;
  begin
    SetQuantifier(TcxRegExprQuestionQuantifier.Create);
  end;

  procedure SetPlusQuantifier;
  begin
    if ACurrentItem.CanEmpty then
      FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
          cxGetResourceString(@scxRegExprCantUsePlusQuantifier)))
    else
      SetQuantifier(TcxRegExprPlusQuantifier.Create);
  end;

  procedure SetStarQuantifier;
  begin
    if ACurrentItem.CanEmpty then
      FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
          cxGetResourceString(@scxRegExprCantUseStarQuantifier)))
    else
      SetQuantifier(TcxRegExprStarQuantifier.Create);
  end;

var
  RefNumber: Integer;
  A, B: Integer;
begin
  ACurrentItem := nil;

  if GetLexem(ALexem) then
  begin
    if (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = '|') then
    begin
      FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
        cxGetResourceString(@scxRegExprCantCreateEmptyAlt)));
      Result := True;
      Exit;
    end;

    if not Global then
    begin
      if (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = ')') then
      begin
        FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
          cxGetResourceString(@scxRegExprCantCreateEmptyBlock)));
        Result := False;
        Exit;
      end;
    end;
  end
  else
  begin
    FErrors.Add(TcxRegExprError.Create(0, 0, cxGetResourceString(@scxRegExprCantCreateEmptyAlt)));
    Result := False;
    Exit;
  end;

  repeat
    case TcxRegExprLexemCode(ALexem.Code) of
      relcSymbol:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprSymbol.Create(
                ALexem.Value[1]))));
      relcSpecial:
      begin
        case ALexem.Value[1] of
          '|':
          begin
            Result := True;
            Exit;
          end;
          '(':
            AddItem(ParseBlock);
          ')':
          begin
            if Global then
              FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalSymbol), [')'])))
            else
            begin
              Result := False;
              Exit;
            end;
          end;
          '[':
            AddItem(ParseEnumeration);
          ']':
            FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalSymbol), [']'])));
          '{':
          begin
            if ACurrentItem = nil then
              FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  cxGetResourceString(@scxRegExprIncorrectParameterQuantifier)))
            else
            begin
              ParseQuantifier(A, B);
              SetParameterQuantifier(A, B);
            end;
          end;
          '}':
            FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalSymbol), ['}'])));
          '-':
            FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalSymbol), ['-'])));
          '?':
          begin
            if ACurrentItem = nil then
              FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalQuantifier), ['?'])))
            else
              SetQuestionQuantifier;
          end;
          '+':
          begin
            if ACurrentItem = nil then
              FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalQuantifier), ['+'])))
            else
              SetPlusQuantifier;
          end;
          '*':
          begin
            if ACurrentItem = nil then
              FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
                  Format(cxGetResourceString(@scxRegExprIllegalQuantifier), ['*'])))
            else
              SetStarQuantifier;
          end;
        end;
      end;
      relcInteger:
        FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
            cxGetResourceString(@scxRegExprIllegalIntegerValue)));
      relcTimeSeparator:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprTimeSeparator.Create)));
      relcDateSeparator:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprDateSeparator.Create)));
      relcAll:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprAll.Create)));
      relcId:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprIdLetter.Create)));
      relcNotId:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprIdLetter.Create(True))));
      relcDigit:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprDigit.Create)));
      relcNotDigit:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprDigit.Create(True))));
      relcSpace:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprSpace.Create)));
      relcNotSpace:
        AddItem(
          TcxRegExprParserSimpleItem.Create(
            TcxRegExprSimpleState.Create(
              TcxRegExprSpace.Create(True))));
      relcReference:
      begin
        RefNumber := StrToInt(ALexem.Value) - 1;
        if RefNumber >= FBlocks.Count then
          FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
              cxGetResourceString(@scxRegExprTooBigReferenceNumber)))
        else
          AddItem(TcxRegExprParserItem(FBlocks[RefNumber]).Clone);
      end;
    end;
  until not GetLexem(ALexem);

  Result := False;
end;

function TcxRegExpr.ParseBlock: TcxRegExprParserBlockItem;
begin
  Result := TcxRegExprParserBlockItem.Create;
  FBlocks.Add(Result);

  repeat
    Result.Alts.AddAlt;
  until not ParseAlt(Result.Alts.LastAlt, False);
end;

function TcxRegExpr.ParseEnumeration: TcxRegExprParserSimpleItem;
var
  ALexem: TcxLexem;
  ALexem1: TcxLexem;
  Enumeration: TcxRegExprUserEnumeration;
begin
  GetLexem(ALexem);

  if (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = '^') then
  begin
    Enumeration := TcxRegExprUserEnumeration.Create(True);
    GetLexem(ALexem);
  end
  else
    Enumeration := TcxRegExprUserEnumeration.Create;

  Result := TcxRegExprParserSimpleItem.Create(TcxRegExprSimpleState.Create(Enumeration));

  if (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = ']') then
  begin
    FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
        cxGetResourceString(@scxRegExprCantCreateEmptyEnum)));
    Exit;
  end;

  repeat
    GetLexem(ALexem1);

    if (TcxRegExprLexemCode(ALexem1.Code) = relcSpecial) and (ALexem1.Value[1] = '-') then
    begin
      GetLexem(ALexem1);
      if ALexem.Value[1] < ALexem1.Value[1] then
        Enumeration.Add(TcxRegExprSubrange.Create(ALexem.Value[1], ALexem1.Value[1]))
      else
        FErrors.Add(TcxRegExprError.Create(ALexem1.Line, ALexem1.Char,
          cxGetResourceString(@scxRegExprSubrangeOrder)));

      GetLexem(ALexem);
      while (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = '-') do
      begin
        FErrors.Add(TcxRegExprError.Create(ALexem.Line, ALexem.Char,
          Format(cxGetResourceString(@scxRegExprIllegalSymbol), ['-'])));
        GetLexem(ALexem);
      end;
    end
    else
    begin
      case TcxRegExprLexemCode(ALexem.Code) of
        relcTimeSeparator:
          Enumeration.Add(TcxRegExprTimeSeparator.Create);
        relcDateSeparator:
          Enumeration.Add(TcxRegExprDateSeparator.Create);
        relcAll:
          Enumeration.Add(TcxRegExprAll.Create);
        relcId:
          Enumeration.Add(TcxRegExprIdLetter.Create);
        relcNotId:
          Enumeration.Add(TcxRegExprIdLetter.Create(True));
        relcDigit:
          Enumeration.Add(TcxRegExprDigit.Create);
        relcNotDigit:
          Enumeration.Add(TcxRegExprDigit.Create(True));
        relcSpace:
          Enumeration.Add(TcxRegExprSpace.Create);
        relcNotSpace:
          Enumeration.Add(TcxRegExprSpace.Create(True));
        else
          Enumeration.Add(TcxRegExprSymbol.Create(ALexem.Value[1]));
      end;

      ALexem := ALexem1;
    end;

  until (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value[1] = ']');
end;

procedure TcxRegExpr.ParseExpr;
var
  Expr: TcxRegExprParserAlts;
begin
  Expr := TcxRegExprParserAlts.Create;

  repeat
    Expr.AddAlt;
  until not ParseAlt(Expr.LastAlt);

  if FErrors.Count > 0 then
    Expr.Free
  else
  begin
    Expr.CreateConnections;
    Expr.CreateFinalStates;
    FAutomat := TcxRegExprAutomat.Create(Expr, Self);
  end;
end;

procedure TcxRegExpr.ParseQuantifier(var A: Integer; var B: Integer);
var
  ALexem: TcxLexem;
begin
  GetLexem(ALexem);
  if TcxRegExprLexemCode(ALexem.Code) = relcInteger then
  begin
    A := StrToInt(ALexem.Value);
    GetLexem(ALexem);
    if TcxRegExprLexemCode(ALexem.Code) = relcSpecial then
    begin
      if ALexem.Value = ',' then
      begin
        GetLexem(ALexem);
        if TcxRegExprLexemCode(ALexem.Code) = relcInteger then
        begin
          B := StrToInt(ALexem.Value);
          if B >= A then
          begin
            GetLexem(ALexem);
            if (TcxRegExprLexemCode(ALexem.Code) = relcSpecial) and (ALexem.Value = '}') then