stregex.pas

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

  FSelAvoidPatSL := nil;

  inherited Destroy;
end;


function TStStreamRegEx.AppendS(Dest, S1, S2 : PAnsiChar;
                                Count : Cardinal) : PAnsiChar;
var
  Remaining : Cardinal;
  I         : Cardinal;
begin
  Result := Dest;
  I := StrLen(S1);
  Remaining := MaxLineLength - I;
  if (Remaining < StrLen(S2)) then
    Count := Remaining;
  Move(S1[0], Dest[0], I);
  Move(S2[0], Dest[I], Count);
  I := I + Count;
  Dest[I] := #0;
end;


function TStStreamRegEx.BuildAllPatterns : Boolean;
var
  Len : Integer;
begin
  if (FMatchPatSL.Count > 0) then begin
    DisposeItems(FMatchPatPtr);

    if (BuildPatternStr(FMatchPatStr, Len, FMatchPatSL)) then begin
      if (Len > 0) then
        GetPattern(FMatchPatStr, FMatchPatPtr)
      else
        DisposeItems(FMatchPatPtr);
      Result := True;
    end else begin
      DisposeItems(FMatchPatPtr);
      Result := False;
    end;
  end else begin
    DisposeItems(FMatchPatPtr);
    Result := True;
  end;

  if Result then begin
    if (FSelAvoidPatSL.Count > 0) then begin
      DisposeItems(FSelAvoidPatPtr);
      if (BuildPatternStr(FSelAvoidPatStr, Len, FSelAvoidPatSL)) then begin
        if (Len > 0) then
          GetPattern(FSelAvoidPatStr, FSelAvoidPatPtr)
        else
          DisposeItems(FSelAvoidPatPtr);
        Result := True;
      end else begin
        DisposeItems(FSelAvoidPatPtr);
        Result := False;
      end;
    end else begin
      DisposeItems(FSelAvoidPatPtr);
      Result := True;
    end;
  end;

  if Result then begin
    if (FReplacePatSL.Count > 0) then begin
      DisposeItems(FReplacePatPtr);
      if (BuildPatternStr(FReplacePatStr, Len, FReplacePatSL)) then begin
        if (Len > 0) then
          GetReplace(FReplacePatStr, FReplacePatPtr)
        else
          DisposeItems(FReplacePatPtr);
        Result := True;
      end else begin
        DisposeItems(FReplacePatPtr);
        Result := False;
      end;
    end else begin
      DisposeItems(FReplacePatPtr);
      Result := True;
    end;
  end;
end;



function TStStreamRegEx.BuildPatternStr(var PStr  : PAnsiChar;
                                  var Len   : Integer;
                                      SL    : TStringList) : Boolean;
var
  I,
  J   : integer;
  CurLen : Integer;                                                  {!!.01}
begin
  Len := 0;
  for I := 0 to pred(SL.Count) do
    Len := Len + Length(TrimL(SL[I]));
  if (Len = 0) then
    Result := True
  else begin
    if Assigned(PStr) then
      FreeMem(PStr, StrLen(PStr)+1);
    GetMem(PStr, Len+1);
    PStr[Len] := EndStr;
    J := 0;
    for I := 0 to pred(SL.Count) do begin
      CurLen := Length(TrimL(SL[I]));                                {!!.01}
      if CurLen > 0 then begin                                       {!!.01}
        Move(SL[I][1], PStr[J], CurLen);                             {!!.01}
        Inc(J, CurLen);                                              {!!.01}
      end;                                                           {!!.01}
    end;
    Result := True;
  end;
end;


function TStStreamRegEx.CheckString(const S : AnsiString;
                                    var REPosition : TMatchPosition) : Boolean;
var
  Tmp : PAnsiChar;
  I   : integer;
  Len : integer;
  OK  : Boolean;
