cxregexpr.pas

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

  if FQuantifier.CanMissing then
    Result := True
  else
    Result := Alts.CanEmpty;
end;

procedure TcxRegExprParserBlockItem.CreateConnections;
begin
  Alts.CreateConnections;
end;

procedure TcxRegExprParserBlockItem.AddAlt(AAlt: TcxRegExprParserAlt);
begin
  FAlts.Add(AAlt);
end;

procedure TcxRegExprParserBlockItem.AddAlts(AAlts: TcxRegExprParserAlts);
var
  I: Integer;
begin
  for I := 0 to AAlts.Count - 1 do
    FAlts.Add(AAlts[I]);
  AAlts.Free;
end;

function TcxRegExprParserBlockItem.Clone: TcxRegExprParserItem;
begin
  Result := TcxRegExprParserBlockItem.Create(FQuantifier.Clone);
  with TcxRegExprParserBlockItem(Result) do
  begin
    FAlts.Free;
    FAlts := Self.Alts.Clone;
  end;
end;

function TcxRegExprParserBlockItem.Print: string;
begin
  Result := '<Start_Block>'#13#10;
  Result := Result + Alts.Print;
  Result := Result + '<Finish_Block> --> ' + FQuantifier.Print + #13#10;
end;

procedure TcxRegExprParserBlockItem.SetFinal;
begin
  Alts.CreateFinalStates;
end;

{ TcxRegExprParserAlt }

constructor TcxRegExprParserAlt.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

destructor TcxRegExprParserAlt.Destroy;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    TcxRegExprParserItem(FItems[I]).Free;
  FItems.Free;
  inherited Destroy;
end;

procedure TcxRegExprParserAlt.Add(AItem: TcxRegExprParserItem);
begin
  FItems.Add(AItem);
end;

function TcxRegExprParserAlt.CanEmpty: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if not Item[I].CanEmpty then
    begin
      Result := False;
      Exit;
    end;

  Result := True;
end;

function TcxRegExprParserAlt.CanMissing: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if not Item[I].CanMissing then
    begin
      Result := False;
      Exit;
    end;

  Result := True;
end;

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

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

procedure TcxRegExprParserAlt.CreateConnections;
var
  I, J: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    if Item[I] is TcxRegExprParserSimpleItem then
    begin
      with TcxRegExprParserSimpleItem(Item[I]) do
      begin
        for J := I + 1 to Count - 1 do
        begin
          if Item[J] is TcxRegExprParserSimpleItem then
            State.Add(TcxRegExprParserSimpleItem(Item[J]).State)
          else if Item[J] is TcxRegExprParserBlockItem then
            State.Add(TcxRegExprParserBlockItem(Item[J]).StartState);

          if not Item[J].CanMissing then
            Break;
        end;

        if Item[I].CanRepeat then
          State.Add(State);
      end;
    end
    else if Item[I] is TcxRegExprParserBlockItem then
    begin
      with TcxRegExprParserBlockItem(Item[I]) do
      begin
        for J := I + 1 to Count - 1 do
        begin
          if Item[J] is TcxRegExprParserSimpleItem then
            FinishState.Add(TcxRegExprParserSimpleItem(Item[J]).State)
          else if Item[J] is TcxRegExprParserBlockItem then
            FinishState.Add(TcxRegExprParserBlockItem(Item[J]).StartState);

          if not Item[J].CanMissing then
            Break;
        end;

        if Item[I].CanRepeat then
          FinishState.Add(StartState);

        StartState.Add(Alts.GetStartConnections);
        if Alts.ThereIsEmptyAlt then
          StartState.Add(FinishState);

        Alts.CreateConnections;
        Alts.SetFinishConnections(FinishState);
      end;
    end;
  end;
end;

procedure TcxRegExprParserAlt.CreateFinalStates;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
  begin
    Item[I].SetFinal;

    if not Item[I].CanMissing then
      Break;
  end;
end;

function TcxRegExprParserAlt.GetStartConnections: TcxRegExprStates;
var
  I: Integer;
begin
  Result := TcxRegExprStates.Create;

  for I := 0 to Count - 1 do
  begin
    if Item[I] is TcxRegExprParserSimpleItem then
      Result.Add(TcxRegExprParserSimpleItem(Item[I]).State)
    else if Item[I] is TcxRegExprParserBlockItem then
      Result.Add(TcxRegExprParserBlockItem(Item[I]).StartState);

    if not Item[I].CanMissing then
      Break;
  end;
end;

function TcxRegExprParserAlt.Print: string;
var
  I: Integer;
begin
  Result := '<Start_Alt>'#13#10;
  for I := 0 to Count - 1 do
    Result := Result + Item[I].Print;
  Result := result + '<Finish_Alt>'#13#10;
end;

procedure TcxRegExprParserAlt.SetFinishConnection(
  AFinishState: TcxRegExprState);
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
  begin
    if Item[I] is TcxRegExprParserSimpleItem then
      TcxRegExprParserSimpleItem(Item[I]).State.Add(AFinishState)
    else if Item[I] is TcxRegExprParserBlockItem then
      TcxRegExprParserBlockItem(Item[I]).FinishState.Add(AFinishState);

    if not Item[I].CanMissing then
      Break;
  end;
end;

function TcxRegExprParserAlt.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxRegExprParserAlt.GetFirstItem: TcxRegExprParserItem;
begin
  Result := TcxRegExprParserItem(FItems[0]);
end;

function TcxRegExprParserAlt.GetItem(
  AIndex: Integer): TcxRegExprParserItem;
begin
  Result := TcxRegExprParserItem(FItems[AIndex]);
end;

function TcxRegExprParserAlt.GetLastItem: TcxRegExprParserItem;
begin
  Result := TcxRegExprParserItem(FItems.Last);
