stregex.pas

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StRegEx.pas 4.03                            *}
{*********************************************************}
{* SysTools: SysTools Regular Expression Engine          *}
{*********************************************************}

{$I StDefine.inc}

unit StRegEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StConst,
  StBase,
  StStrms;

const
  StWordDelimString : string[31] = #9#32'!"&()*+,-./:;<=>?@[\]^`{|}~';
  StHexDigitString  : string[19] = '0123456789ABCDEF';

type
  TMatchPosition = packed record
    StartPos : Cardinal;
    EndPos   : Cardinal;
    Length   : Cardinal;
    LineNum  : Cardinal;
  end;

  TStOutputOption = (ooUnselected, ooModified, ooCountOnly);
  TStOutputOptions = set of TStOutputOption;

  TStTokens = (tknNil, tknLitChar, tknCharClass, tknNegCharClass,
               tknClosure, tknMaybeOne, tknAnyChar, tknBegOfLine,
               tknEndOfLine, tknGroup, tknBegTag, tknEndTag, tknDitto);

  PStPatRecord = ^TStPatRecord;
  TStPatRecord = packed record
    StrPtr        : ^ShortString;
    NestedPattern : PStPatRecord;
    NextPattern   : PStPatRecord;
    Token         : TStTokens;
    OneChar       : AnsiChar;
    NextOK        : Boolean;
  end;

  TStTagLevel = -1..9;
  TStFlag     = array[0..1023] of TStTagLevel;

  TStOnRegExProgEvent = procedure(Sender : TObject; Percent : Word) of object;
  TStOnMatchEvent = procedure(Sender     : TObject;
                              REPosition : TMatchPosition) of object;


  TStNodeHeap = class
  private
    FFreeList : PStPatRecord;

  protected
    procedure nhClearHeap;
    function nhDeepCloneNode(aNode : PStPatRecord) : PStPatRecord;

  public
    constructor Create;
    destructor Destroy; override;

    function AllocNode : PStPatRecord;
    procedure FreeNode(aNode : PStPatRecord);

    function CloneNode(aNode : PStPatRecord) : PStPatRecord;
  end;


  TStStreamRegEx = class(TObject)
  protected {private}
    { Private declarations }
    FAvoid            : Boolean;
    FIgnoreCase       : Boolean;
    FInTextStream     : TStAnsiTextStream;
    FInFileSize       : Cardinal;
    FInputStream      : TStream;

    FInLineBuf        : PAnsiChar;
    FInLineCount      : Cardinal;
    FInLineNum        : Cardinal;
    FInLineTermChar   : AnsiChar;
    FInLineTerminator : TStLineTerminator;
    FInLineLength     : integer;
    FLineNumbers      : Boolean;
    FLinesPerSec      : Cardinal;

    FMatchCount       : Cardinal;

    FMatchPatSL       : TStringList;
    FMatchPatStr      : PAnsiChar;
    FMatchPatPtr      : PStPatRecord;

    FMaxLineLength    : Cardinal;

    FNodes            : TStNodeHeap;

    FOnMatch          : TStOnMatchEvent;
    FOutLineLength    : integer;
    FOutLineTermChar  : AnsiChar;
    FOutLineTerminator: TStLineTerminator;

    FReplaceCount     : Cardinal;
    FReplacePatSL     : TStringList;
    FReplacePatStr    : PAnsiChar;
    FReplacePatPtr    : PStPatRecord;

    FOnProgress       : TStOnRegExProgEvent;
    FOutputStream     : TStream;
    FOutTextStream    : TStAnsiTextStream;
    FOutLineBuf       : PAnsiChar;

    FOutputOptions    : TStOutputOptions;

    FSelAvoidPatSL    : TStringList;
    FSelAvoidPatStr   : PAnsiChar;
    FSelAvoidPatPtr   : PStPatRecord;

    FSelectCount      : Cardinal;

  protected
    { Protected declarations }

    procedure AddTokenToPattern(var PatRec : PStPatRecord;
                                LastPatRec : PStPatRecord;
                                     Token : TStTokens;
                                         S : ShortString);
    procedure AddTokenToReplace(var PatRec : PStPatRecord;
                                LastPatRec : PStPatRecord;
                                     Token : TStTokens;
                                const S    : ShortString);             {!!.02}
    function  AppendS(Dest, S1, S2 : PAnsiChar; Count : Cardinal) : PAnsiChar;
    function  BuildAllPatterns : boolean;
    function  BuildPatternStr(var PStr  : PAnsiChar;
                              var Len   : Integer;
                                  SL    : TStringList) : Boolean;
    function  ConvertMaskToRegEx(const S : AnsiString) : String;
    procedure DisposeItems(var Data : PStPatRecord);

    procedure InsertLineNumber(Dest : PAnsiChar;
                               const S : PAnsiChar; LineNum : Integer);
    function  GetPattern(var Pattern : PAnsiChar;
                         var PatList : PStPatRecord) : Boolean;
    function  GetReplace(Pattern     : PAnsiChar;
                         var PatList : PStPatRecord) : Boolean;
    function  MakePattern(var Pattern : PAnsiChar;
                              Start   : Integer;
                              Delim   : AnsiChar;
                          var TagOn   : Boolean;
                          var PatList : PStPatRecord) : Integer;
    function  MakeReplacePattern(Pattern     : PAnsiChar;
                                 Start       : Integer;
                                 Delim       : AnsiChar;
                                 var PatList : PStPatRecord) : Integer;
    function  FindMatch(var Buf        : PAnsiChar;
                            PatPtr     : PStPatRecord;
                        var REPosition : TMatchPosition) : Boolean;
    function  MatchOnePatternElement(var Buf    : PAnsiChar;
                                     var I      : Integer;
                                     var TagOn  : Boolean;
                                     var TagNum : Integer;
                                       PatPtr   : PStPatRecord) : Boolean;
    function  ProcessLine(Buf           : PAnsiChar;
                          Len           : integer;
                          LineNum       : integer;
                          CheckOnly     : Boolean;
                          var REPosition: TMatchPosition) : Boolean;
    function  SearchMatchPattern(var Buf    : PAnsiChar;
                                     OffSet : Integer;
                                 var TagOn  : Boolean;
                                 var TagNum : Integer;
                                     PatPtr : PStPatRecord) : Integer;
    procedure SetMatchPatSL(Value : TStringList);
    procedure SetOptions(Value : TStOutputOptions);
    procedure SetReplacePatSL(Value : TStringList);
    procedure SetSelAvoidPatSL(Value : TStringList);
    procedure SubLine(Buf : PAnsiChar);
    function  SubLineFindTag(Buf         : PAnsiChar;
                             I           : Integer;
                             IEnd        : Integer;
                             TagNum      : Integer;
                             var Flags   : TStFlag;
                             var IStart  : Integer;
                             var IStop   : Integer) : Boolean;
    function  SubLineMatchOne(Buf        : PAnsiChar;
                              var Flags  : TStFlag;
                              var TagOn  : Boolean;
                              var I      : Integer;
                              var TagNum : Integer;
                              PatPtr     : PStPatRecord) : Boolean;
    function  SubLineMatchPattern(Buf        : PAnsiChar;
                                  var Flags  : TStFlag;
                                  var TagOn  : Boolean;
                                  var TagNum : Integer;
                                  OffSet     : Integer;
                                  PatPtr     : PStPatRecord) : Integer;
    procedure SubLineWrite(Buf       : PAnsiChar;
                           S         : PAnsiChar;
                           RepRec    : PStPatRecord;
                           I,
                           IEnd      : Integer;
                           var Flags : TStFlag);

  public
    { Public declarations }

    property InputStream : TStream
      read FInputStream
      write FInputStream;

    property OutputStream : TStream
      read FOutputStream
      write FOutputStream;

    constructor Create;
    destructor Destroy; override;

    function CheckString(const S : AnsiString;
                         var REPosition : TMatchPosition) : Boolean;
    function FileMasksToRegEx(Masks : AnsiString) : Boolean;
    function Execute : Boolean;
    function ReplaceString(var S : AnsiString;
                           var REPosition : TMatchPosition) : Boolean;

    property Avoid : Boolean
      read FAvoid
      write FAvoid;

    property IgnoreCase : Boolean
      read FIgnoreCase
      write FIgnoreCase;

    property InFixedLineLength : integer
      read FInLineLength
      write FInLineLength;

    property InLineTermChar : AnsiChar
      read FInLineTermChar
      write FInLineTermChar;

    property InLineTerminator : TStLineTerminator
      read FInLineTerminator
      write FInLineTerminator;

    property LineCount : Cardinal
      read FInLineCount;

    property LineNumbers : Boolean
      read FLineNumbers
      write FLineNumbers;

    property LinesMatched : Cardinal
      read FMatchCount;

    property LinesPerSecond : Cardinal
      read FLinesPerSec;

    property LinesReplaced : Cardinal
      read FReplaceCount;

    property LinesSelected : Cardinal
      read FSelectCount;

    property MatchPattern : TStringList
      read FMatchPatSL
      write SetMatchPatSL;

    property MaxLineLength : Cardinal
      read FMaxLineLength
      write FMaxLineLength;

    property OnMatch : TStOnMatchEvent
      read FOnMatch
      write FOnMatch;

    property OnProgress : TStOnRegExProgEvent
      read FOnProgress
      write FOnProgress;

    property OutFixedLineLength : integer
      read FOutLineLength
      write FOutLineLength;

    property OutLineTermChar : AnsiChar
      read FOutLineTermChar
      write FOutLineTermChar;

    property OutLineTerminator : TStLineTerminator
      read FOutLineTerminator
      write FOutLineTerminator;

    property OutputOptions : TStOutputOptions
      read FOutputOptions
      write SetOptions;

    property ReplacePattern : TStringList
      read FReplacePatSL
      write SetReplacePatSL;

    property SelAvoidPattern : TStringList
      read FSelAvoidPatSL
      write SetSelAvoidPatSL;
  end;


  TStRegEx = class(TStComponent)
  protected {private}
    FAvoid            : Boolean;
    FIgnoreCase       : Boolean;
    FInFileSize       : Cardinal;
    FInFileStream     : TFileStream;
    FInLineCount      : Cardinal;

    FInLineTermChar   : AnsiChar;
    FInLineTerminator : TStLineTerminator;
    FInFixedLineLength: integer;
    FInputFile        : AnsiString;

    FLineNumbers      : Boolean;
    FLinesPerSec      : Cardinal;

    FMatchCount       : Cardinal;

    FMatchPatSL       : TStringList;
    FMatchPatStr      : PAnsiChar;
    FMatchPatPtr      : PStPatRecord;

    FMaxLineLength    : Cardinal;

    FNodes            : TStNodeHeap;

    FOnProgress       : TStOnRegExProgEvent;
    FOnMatch          : TStOnMatchEvent;

    FOutFileStream    : TFileStream;
    FOutTextStream    : TStAnsiTextStream;
    FOutLineBuf       : PAnsiChar;

    FOutFixedLineLength : integer;
    FOutLineTermChar  : AnsiChar;
    FOutLineTerminator: TStLineTerminator;

    FOutputFile       : AnsiString;
    FOutputOptions    : TStOutputOptions;

    FReplaceCount     : Cardinal;
    FReplacePatSL     : TStringList;
    FReplacePatStr    : PAnsiChar;
    FReplacePatPtr    : PStPatRecord;

    FSelAvoidPatSL    : TStringList;
    FSelAvoidPatStr   : PAnsiChar;
    FSelAvoidPatPtr   : PStPatRecord;

    FSelectCount      : Cardinal;

    FStream           : TStStreamRegEx;

  protected
    procedure SetMatchPatSL(Value : TStringList);
    procedure SetOptions(Value : TStOutputOptions);
    procedure SetReplacePatSL(Value : TStringList);
    procedure SetSelAvoidPatSL(Value : TStringList);
    procedure SetStreamProperties;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function CheckString(const S : AnsiString;
                         var REPosition : TMatchPosition) : Boolean;
    function FileMasksToRegEx(const Masks : AnsiString) : Boolean;     {!!.02}
    function Execute : Boolean;
    function ReplaceString(var S : AnsiString;
                           var REPosition : TMatchPosition) : Boolean;

    property LineCount : Cardinal
      read FInLineCount;

    property LinesMatched : Cardinal
      read FMatchCount;

    property LinesPerSecond : Cardinal
      read FLinesPerSec;

    property LinesReplaced : Cardinal
      read FReplaceCount;

    property LinesSelected : Cardinal
      read FSelectCount;

    property MaxLineLength : Cardinal