cxregexpr.pas

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

{ TcxRegExprStates }

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

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

procedure TcxRegExprStates.Add(AState: TcxRegExprState);
begin
  FStates.Add(AState);
end;

procedure TcxRegExprStates.Add(AStates: TcxRegExprStates);
var
  I: Integer;
begin
  for I := 0 to AStates.Count - 1 do
    Add(AStates.State[I]);
  AStates.Free;
end;

procedure TcxRegExprStates.Clear;
begin
  FStates.Clear;
end;

function TcxRegExprStates.Equ(var ASymbol: Char): Boolean;
var
  I: Integer;
  Flag: Boolean;
begin
  if Count = 0 then
  begin
    Result := False;
    Exit;
  end;

  Flag := False;

  for I := 0 to Count - 1 do
  begin
    if State[I] is TcxRegExprSimpleState then
    begin
      with TcxRegExprSimpleState(State[I]) do
      begin
        if FValue is TcxRegExprSymbol then
        begin
          if not Flag then
          begin
            ASymbol := TcxRegExprSymbol(FValue).FValue;
            Flag := True;
          end
          else
          begin
            if ASymbol <> TcxRegExprSymbol(FValue).FValue then
            begin
              Result := False;
              Exit;
            end;
          end;
        end
        else if FValue is TcxRegExprTimeSeparator then
        begin
          if not Flag then
          begin
            ASymbol := TcxRegExprTimeSeparator(FValue).Value;
            Flag := True;
          end
          else
          begin
            if ASymbol <> TcxRegExprTimeSeparator(FValue).Value then
            begin
              Result := False;
              Exit;
            end;
          end;
        end
        else if FValue is TcxRegExprDateSeparator then
        begin
          if not Flag then
          begin
            ASymbol := TcxRegExprDateSeparator(FValue).Value;
            Flag := True;
          end
          else
          begin
            if ASymbol <> TcxRegExprDateSeparator(FValue).Value then
            begin
              Result := False;
              Exit;
            end;
          end;
        end
        else
        begin
          Result := False;
          Exit;
        end;
      end;
    end
    else
    begin
      Result := False;
      Exit;
    end;
  end;

  Result := True;
end;

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

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

function TcxRegExprStates.IsFinal: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if TcxRegExprSimpleState(State[I]).IsFinal then
    begin
      Result := True;
      Exit;
    end;

  Result := False;
end;

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

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

function TcxRegExprStates.GetCount: Integer;
begin
  Result := FStates.Count;
end;

function TcxRegExprStates.GetState(AIndex: Integer): TcxRegExprState;
begin
  Result := TcxRegExprState(FStates[AIndex]);
end;

{ TcxRegExprAutomat }

constructor TcxRegExprAutomat.Create(AExpr: TcxRegExprParserAlts; AOwner: TcxRegExpr);
begin
  inherited Create;
  FHistory := TList.Create;
  FExpr := AExpr;
  FStartState := TcxRegExprSimpleState.Create(nil);
  FStartState.Add(FExpr.GetStartConnections);
  if FExpr.StartStateIsFinal then
    FStartState.SetFinal;
  FCurrentStates := TcxRegExprStates.Create;
  FCurrentStates.Add(FStartState);
  FOwner := AOwner;
end;

destructor TcxRegExprAutomat.Destroy;
var
  I: Integer;
begin
  for I := 0 to FHistory.Count - 1 do
    TcxRegExprStates(FHistory[I]).Free;
  FHistory.Free;
  FCurrentStates.Free;
  FExpr.Free;
  FStartState.Free;
  inherited Destroy;
end;

function TcxRegExprAutomat.GetAllNextStates: TcxRegExprStates;
begin
  Result := FCurrentStates.GetAllNextStates
end;

function TcxRegExprAutomat.IsFinal: Boolean;
begin
  Result := FCurrentStates.IsFinal;  
end;

function TcxRegExprAutomat.IsStart: Boolean;
begin
  Result := FCurrentStates[0] = FStartState;
