stregex.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

      end;
    end else if (AToken = tknAnyChar) then begin
      if not (C in [#13, #10]) then
        Advance := 1;
    end else if (AToken = tknBegOfLine) then begin
      if (I = 0) then
        Advance := 0;
    end else if (AToken = tknEndOfLine) then begin
      if (C = #13) and (Buf[Succ(I)] = #10) then
        Advance := 0;
    end else if (AToken = tknNil) then begin
      Advance := 0;
    end else if (AToken = tknBegTag) then begin
      Advance := 0;
      if not(TagOn) then begin
        TagNum := Succ(TagNum);
        TagOn := True;
      end;
    end else if (AToken = tknEndTag) then begin
      Advance := 0;
      TagOn := False;
    end else if (AToken = tknGroup) then begin
      {we treat a group as a "character", but allow advance of multiple chars}
      {recursive call to SearchMatchPattern}
      PatPos := SearchMatchPattern(Buf, I, TagOn, TagNum, PatPtr^.NestedPattern);
      if (PatPos >= I) then begin
        I := PatPos;
        Advance := 0;
      end;
    end;
  end else begin
    {at end of line}
    {end tag marks match}
    if (AToken = tknEndTag) then
      Advance := 0;
  end;

  if (Advance >= 0) then begin
    {ignore tag words here, since they are not used}
    Result := True;
    Inc(I, Advance);
  end else
    Result := False;
end;


function TStStreamRegEx.SearchMatchPattern(var Buf    : PAnsiChar;
                                               OffSet : Integer;
                                           var TagOn  : Boolean;
                                           var TagNum : Integer;
                                           PatPtr : PStPatRecord) : Integer;
{-look for match of pattern list starting at PatPtr with Buf[offset...]}
{-return the last position that matched}
var
  I      : Integer;
  K      : Integer;
  PatRec : PStPatRecord;
  Done   : Boolean;
  AToken : TStTokens;

begin
  Done := False;
  PatRec    := PatPtr;
  while not(Done) and (PatRec <> nil) do begin
    AToken := PatRec^.Token;
    if (AToken = tknClosure) then begin
      {a closure}
      PatRec := PatRec^.NextPattern; {step past the closure in the pattern list}
      I := OffSet;                   {leave the current line position unchanged}
      {match as many as possible}
      while not(Done) and (Buf[I] <> EndStr) do begin
       if not(MatchOnePatternElement(Buf, I, TagOn, TagNum, PatRec)) then
          Done := True;
      end;
      {I points to the location that caused a non-match}
      {match rest of pattern against rest of input}
      {shrink closure by one after each failure}
      Done := False;
      K := -1;
      while not(Done) and (I >= OffSet) do begin
        K := SearchMatchPattern(Buf, I, TagOn, TagNum, PatRec^.NextPattern);
        if (K > -1) then
          Done := True
        else
          Dec(I);
      end;
      OffSet := K;   {if k=-1 then failure else success}
      Done := True;
    end else if (AToken = tknMaybeOne) then begin
      {a 0 or 1 closure}
      PatRec := PatRec^.NextPattern;   {step past the closure marker}
      {match or no match is ok, but advance lin cursor if matched}
      MatchOnePatternElement(Buf, OffSet, TagOn, TagNum, PatRec);
      {advance to the next pattern token}
      PatRec := PatRec^.NextPattern;
    end else if not(MatchOnePatternElement(Buf, OffSet,
                                           TagOn, TagNum, PatRec)) then begin
      if PatRec^.NextOK then begin
        {we get another chance because of alternation}
        PatRec := PatRec^.NextPattern;
      end else begin
        OffSet := -1;
        Done := True;
      end;
    end else begin 
      {skip over alternates if we matched already}
      while (PatRec^.NextOK) and (PatRec^.NextPattern <> nil) do
        PatRec := PatRec^.NextPattern;
      {move to the next non-alternate}
      PatRec := PatRec^.NextPattern;
    end;
  end;
  Result := OffSet;
end;


function TStStreamRegEx.FindMatch(var Buf        : PAnsiChar;
                                      PatPtr     : PStPatRecord;
                                  var REPosition : TMatchPosition) : Boolean;
var
  I,
  LPos,
  TagNum : Integer;
  TagOn  : Boolean;

begin
  LPos   := -1;
  I      := 0;
  TagNum := 0;
  TagOn := False;
  Result := False;
  REPosition.Length := 0;
  while (Buf[I] <> EndStr) and (LPos = -1) do begin
    LPos := SearchMatchPattern(Buf, I, TagOn, TagNum, PatPtr);
    Result := (LPos > -1);
    if (Result) then begin
      REPosition.StartPos := I+1;
      RePosition.EndPos   := LPos;
      RePosition.Length   := REPosition.EndPos - REPosition.StartPos + 1;
    end;
    Inc(I);
  end;
end;



procedure TStStreamRegEx.InsertLineNumber(Dest    : PAnsiChar;
                                    const S : PAnsiChar;
                                    LineNum : Integer);
var
  Count : Cardinal;
  SI    : string[8];
begin
  Dest[0] := #0;
  Count := StrLen(S);
  if (Count > MaxLineLength - 8) then
    Count := MaxLineLength - 8;
  SI := LeftPadS(IntToStr(LineNum), 6) + '  ';
  Move(SI[1], Dest[0], 8);
  Move(S^, Dest[8], Count);
  Dest[Count+8] := #0;
end;



function TStStreamRegEx.ProcessLine(    Buf       : PAnsiChar;
                                        Len       : integer;
                                        LineNum   : integer;
                                        CheckOnly : Boolean;
                                    var REPosition: TMatchPosition) : Boolean;
var
  Tmp : PAnsiChar;
begin
  GetMem(Tmp, MaxLineLength+1);
  try
    if (FSelAvoidPatPtr <> nil) then begin
      if (not Avoid) then
        Result := FindMatch(Buf, FSelAvoidPatPtr, REPosition)
      else if (Avoid) then
        Result := not(FindMatch(Buf, FSelAvoidPatPtr, REPosition))
      else
        Result := True;
    end else
      Result := True;

    if Result then begin
      {met select criterion, perhaps by default}
      FSelectCount := Succ(FSelectCount);
      if ((FReplacePatPtr <> nil) and (not CheckOnly)) then begin
        if (ooModified in FOutputOptions) then begin
          {we only want to replace and output lines that have a match}
          Result := FindMatch(Buf, FMatchPatPtr, REPosition);
        end;
        if Result then begin
          Tmp[0] := #0;
          SubLine(Buf);
          if (not (ooCountOnly in FOutputOptions)) then begin
            if (LineNumbers) then
              InsertLineNumber(Tmp, FOutlineBuf, LineNum)
            else
              StrCopy(Tmp, FOutlineBuf);
            Tmp[StrLen(Tmp)-2] := #0;
            FOutTextStream.WriteLineZ(Tmp);
          end;
          {subline keeps a count of matched lines and replaced patterns}
        end;
      end else if (FMatchPatPtr <> nil) then begin
        Result := FindMatch(Buf, FMatchPatPtr, REPosition);
        {met match criterion}
        if Result then begin
          FMatchCount := Succ(FMatchCount);
          if (not CheckOnly) then begin
            if (not (ooCountOnly in FOutputOptions)) then begin
              Buf[Len] := #0;
              if (LineNumbers) then
                InsertLineNumber(Tmp, Buf, LineNum)
              else
                StrCopy(Tmp, Buf);
              Tmp[StrLen(Tmp)] := #0;
              FOutTextStream.WriteLineZ(Tmp);
            end;
          end;
        end;
      end else begin
        {we are neither matching nor replacing, just selecting}
        {output the selected line}
        if (not CheckOnly) then begin
          if (not (ooCountOnly in FOutputOptions)) then begin
            Buf[Len] := #0;
            if (LineNumbers) then
              InsertLineNumber(Tmp, Buf, LineNum)
            else
              StrCopy(Tmp, Buf);
            Tmp[StrLen(Tmp)] := #0;
            FOutTextStream.WriteLineZ(Tmp);
          end;
        end;
      end;
    end else begin
      {non-selected line, do we write it?}
      if (ooUnselected in FOutputOptions) and
         (not (ooCountOnly in FOutputOptions)) then begin
        Buf[Len] := #0;
        if (LineNumbers) then
          InsertLineNumber(Tmp, Buf, LineNum)
        else
          StrCopy(Tmp, Buf);
        Tmp[StrLen(Tmp)] := #0;
        FOutTextStream.WriteLineZ(Tmp);
      end;
    end;
  finally
    FreeMem(Tmp, MaxLineLength+1);
  end;
end;



procedure TStStreamRegEx.SetMatchPatSL(Value : TStringList);
begin
  FMatchPatSL.Assign(Value);
  DisposeItems(FMatchPatPtr);
end;



procedure TStStreamRegEx.SetOptions(Value : TStOutputOptions);
begin
  if (Value <> FOutputOptions) then begin
    FOutputOptions := Value;
    if (ooCountOnly in FOutputOptions) then
      FOutputOptions := [ooCountOnly];
  end;
end;



procedure TStStreamRegEx.SetReplacePatSL(Value : TStringList);
begin
  FReplacePatSL.Assign(Value);
  DisposeItems(FReplacePatPtr);
end;



procedure TStStreamRegEx.SetSelAvoidPatSL(Value : TStringList);
begin
  FSelAvoidPatSL.Assign(Value);
  DisposeItems(FSelAvoidPatPtr);
end;


function TStStreamRegEx.SubLineMatchOne(Buf        : PAnsiChar;
                                        var Flags  : TStFlag;
                                        var TagOn  : Boolean;
                                        var I      : Integer;
                                        var TagNum : Integer;
                                        PatPtr     : PStPatRecord) : Boolean;
var
  Advance  : -1..255;
  lToken   : TStTokens;
  PatPos   : Integer;
  K        : Cardinal;
  C        : AnsiChar;
begin                       
  Advance := -1;
  lToken := PatPtr^.Token;
  if FIgnoreCase then
    C := AnsiUpperCase(Buf[I])[1]
  else
    C := Buf[I];

  if (C <> EndStr) then begin
    if (lToken = tknLitChar) then begin
      if (C = PatPtr^.OneChar) then
        Advance := 1;
    end else if (lToken = tknCharClass) then begin
      if (StrChPosS(PatPtr^.StrPtr^, C, K)) then
        Advance := 1;
    end else if (lToken = tknNegCharClass) then begin
      if (pos(C, NewLine) = 0) then begin
        if not (StrChPosS(PatPtr^.StrPtr^, C, K)) then
          Advance := 1;
      end;
    end else if (lToken = tknAnyChar) then begin
      if (not (C in [#13, #10])) then
        Advance := 1;
    end else if (lToken = tknBegOfLine) then begin
      if (I = 0) then
        Advance := 0;
    end else if (lToken = tknEndOfLine) then begin
      if (C = #13) and (Buf[Succ(I)] = #10) then begin
        Advance := 0;
      end;
    end else if (lToken = tknNil) then begin
      Advance := 0;
    end else if (lToken = tknBegTag) then begin
      Advance := 0;
      if not(TagOn) then begin
        Inc(TagNum);
        TagOn := True;
      end;
    end else if (lToken = tknEndTag) then begin
      Advance := 0;
      TagOn := False;
    end else if (lToken = tknGroup) then begin
      {we treat a group as a "character", but allow advance of multiple chars}

      PatPos := SubLineMatchPattern(Buf, Flags, TagOn, TagNum,
                                    I, PatPtr^.NestedPattern);
      if (PatPos >= I) then begin
        I := PatPos;
        Advance := 0;
      end;
    end;
  end else begin
    {at end of line}
    {end tag marks match}
    if (lToken = tknEndTag) then
      Advance := 0;
  end;

  if (Advance > 0) then begin
    {we had a match at this (these) character position(s)}
    {set the match flags}
    if (TagOn) then
      Flags[I] := TagNum
    else
      Flags[I] := 0;
    Inc(I, Advance);
    Result := True;
  end else if (Advance = 0) then begin
    Result := True;
  end else begin
    {this character didn't match}
    Result := False;
    Flags[I] := -1;
  end;
end;



function TStStreamRegEx.SubLineMatchPattern(Buf        : PAnsiChar;
                                            var Flags  : TStFlag;
                                            var TagOn  : Boolean;
                                            var TagNum : Integer;
                                            OffSet     : Integer;
                                            PatPtr     : PStPatRecord) : Integer;
{-look for match of pattern list starting at PatPtr with Buf[offset...]}
{return the last position that matched}
var
  I,
  LocTag   : Integer;
  PatPos   : Integer;
  PatRec   : PStPatRecord;
  Done     : Boolean;
  AToken   : TStTokens;
  OldTagOn : boolean;                                          
  OldTagNum: integer;
begin
  Done := False;
  PatRec := PatPtr;
  while not(Done) and (PatRec <> nil) do begin
    AToken := PatRec^.Token;
    if (AToken = tknClosure) then begin
      {a closure}
      PatRec := PatRec^.NextPattern; {step past the closure in the pattern list}
      I := OffSet;                   {leave the current line position unchanged}
      LocTag := TagNum;
      {match as many as possible}
      while not(Done) and (Buf[I] <> EndStr) do begin
        if not(SubLineMatchOne(Buf, Flags, TagOn,                      
                               I, LocTag, PatRec)) then
          Done := True;
      end;
      {i points to the location that caused a non-match}
      {match rest of pattern against rest of input}
      {shrink closure by one after each failure}
      Done := False;
      PatP