end;

procedure TcxRegExprParserAlt.SetLastItem(AItem: TcxRegExprParserItem);
begin
  TcxRegExprParserItem(FItems[FItems.Count - 1]).Free;
  FItems.Delete(FItems.Count - 1);
  FItems.Add(AItem);
end;

{ TcxRegExprParserAlts }

constructor TcxRegExprParserAlts.Create;
begin
  inherited Create;
  FAlts := TList.Create;
end;

destructor TcxRegExprParserAlts.Destroy;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Alt[I].Free;
  FAlts.Free;
  inherited Destroy;
end;

procedure TcxRegExprParserAlts.Add(AAlt: TcxRegExprParserAlt);
begin
  FAlts.Add(AAlt);
end;

procedure TcxRegExprParserAlts.AddAlt;
begin
  FAlts.Add(TcxRegExprParserAlt.Create)
end;

function TcxRegExprParserAlts.CanEmpty: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Alt[I].CanEmpty then
    begin
      Result := True;
      Exit;
    end;

  Result := False; 
end;

procedure TcxRegExprParserAlts.CreateConnections;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Alt[I].CreateConnections;
end;

procedure TcxRegExprParserAlts.CreateFinalStates;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Alt[I].CreateFinalStates;
end;

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

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

function TcxRegExprParserAlts.GetStartConnections: TcxRegExprStates;
var
  I: Integer;
begin
  Result := TcxRegExprStates.Create;

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

function TcxRegExprParserAlts.Print: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
    Result := Result + Alt[I].Print;
end;

procedure TcxRegExprParserAlts.SetFinishConnections(
  AFinishState: TcxRegExprState);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Alt[I].SetFinishConnection(AFinishState);
end;

function TcxRegExprParserAlts.StartStateIsFinal: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Alt[I].CanMissing then
    begin
      Result := True;
      Exit;
    end;

  Result := False;
end;

function TcxRegExprParserAlts.ThereIsEmptyAlt: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Alt[I].CanMissing then
    begin
      Result := True;
      Exit;
    end;

  Result := False;
end;

function TcxRegExprParserAlts.GetAlt(AIndex: Integer): TcxRegExprParserAlt;
begin
  Result := TcxRegExprParserAlt(FAlts[AIndex]);
end;

function TcxRegExprParserAlts.GetCount: Integer;
begin
  Result := FAlts.Count;
end;

function TcxRegExprParserAlts.GetLastAlt: TcxRegExprParserAlt;
begin
  Result := TcxRegExprParserAlt(FAlts.Last);
end;

{ TcxRegExpr }

constructor TcxRegExpr.Create;
begin
  inherited Create;
  FStream := TMemoryStream.Create;
  FErrors := TcxRegExprErrors.Create;
  FLexems := TcxLexems.Create;
  FBlocks := TList.Create;
  FAutomat := nil;
  FIndex := 0;
  FLexemIndex := 0;
  FLine := 1;
  FChar := 0;
  FFirstExpr := True;
  FCompiled := False;
  FUpdateOn := False;
  FCaseInsensitive := False;
end;

destructor TcxRegExpr.Destroy;
begin
  Clear;
  FStream.Free;
  FLexems.Free;
  FBlocks.Free;
  FErrors.Free;
  if FAutomat <> nil then
    FAutomat.Free;
  inherited Destroy;
end;

procedure TcxRegExpr.Compile(AStream: TStream);
begin
  if FFirstExpr then
    FFirstExpr := False
  else
    Clear;

  try
    FStream.LoadFromStream(AStream);
  except
    FErrors.Add(TcxRegExprError.Create(0, 0, cxGetResourceString(@scxRegExprNotAssignedSourceStream)));
    raise EcxRegExprError.Create(FErrors);
  end;

  if EmptyStream then
  begin
    FErrors.Add(TcxRegExprError.Create(0, 0, cxGetResourceString(@scxRegExprEmptySourceStream)));
    raise EcxRegExprError.Create(FErrors);
  end;

  ScanExpr;
  if FErrors.Count > 0 then
    raise EcxRegExprError.Create(FErrors);

  ParseExpr;
  if FErrors.Count > 0 then
    raise EcxRegExprError.Create(FErrors);

  FCompiled := True;

  if UpdateOn then
    FAutomat.Update;
end;

function TcxRegExpr.IsCompiled: Boolean;
begin
  Result := FCompiled;
end;

function TcxRegExpr.IsFinal: Boolean;
begin
  TestCompiledStatus;

  Result := FAutomat.IsFinal;
end;

function TcxRegExpr.IsStart: Boolean;
begin
  TestCompiledStatus;

  Result := FAutomat.IsStart;
end;

function TcxRegExpr.Next(var AToken: Char): Boolean;
begin
  TestCompiledStatus;

  Result := FAutomat.Next(AToken, FCaseInsensitive);

  if not FAutomat.IsFinal and Result and UpdateOn then
    FAutomat.Update;
end;

function TcxRegExpr.NextEx(const AString: string): string;
var
  C: Char;
  I: Integer;
begin
  TestCompiledStatus;

  Result := '';
  for I := 1 to Length(AString) do
  begin
    C := AString[I];
    if FAutomat.Next(C, FCaseInsensitive) then
      Result := Result + AString[I];
  end;
end;

function TcxRegExpr.Prev: Boolean;
begin
  TestCompiledStatus;

  if UpdateOn then
    FAutomat.ReUpdate;

  Result := FAutomat.Prev;
end;

function TcxRegExpr.Print: string;
begin
  Result := FAutomat.Print;
end;

procedure TcxRegExpr.Reset;
begin
  TestCompiledStatus;

  FAutomat.Reset;