end;

function TcxRegExprAutomat.Next(var AToken: Char; ACaseInsensitive: Boolean): Boolean;
var
  NextStates: TcxRegExprStates;
begin
  NextStates := FCurrentStates.Next(AToken, ACaseInsensitive);
  if NextStates.Count > 0 then
  begin
    Push(FCurrentStates);
    FCurrentStates := NextStates;
    Result := True;
  end
  else
  begin
    NextStates.Free;
    Result := False;
  end;
end;

function TcxRegExprAutomat.Prev: Boolean;
var
  LastStates: TcxRegExprStates;
begin
  LastStates := Pop;
  if LastStates = nil then
    Result := False
  else
  begin
    FCurrentStates.Free;
    FCurrentStates := LastStates;
    Result := True;
  end;
end;

function TcxRegExprAutomat.Print: string;
begin
  Result := FExpr.Print;
end;

procedure TcxRegExprAutomat.Reset;
var
  I: Integer;
begin
  for I := 0 to FHistory.Count - 1 do
    TcxRegExprStates(FHistory[I]).Free;
  FHistory.Clear;
  FCurrentStates.Free;
  FCurrentStates := TcxRegExprStates.Create;
  FCurrentStates.Add(FStartState);
end;

procedure TcxRegExprAutomat.ReUpdate;
var
  ASymbol: Char;
  PrevStates: TcxRegExprStates;
  AllNextStates: TcxRegExprStates;
begin
  while FCurrentStates.Equ(ASymbol) do
  begin
    PrevStates := Pop;
    if PrevStates = nil then
    begin
      Push(PrevStates);
      Exit;
    end;

    AllNextStates := PrevStates.GetAllNextStates;
    if not AllNextStates.Equ(ASymbol) or PrevStates.IsFinal then
    begin
      Push(PrevStates);
      AllNextStates.Free;
      Exit;
    end
    else
      AllNextStates.Free;

    FOwner.SymbolDelete;

    FCurrentStates.Free;
    FCurrentStates := PrevStates;
  end;
end;

procedure TcxRegExprAutomat.Update;
var
  NextStates: TcxRegExprStates;
  ASymbol: Char;
begin
  if FCurrentStates.IsFinal then
    Exit;

  NextStates := GetAllNextStates;

  while NextStates.Equ(ASymbol) do
  begin
    FOwner.SymbolUpdate(ASymbol);

    Push(FCurrentStates);
    FCurrentStates := NextStates;

    if NextStates.IsFinal then
      Exit;

    NextStates := GetAllNextStates;
  end;

  NextStates.Free;
end;

function TcxRegExprAutomat.Pop: TcxRegExprStates;
begin
  if FHistory.Count > 0 then
  begin
    Result := TcxRegExprStates(FHistory.Last);
    FHistory.Delete(FHistory.Count - 1);
  end
  else
    Result := nil;
end;

procedure TcxRegExprAutomat.Push(AStates: TcxRegExprStates);
begin
  FHistory.Add(AStates);
end;

{ TcxRegExprSimpleQuantifier }

function TcxRegExprSimpleQuantifier.CanMissing: Boolean;
begin
  Result := False;
end;

function TcxRegExprSimpleQuantifier.CanRepeat: Boolean;
begin
  Result := False;
end;

function TcxRegExprSimpleQuantifier.Clone: TcxRegExprQuantifier;
begin
  Result := TcxRegExprSimpleQuantifier.Create;
end;

function TcxRegExprSimpleQuantifier.Print: string;
begin
  Result := '';
end;

{ TcxRegExprQuestionQuantifier }

function TcxRegExprQuestionQuantifier.CanMissing: Boolean;
begin
  Result := True;
end;

function TcxRegExprQuestionQuantifier.CanRepeat: Boolean;
begin
  Result := False;
end;

function TcxRegExprQuestionQuantifier.Clone: TcxRegExprQuantifier;
begin
  Result := TcxRegExprQuestionQuantifier.Create;