begin
  I := Length(S);
  GetMem(Tmp, I+3);
  try
    if I > 0 then                                                     {!!.01}
      Move(S[1], Tmp[0], I);

    Tmp[I]   := #13;
    Tmp[I+1] := #10;
    Tmp[I+2] := EndStr;

    if (FMatchPatSL.Count > 0) then begin
      OK := BuildPatternStr(FMatchPatStr, Len, FMatchPatSL);
      if (OK) then begin
        if (Len > 0) then
          GetPattern(FMatchPatStr, FMatchPatPtr)
        else
          DisposeItems(FMatchPatPtr);
      end else
        DisposeItems(FMatchPatPtr);
    end else
      DisposeItems(FMatchPatPtr);

    if (FSelAvoidPatSL.Count > 0) then begin
      OK := BuildPatternStr(FSelAvoidPatStr, Len, FSelAvoidPatSL);
      if (OK) then begin
        if (Len > 0) then
          GetPattern(FSelAvoidPatStr, FSelAvoidPatPtr)
        else
          DisposeItems(FSelAvoidPatPtr);
      end;
    end else
      DisposeItems(FSelAvoidPatPtr);

    FMatchCount    := 0;
    FSelectCount   := 0;
    FReplaceCount  := 0;
    FInLineCount   := 0;
    FLinesPerSec   := 0;

    REPosition.LineNum := 1;
    if ((FSelAvoidPatPtr <> nil) or (FMatchPatPtr <> nil)) then
      Result := ProcessLine(Tmp, I, 1, True, REPosition)
    else begin
      Result := False;
      RaiseStError(EStRegExError, stscNoPatterns);
    end;
  finally
    FreeMem(Tmp, I+3);
  end;
end;


function TStStreamRegEx.ReplaceString(var S : AnsiString;
                                      var REPosition : TMatchPosition) : Boolean;
var
  Tmp : PAnsiChar;
  I   : integer;
  Len : integer;
  OK  : Boolean;

      function ProcessString(var S          : AnsiString;
                                 Len        : integer;
                                 LineNum    : integer;
                             var REPosition : TMatchPosition) : Boolean;
      var
        TmpBuf : PAnsiChar;
        ABuf   : PAnsiChar;
        L      : Integer;
      begin
        L := Length(S)+1;
        GetMem(TmpBuf, MaxLineLength+1);
        GetMem(ABuf, L);
        try
          StrPCopy(ABuf, S);
          if (FSelAvoidPatPtr <> nil) then begin
            Result := False;
            if (not Avoid) then
              Result := FindMatch(ABuf, FSelAvoidPatPtr, REPosition)
            else
              Result := not(FindMatch(ABuf, FSelAvoidPatPtr, REPosition));
          end else
            Result := True;

          if Result then begin
            {met select criterion, perhaps by default}
            FSelectCount := Succ(FSelectCount);
            if (FReplacePatPtr <> nil) then begin
              Result := FindMatch(ABuf, FMatchPatPtr, REPosition);
              if Result then begin
                TmpBuf[0] := #0;
                SubLine(ABuf);
                S := StrPas(FOutLineBuf);
              end;
            end;
          end;
        finally
          FreeMem(TmpBuf, MaxLineLength+1);
          FreeMem(ABuf, L);
        end;
      end;


begin
  I := Length(S);
  GetMem(Tmp, I+3);
  try
    if I > 0 then                                                  {!!.01}
      Move(S[1], Tmp[0], I);
    Tmp[I]   := #13;
    Tmp[I+1] := #10;
    Tmp[I+2] := EndStr;

    if (FMatchPatSL.Count > 0) then begin
      OK := BuildPatternStr(FMatchPatStr, Len, FMatchPatSL);
      if (OK) then begin
        if (Len > 0) then
          GetPattern(FMatchPatStr, FMatchPatPtr)
        else
          DisposeItems(FMatchPatPtr);
      end else
        DisposeItems(FMatchPatPtr);
    end else
      DisposeItems(FMatchPatPtr);

    if (FSelAvoidPatSL.Count > 0) then begin
      OK := BuildPatternStr(FSelAvoidPatStr, Len, FSelAvoidPatSL);
      if (OK) then begin
        if (Len > 0) then
          GetPattern(FSelAvoidPatStr, FSelAvoidPatPtr)
        else
          DisposeItems(FSelAvoidPatPtr);
      end;
    end else
      DisposeItems(FSelAvoidPatPtr);

    if (FReplacePatSL.Count > 0) then begin
      OK := BuildPatternStr(FReplacePatStr, Len, FReplacePatSL);
      if (OK) then begin
        if (Len > 0) then
          GetPattern(FReplacePatStr, FReplacePatPtr)
        else
          DisposeItems(FReplacePatPtr);
      end else
        DisposeItems(FReplacePatPtr);
    end else
      DisposeItems(FReplacePatPtr);

    FMatchCount    := 0;
    FSelectCount   := 0;
    FReplaceCount  := 0;
    FInLineCount   := 0;
    FLinesPerSec   := 0;

    GetMem(FInLineBuf, MaxLineLength+3);
    GetMem(FOutLineBuf, MaxLineLength+3);
    try
      REPosition.LineNum := 1;
      if ((FSelAvoidPatPtr <> nil) or (FMatchPatPtr <> nil)) and
          (Assigned(FReplacePatPtr))then begin
        Result := ProcessString(S, I, 1, REPosition);
      end else begin
        Result := False;
        RaiseStError(EStRegExError, stscNoPatterns);
      end;
    finally
      FreeMem(FInLineBuf, MaxLineLength+3);
      FreeMem(FOutLineBuf, MaxLineLength+3);
    end;
  finally
    FreeMem(Tmp, I+3);
  end;