end;

function TcxRegExprQuestionQuantifier.Print: string;
begin
  Result := '?';
end;

{ TcxRegExprStarQuantifier }

function TcxRegExprStarQuantifier.CanMissing: Boolean;
begin
  Result := True;
end;

function TcxRegExprStarQuantifier.CanRepeat: Boolean;
begin
  Result := True;
end;

function TcxRegExprStarQuantifier.Clone: TcxRegExprQuantifier;
begin
  Result := TcxRegExprStarQuantifier.Create;
end;

function TcxRegExprStarQuantifier.Print: string;
begin
  Result := '*';
end;

{ TcxRegExprPlusQuantifier }

function TcxRegExprPlusQuantifier.CanMissing: Boolean;
begin
  Result := False;
end;

function TcxRegExprPlusQuantifier.CanRepeat: Boolean;
begin
  Result := True;
end;

function TcxRegExprPlusQuantifier.Clone: TcxRegExprQuantifier;
begin
  Result := TcxRegExprPlusQuantifier.Create;
end;

function TcxRegExprPlusQuantifier.Print: string;
begin
  Result := '+';
end;

{ TcxRegExprParserItem }

constructor TcxRegExprParserItem.Create(AQuantifier: TcxRegExprQuantifier = nil);
begin
  inherited Create;
  if AQuantifier = nil then
    FQuantifier := TcxRegExprSimpleQuantifier.Create
  else
    FQuantifier := AQuantifier;
end;

destructor TcxRegExprParserItem.Destroy;
begin
  FQuantifier.Free;
  inherited Destroy;
end;

function TcxRegExprParserItem.CanMissing: Boolean;
begin
  Result := FQuantifier.CanMissing;
end;

function TcxRegExprParserItem.CanRepeat: Boolean;
begin
  Result := FQuantifier.CanRepeat;
end;

function TcxRegExprParserItem.NotQuantifier: Boolean;
begin
  Result := FQuantifier is TcxRegExprSimpleQuantifier;
end;

procedure TcxRegExprParserItem.SetQuantifier(
  AQuantifier: TcxRegExprQuantifier);
begin
  if AQuantifier <> nil then
  begin
    FQuantifier.Free;
    FQuantifier := AQuantifier;
  end;
end;

{ TcxRegExprParserSimpleItem }

constructor TcxRegExprParserSimpleItem.Create(AState: TcxRegExprState;
    AQuantifier: TcxRegExprQuantifier);
begin
  inherited Create(AQuantifier);
  FState := AState;
end;

destructor TcxRegExprParserSimpleItem.Destroy;
begin
  if FState <> nil then
    FState.Free;
  inherited Destroy;
end;

function TcxRegExprParserSimpleItem.CanEmpty: Boolean;
begin
  Result := FQuantifier.CanMissing;
end;

function TcxRegExprParserSimpleItem.Clone: TcxRegExprParserItem;
begin
  Result := TcxRegExprParserSimpleItem.Create(FState.Clone, FQuantifier.Clone);
end;

function TcxRegExprParserSimpleItem.Print: string;
begin
  Result := 'item --> ' + FQuantifier.Print + #13#10;
end;

procedure TcxRegExprParserSimpleItem.SetFinal;
begin
  TcxRegExprSimpleState(State).SetFinal;
end;

{ TcxRegExprParserBlockItem }

constructor TcxRegExprParserBlockItem.Create(AQuantifier: TcxRegExprQuantifier = nil);
begin
  inherited Create(AQuantifier);

  FStartState := TcxRegExprBlockState.Create;
  FFinishState := TcxRegExprBlockState.Create;
  FAlts := TcxRegExprParserAlts.Create;
end;

destructor TcxRegExprParserBlockItem.Destroy;
begin
  FStartState.Free;
  FFinishState.Free;
  FAlts.Free;

  inherited Destroy;
end;

function TcxRegExprParserBlockItem.CanEmpty: Boolean;
begin