end;


function TStStreamRegEx.ConvertMaskToRegEx(const S : AnsiString) : AnsiString;
var
  I      : integer;
  TS     : AnsiString;
begin
  I := 1;
  while (I <= Length(S)) do begin
    if (I = 1) then begin
      if not (S[1] in ['*', '?']) then begin
        TS := '((^[' ;
        TS := TS + S[1] + '])';
        Inc(I);
      end else
        TS := '(';
    end;

    if not (S[I] in ['*', '?', '.', '\']) then
      TS := TS + S[I]
    else begin
      if (S[I] = '*') then
        TS := TS + '.*'
      else if (S[I] = '?') then begin
        if (I = 1) then
          TS := TS + '(^.)'
        else
          TS := TS + '.?';
      end else begin
        TS := TS + '\' + S[I];
      end;
    end;
    Inc(I);
  end;
  Result := TS + '\n)';
end;


function TStStreamRegEx.FileMasksToRegEx(Masks : AnsiString) : Boolean;
var
  SL : TStringList;
  S  : AnsiString;
  K  : Cardinal;
  Len: Integer;
begin
  SL := TStringList.Create;
  try
    if StrChPosS(Masks, ';', K) then begin
      while (K > 0) do begin
        S := Copy(Masks, 1, K-1);
        if (Length(S) > 0) then begin
          if (SL.Count = 0) then
            SL.Add(ConvertMaskToRegEx(S))
          else
            SL.Add('|' + ConvertMaskToRegEx(S));
        end;
        Delete(Masks, 1, K);
        if not (StrChPosS(Masks, ';', K)) then
          break;
      end;
      if (Length(Masks) > 0) then
        SL.Add('|' + ConvertMaskToRegEx(Masks));
    end else begin
      if (Length(Masks) > 0) then
        SL.Add(ConvertMaskToRegEx(Masks));
    end;

    if (SL.Count > 0) then begin
      FMatchPatSL.Clear;
      FMatchPatSL.Assign(SL);
      DisposeItems(FMatchPatPtr);
      FMatchPatPtr := nil;
      if (BuildPatternStr(FMatchPatStr, Len, FMatchPatSL)) then begin
        if (Len > 0) then
          GetPattern(FMatchPatStr, FMatchPatPtr)
        else begin
          DisposeItems(FMatchPatPtr);
          FMatchPatPtr := nil;
        end;
        Result := True;
      end else begin
        DisposeItems(FMatchPatPtr);
        FMatchPatPtr := nil;
        Result := False;
      end;
      Result := True;
    end else
      Result := False;
  finally
    SL.Free;
  end;
end;



function TStStreamRegEx.Execute : Boolean;
var
  Len       : TStMemSize;
  LineNum   : Integer;
  ATime     : TDateTime;
  PC        : Cardinal;
  LPC       : Cardinal;
  BytesRead : Cardinal;
  REPosition: TMatchPosition;
  Found     : Boolean;

  Src : PAnsiChar; {!!!}
  FFoundText : AnsiString; {!!!}
begin
  if (FMatchPatSL.Count = 0) and
     (FReplacePatSL.Count = 0) and (FSelAvoidPatSL.Count = 0) then
    RaiseStError(EStRegExError, stscNoPatterns);

  if (not (BuildAllPatterns)) then
    RaiseStError(EStRegExError, stscPatternError);

  if (FMatchPatPtr = nil) and (FSelAvoidPatPtr = nil) and (FReplacePatPtr = nil) then
    RaiseStError(EStRegExError, stscNoPatterns);

  if (not (Assigned(FInputStream))) or
     ((not (Assigned(FOutputStream)) and (not (ooCountOnly in OutputOptions)))) then
    RaiseStError(EStRegExError, stscStreamsNil);

  FInTextStream := nil;