 {
 ****************************************************************************
 CRW32 project
 Copyright (c) 2001-2022 Alexey Kuryakin kouriakine@mail.ru
 Regular expression support procedures.
 Provide single API for many RegExp engines.
 Modifications:
 20220127 - Creation: uses 2 engines (TRegExpr,VBScript.RegExp).
 20220203 - TRegExpStorage for better performance
 20220205 - regexp_pcre,regexp_escape
 20221216 - LC_CTYPE_xxx constants
 ****************************************************************************
 }

unit _regexp;

{$I _sysdef}

interface

uses
 sysutils, windows, math, classes, comobj, perlregex, pcrelib, regexpr,
 _alloc, _str, _fio, _ef, _hl;

const //////////////////////////////////////////////// Engine identifiers: ////////////////////////////////////////////
 regexp_def                      = 0;               // Correspond regexp_default_engine
 regexp_pas                      = 1;               // TRegExpr by A.Sorokin, Pascal
 regexp_vbs                      = 2;               // VBScript.RegExp  by Microsoft
 regexp_pcrelib                  = 3;               // TPerlRegEx by Jan Goyvaerts
 regexp_valid_engines            = [1..3];          // All valid engines numbers
 regexp_fallback_engine          = regexp_pas;      // Fallback value use for safety
 regexp_valid_modifiers          = 'igmrsx';        // All supported modifiers
 regexp_reset_modifiers          = '-igmrsx';       // Uses to reset modifiers
 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 regexp_default_engine    : Integer = regexp_pas;   // Default engine number
 regexp_default_modifiers : String  = '-igmrsx';    // Default Modifiers
 regexp_default_usesubst  : Boolean = true;         // Default UseSubst
 regexp_default_useslash  : Boolean = true;         // Default UseSlash
 regexp_default_execmax   : Integer = 0;            // Default ExecMax
 regexp_default_savepar   : Boolean = false;        // Default SavePar
 regexp_default_greedy    : Boolean = true;         // Default Greedy
 ////////////////////////////////////////////////// Default options for TRegExpMaster.SetDefaultOptions //////////////
 regexp_default_options   : String  = 'Engine=1,Modifiers=-irsgmx,ExecMax=0,UseSubst=1,UseSlash=1,Greedy=1,SavePar=0';
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

const ////// https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap07.html //////// Posix charsets ////////
 LC_CTYPE_digit  = '0123456789';                                                            // [:digit:]
 LC_CTYPE_xdigit = '0123456789ABCDEFabcdef';                                                // [:xdigit:]
 LC_CTYPE_upper  = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';                                            // [:upper:]
 LC_CTYPE_lower  = 'abcdefghijklmnopqrstuvwxyz';                                            // [:lower:]
 LC_CTYPE_punct  = '!"#$%&''()*+,-./:;<=>?@[\]^_`{|}~';                                     // [:punct:]
 LC_CTYPE_blank  = #$09#$20;                                                                // [:blank:]
 LC_CTYPE_space  = #$09#$0A#$0B#$0C#$0D#$20;                                                // [:space:]
 LC_CTYPE_cntrl  = #$00#$01#$02#$03#$04#$05#$06#$07#$08#$09#$0A#$0B#$0C#$0D#$0E#$0F         // [:cntrl:]
                 + #$10#$11#$12#$13#$14#$15#$16#$17#$18#$19#$1A#$1B#$1C#$1D#$1E#$1F#$7F;    //
 LC_CTYPE_alpha  = LC_CTYPE_upper+LC_CTYPE_lower;                                           // [:alpha:]
 LC_CTYPE_alnum  = LC_CTYPE_digit+LC_CTYPE_alpha;                                           // [:alnum:]
 LC_CTYPE_graph  = LC_CTYPE_alnum+LC_CTYPE_punct;                                           // [:graph:]
 LC_CTYPE_print  = LC_CTYPE_alnum+LC_CTYPE_punct+#$20;                                      // [:print:]
 LC_CTYPE_word   = LC_CTYPE_alnum+'_';                                                      // [:word:]
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

const // ProgID for VBS RegExp object
 VbsRegExpProgId = 'VBScript.RegExp';

const // Limit for submatches
 MaxSubMatchNum = RegExpr.NSUBEXP;

type  // Wrapper for RegExp engines
 TRegExpMatch = class;
 TRegExpStorage = class;
 TRegExpMaster = class(TMasterObject)
 private
  myErrors   : Cardinal;        // Error counter
  myEngine   : Integer;         // Engine number or 0 on error
  myStorage  : TRegExpStorage;  // Storage for matches & params
  myRegExpr  : TRegExpr;        // Uses with Engine = regexp_pas
  myVbsRex   : Variant;         // Uses with Engine = regexp_vbs
  myPcreRex  : TPerlRegEx;      // Uses with Engine = regexp_pcre
  myExecMax  : Integer;         // Limit for Exec call
  mySavePar  : Boolean;         // Save Input params to storage
  myUseSubst : Boolean;         // Replace use substitutions
  myUseSlash : Boolean;         // Use slash /Pattern/igm
  myGlobal   : Boolean;         // Modifier g - standard
  myGreedy   : Boolean;         // Modifier g - TRegExpr
  function  GetErrors:Cardinal;
  function  GetEngine:Integer;
  function  GetVersion:String;
  function  GetStorage:TRegExpStorage;
  function  GetPattern:String;
  procedure SetPattern(const aPattern:String);
  function  GetExecMax:Integer;
  procedure SetExecMax(v:Integer);
  function  GetUseSubst:Boolean;
  procedure SetUseSubst(v:Boolean);
  function  GetUseSlash:Boolean;
  procedure SetUseSlash(v:Boolean);
  function  GetSavePar:Boolean;
  procedure SetSavePar(v:Boolean);
  function  GetModifier(n:Char):Boolean;
  procedure SetModifier(n:Char; v:Boolean);
  function  GetIgnoreCase:Boolean;
  procedure SetIgnoreCase(v:Boolean);
  function  GetGlobal:Boolean;
  procedure SetGlobal(v:Boolean);
  function  GetGreedy:Boolean;
  procedure SetGreedy(v:Boolean);
  function  GetMultiline:Boolean;
  procedure SetMultiline(v:Boolean);
  function  GetSingleline:Boolean;
  procedure SetSingleline(v:Boolean);
  function  GetRussian:Boolean;
  procedure SetRussian(v:Boolean);
  function  GetExtended:Boolean;
  procedure SetExtended(v:Boolean);
  function  GetModifiers:String;
  procedure SetModifiers(const arg:String);
  function  GetWordChars:String;
  function  GetSpaceChars:String;
  function  GetLineSeparators:String;
  function  GetLinePairedSeparator:String;
  function  GetMatchNum(i:Integer):Integer;
  procedure SetMatchNum(i:Integer; c:Integer);
  function  GetMatchPos(i,j:Integer):Integer;
  procedure SetMatchPos(i,j:Integer; p:Integer);
  function  GetMatchLen(i,j:Integer):Integer;
  procedure SetMatchLen(i,j:Integer; l:Integer);
  function  GetMatchStr(i,j:Integer):String;
  procedure SetMatchStr(i,j:Integer; s:String);
  procedure BadEngine(aEngine:Integer);
  procedure BugReport(E:Exception; Sender:TObject=nil; Note:LongString='');
  function  GetOptions:String;
  procedure SetOptions(Opt:String);
 public   // Creation / destruction
  constructor Create(aEngine:Integer=0; const aPattern:String=''; aOptions:String='');
  destructor  Destroy; override;
 public   // Identification and storage
  property  Engine     : Integer     read GetEngine;
  property  Version    : String      read GetVersion;
  property  Storage    : TRegExpStorage read GetStorage;
  class function Engines:String; // List of engines with line delimiters
 public    // Engine=1,Modifiers=-igmrsx,ExecMax=0,UseSubst=1,Greedy=1,SavePar=0
  class function  GetDefaultOptions:String;
  class procedure SetDefaultOptions(aOptions:String);
 public    // Escape RegExp special chars with \ to make string S valid for Pattern
  class function EscapeRegExpChars(const S:String; Mode:Integer=3):String;
 public   // Modifiers
  function  AllModifiers:String; // List of all supported modifiers
  property  Modifier[n:Char]:Boolean read GetModifier    write SetModifier;
  property  IgnoreCase : Boolean     read GetIgnoreCase  write SetIgnoreCase;
  property  Global     : Boolean     read GetGlobal      write SetGlobal;
  property  Greedy     : Boolean     read GetGreedy      write SetGreedy;
  property  Multiline  : Boolean     read GetMultiline   write SetMultiline;
  property  Singleline : Boolean     read GetSingleline  write SetSingleline;
  property  Russian    : Boolean     read GetRussian     write SetRussian;
  property  Extended   : Boolean     read GetExtended    write SetExtended;
  property  Modifiers  : String      read GetModifiers   write SetModifiers;
 public   // Pattern is regular expression to work with
  property  Pattern    : String      read GetPattern  write SetPattern;
 public   // General seach/replace functions
  function  Test(const aInput:String):Boolean;
  function  Exec(const aInput:String):Integer;
  function  Replace(const aInput,aReplacer:String):String;
 public   // Matches found by Exec call
  property  MatchNum[i:Integer]   : Integer read GetMatchNum write SetMatchNum;
  property  MatchPos[i,j:Integer] : Integer read GetMatchPos write SetMatchPos;
  property  MatchLen[i,j:Integer] : Integer read GetMatchLen write SetMatchLen;
  property  MatchStr[i,j:Integer] : String  read GetMatchStr write SetMatchStr;
 public   // Addon parameters
  property  Errors     : Cardinal    read GetErrors;                        // Error counter
  property  ExecMax    : Integer     read GetExecMax     write SetExecMax;  // Limit for Exec
  property  UseSubst   : Boolean     read GetUseSubst    write SetUseSubst; // Replace use substitutions
  property  UseSlash   : Boolean     read GetUseSlash    write SetUseSlash; // Use slash like /Pattern/igm
  property  SavePar    : Boolean     read GetSavePar     write SetSavePar;  // Save Input params to storage
  property  Options    : String      read GetOptions     write SetOptions;  // Engine=*,Modifiers=*,ExecMax=*,UseSubst=*,SavePar=*
  property  WordChars  : String      read GetWordChars;                     // Uses for \w
  property  SpaceChars : String      read GetSpaceChars;                    // Uses for \s
  property  LineSeparators      : String read GetLineSeparators;            // Line separators
  property  LinePairedSeparator : String read GetLinePairedSeparator;       // CRLF
 public   // Debug & browse
  function  DumpCode:String;
  function  DumpData:String;
 public   // Control (get/set) params
  function  Control(arg:String):String;
 end;
 //
 // TRegExpMatch
 //
 TRegExpMatch = class(TMasterObject)
 private
  myCount : Integer;
  myMatch : array[0..MaxSubMatchNum] of record Pos,Len:Integer; Str:String; end;
  function  GetCount:Integer;
  procedure SetCount(n:Integer);
  function  GetPos(i:Integer):Integer;
  procedure SetPos(i:Integer; v:Integer);
  function  GetLen(i:Integer):Integer;
  procedure SetLen(i:Integer; v:Integer);
  function  GetStr(i:Integer):String;
  procedure SetStr(i:Integer; v:String);
 public
  constructor Create;
  destructor  Destroy; override;
 public
  procedure Clear;
 public   // NB: Pos/Len/Str[i] indexed as i=0..Count. Be care.
  property  Count:Integer          read GetCount write SetCount;
  property  Pos[i:Integer]:Integer read GetPos   write SetPos;
  property  Len[i:Integer]:Integer read GetLen   write SetLen;
  property  Str[i:Integer]:String  read GetStr   write SetStr;
 end;
 TRegExpStorage = class(TMasterObject)
 private
  myList      : TList;
  myInput     : String;
  myPattern   : String;
  myReplacer  : String;
  myModifiers : String;
  function  GetCount:Integer;
  procedure SetCount(n:Integer);
  function  GetItems(i:Integer):TRegExpMatch;
  function  GetInput:String;
  procedure SetInput(s:String);
  function  GetPattern:String;
  procedure SetPattern(s:String);
  function  GetReplacer:String;
  procedure SetReplacer(s:String);
  function  GetModifiers:String;
  procedure SetModifiers(s:String);
 public
  constructor Create;
  destructor  Destroy; override;
 public
  procedure Clear;
 public   // NB: Items[i] indexed as i=1..Count. Be care.
  property Items[i:Integer]:TRegExpMatch  read GetItems; default;
 public
  property Count     : Integer read GetCount     write SetCount;
  property Input     : String  read GetInput     write SetInput;
  property Pattern   : String  read GetPattern   write SetPattern;
  property Replacer  : String  read GetReplacer  write SetReplacer;
  property Modifiers : String  read GetModifiers write SetModifiers;
 end;

function NewRegExpMaster(Engine:Integer=0; Pattern:String=''; Options:String=''):TRegExpMaster;
procedure Kill(var TheObject:TRegExpMaster); overload;

const
 pcre_user_malloc         : Boolean = false;
 pcre_malloc_count        : Integer = 0;
 pcre_stack_malloc_count  : Integer = 0;

////////////////////////////////////////////////////////////////////////////////
// Rex API - easy RegEx interface.
////////////////////////////////////////////////////////////////////////////////
// regexp_init(n,p)         - init RegExp with engine,pattern (n,p), return reference.
// regexp_init(n,p,o)       - init RegExp with engine,pattern (n,p), return reference,
//                            use options (o) like Modifiers=rsg-imx,UseSubst=1,...
// regexp_free(rex)         - free RegExp object (from regexp_init) with reference (rex).
// regexp_ref(rex)          - return RegExp object or nil if one not found.
// regexp_ctrl(rex,arg)     - control RegExp object (rex) with argument (arg).
//                            if (arg) is  like (name), return value by this (name).
//                            if (arg) is like (name=value), assign (value) to (name),
//                            anyway return actual value of (name) property.
//                            Valid names are:
//                            Engine        - actual engine number
//                            Engines       - list of engines (names)
//                            Pattern       - regular expression to work with
//                            Modifiers     - modifiers as string like igm-rsx
//                            IgnoreCase    - modifier /i to use case insensitive mode
//                            Global        - modifier /g to search/replace globally
//                            Multiline     - modifier /m to in multiline text
//                            Russian       - modifier /r to use extended Russian support
//                            SingleLine    - modifier /s for single line mode
//                            Extended      - modifier /x for extended syntax mode
//                            Greedy        - greedy mode (only TRegExpr)
//                            UseSubst      - flag (0/1) to use substitutions on Replace
//                            UseSlash      - use slash like /Pattern/igm like JavaScript
//                            ExecMax       - max.number of matches for Exec, 0=unlimited
//                            SavePar       - save (Test,Exec,Replace) call parameters to Storage
// regexp_test(rex,arg)     - Test argument (arg) is match to seach Pattern.
// regexp_exec(rex,arg)     - Execute argument (arg) with seach Pattern.
//                            Return number of matches found.
// regexp_replace(rex,arg,rep) - replace input (arg) to given replacer (rep) with
//                            specified Pattern
// regexp_matchnum(rex,i)   - for i=0 return match number (count of matches)
//                          - for i>0 return submatch number of match[i]
// regexp_matchpos(rex,i,j) - for i>0,j=0 return position of match[i]
//                            for i>0,j>0 return position of submatch[j] in match[i]
// regexp_matchlen(rex,i,j) - for i>0,j=0 return length of match[i]
//                            for i>0,j>0 return length of submatch[j] in match[i]
// regexp_matchstr(rex,i,j) - for i>0,j=0 return string of match[i]
//                            for i>0,j>0 return string of submatch[j] in match[i]
// regexp_escape(arg)       - escape all RegExp special chars in (arg) with \ char
//                            so result is valid string for RegExp`s Pattern use
//
////////////////////////////////////////////////////////////////////////////////

function regexp_init(engine:Integer; pattern:String; options:String=''):Integer;
function regexp_free(rex:Integer):Boolean;
function regexp_ref(rex:Integer):TRegExpMaster;
function regexp_ctrl(rex:Integer; arg:String):String;
function regexp_test(rex:Integer; arg:String):Boolean;
function regexp_exec(rex:Integer; arg:String):Integer;
function regexp_replace(rex:Integer; arg,rep:String):String;
function regexp_matchnum(rex:Integer; i:Integer):Integer;
function regexp_matchpos(rex:Integer; i,j:Integer):Integer;
function regexp_matchlen(rex:Integer; i,j:Integer):Integer;
function regexp_matchstr(rex:Integer; i,j:Integer):String;
function regexp_escape(arg:String):String;

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  sid_Errors,
  sid_Engine,
  sid_Engines,
  sid_Version,
  sid_Pattern,
  sid_Input,
  sid_Replacer,
  sid_IgnoreCase,
  sid_Global,
  sid_Greedy,
  sid_Multiline,
  sid_Singleline,
  sid_Russian,
  sid_Extended,
  sid_DumpCode,
  sid_DumpData,
  sid_AllModifiers,
  sid_Modifiers,
  sid_UseSubst,
  sid_UseSlash,
  sid_ExecMax,
  sid_SavePar,
  sid_WordChars,
  sid_SpaceChars,
  sid_LineSeparators,
  sid_LinePairedSeparator,
  sid_Options,
  sid_Asterisk,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:String; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'Errors'              , sid_Errors);
 AddSid( 'Engine'              , sid_Engine);
 AddSid( 'Engines'             , sid_Engines);
 AddSid( 'Version'             , sid_Version);
 AddSid( 'Pattern'             , sid_Pattern);
 AddSid( 'Input'               , sid_Input);
 AddSid( 'Replacer'            , sid_Replacer);
 AddSid( 'IgnoreCase'          , sid_IgnoreCase);
 AddSid( 'Global'              , sid_Global);
 AddSid( 'Greedy'              , sid_Greedy);
 AddSid( 'Multiline'           , sid_Multiline);
 AddSid( 'Singleline'          , sid_Singleline);
 AddSid( 'Russian'             , sid_Russian);
 AddSid( 'Extended'            , sid_Extended);
 AddSid( 'DumpCode'            , sid_DumpCode);
 AddSid( 'DumpData'            , sid_DumpData);
 AddSid( 'AllModifiers'        , sid_AllModifiers);
 AddSid( 'Modifiers'           , sid_Modifiers);
 AddSid( 'UseSubst'            , sid_UseSubst);
 AddSid( 'UseSlash'            , sid_UseSlash);
 AddSid( 'ExecMax'             , sid_ExecMax);
 AddSid( 'SavePar'             , sid_SavePar);
 AddSid( 'WordChars'           , sid_WordChars);
 AddSid( 'SpaceChars'          , sid_SpaceChars);
 AddSid( 'LineSeparators'      , sid_LineSeparators);
 AddSid( 'LinePairedSeparator' , sid_LinePairedSeparator);
 AddSid( 'Options'             , sid_Options);
 AddSid( '*'                   , sid_Asterisk);
end;

function Identify(const key:String):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

 //////////////////////////////
 // TRegExpMatch implementation
 //////////////////////////////

constructor TRegExpMatch.Create;
begin
 inherited Create;
 myCount:=0;
end;

destructor TRegExpMatch.Destroy;
begin
 Clear;
 inherited Destroy;
end;

procedure TRegExpMatch.Clear;
var i:Integer;
begin
 if (Self=nil) then Exit;
 for i:=0 to Min(myCount,High(myMatch)) do myMatch[i].Str:='';
end;

function TRegExpMatch.GetCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 Result:=myCount;
end;

procedure TRegExpMatch.SetCount(n:Integer);
begin
 if (Self=nil) then Exit;
 if (n<0) then n:=0;
 if (n<myCount) then n:=myCount;
 if (n>High(myMatch)) then n:=High(myMatch);
 myCount:=n;
end;

function TRegExpMatch.GetPos(i:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then Exit;
 Result:=myMatch[i].Pos;
end;

procedure TRegExpMatch.SetPos(i:Integer; v:Integer);
begin
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then SetCount(i);
 if (i>myCount) then Exit;
 myMatch[i].Pos:=Max(0,v);
end;

function TRegExpMatch.GetLen(i:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then Exit;
 Result:=myMatch[i].Len;
end;

procedure TRegExpMatch.SetLen(i:Integer; v:Integer);
begin
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then SetCount(i);
 if (i>myCount) then Exit;
 myMatch[i].Len:=Max(0,v);
end;

function TRegExpMatch.GetStr(i:Integer):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then Exit;
 Result:=myMatch[i].Str;
end;

procedure TRegExpMatch.SetStr(i:Integer; v:String);
begin
 if (Self=nil) then Exit;
 if (i<0) or (i>High(myMatch)) then Exit;
 if (i>myCount) then SetCount(i);
 if (i>myCount) then Exit;
 myMatch[i].Str:=v;
end;

 ////////////////////////////////
 // TRegExpStorage implementation
 ////////////////////////////////

constructor TRegExpStorage.Create;
begin
 inherited Create;
 myList:=TList.Create;
 Clear;
end;

destructor TRegExpStorage.Destroy;
begin
 Clear;
 Kill(myList);
 inherited Destroy;
end;

procedure TRegExpStorage.Clear;
begin
 if (Self=nil) then Exit;
 SetCount(0);
 myInput:='';
 myPattern:='';
 myReplacer:='';
 myModifiers:='';
end;

function TRegExpStorage.GetCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 Result:=myList.Count;
end;

procedure TRegExpStorage.SetCount(n:Integer);
var Obj:TObject;
begin
 if (Self=nil) then Exit;
 if (n<0) then n:=0;
 while (myList.Count<n) do myList.Add(TRegExpMatch.Create);
 while (myList.Count>n) do begin
  Obj:=myList[myList.Count-1];
  myList.Delete(myList.Count-1);
  if (Obj<>nil) then Obj.Free;
 end;
end;

function TRegExpStorage.GetItems(i:Integer):TRegExpMatch;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (i<1) or (i>myList.Count) then Exit;
 Result:=myList[i-1]; // NB: Indexed from 1 to Count.
end;

function TRegExpStorage.GetInput:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Result:=myInput;
end;

procedure TRegExpStorage.SetInput(s:String);
begin
 if (Self=nil) then Exit;
 myInput:=s;
end;

function TRegExpStorage.GetPattern:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Result:=myPattern;
end;

procedure TRegExpStorage.SetPattern(s:String);
begin
 if (Self=nil) then Exit;
 myPattern:=s;
end;

function TRegExpStorage.GetReplacer:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Result:=myReplacer;
end;

procedure TRegExpStorage.SetReplacer(s:String);
begin
 if (Self=nil) then Exit;
 myReplacer:=s;
end;

function TRegExpStorage.GetModifiers:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Result:=myModifiers;
end;

procedure TRegExpStorage.SetModifiers(s:String);
begin
 if (Self=nil) then Exit;
 myModifiers:=s;
end;

 /////////////////////////////////////////////
 // TPerlRegEx PCRE memory allocation routines
 /////////////////////////////////////////////
 
function pcre_malloc_handler(Size: Integer): Pointer; cdecl;
begin
 Result:=nil;
 if (Size<=0) then Exit;
 try
  Result:=Allocate(Size);
  LockedInc(pcre_malloc_count);
 except
  on E:Exception do BugReport(E,nil,'pcre_free_handler');
 end;
end;

procedure pcre_free_handler(P: Pointer); cdecl;
begin
 if (P<>nil) then
 try
  Deallocate(P);
  LockedDec(pcre_malloc_count);
 except
  on E:Exception do BugReport(E,nil,'pcre_free_handler');
 end;
end;

function pcre_stack_malloc_handler(Size: Integer): Pointer; cdecl;
begin
 Result:=nil;
 if (Size<=0) then Exit;
 try
  Result:=Allocate(Size);
  LockedInc(pcre_stack_malloc_count);
 except
  on E:Exception do BugReport(E,nil,'pcre_stack_malloc_handler');
 end;
end;

procedure pcre_stack_free_handler(P: Pointer); cdecl;
begin
 if (P<>nil) then
 try
  Deallocate(P);
  LockedDec(pcre_stack_malloc_count);
 except
  on E:Exception do BugReport(E,nil,'pcre_stack_free_handler');
 end;
end;

function  pcre_callout_handler(var callout_block: pcre_callout_block): Integer; cdecl;
begin
 Result:=0;
end;

procedure pcre_initialize_dll;
var first:Boolean;
begin
 first:=not IsPCRELoaded;
 if not LoadPCRE then raise EPerlRegEx.Create('Could not load pcrelib.dll');
 if not IsPCREAssigned then raise EPerlRegEx.Create('Could not connect pcrelib.dll');
 if first and pcre_user_malloc then begin
  SetPCREMallocCallback(pcre_malloc_handler);
  SetPCREFreeCallback(pcre_free_handler);
  SetPCREStackMallocCallback(pcre_stack_malloc_handler);
  SetPCREStackFreeCallback(pcre_stack_free_handler);
  //SetPCRECalloutCallback(pcre_callout_handler);
 end;
end;

procedure pcre_finalize;
begin
 if IsPCRELoaded then
 try
  UnloadPCRE;
  ResourceLeakageLog(Format('%-60s = %d',['pcre_malloc_count',pcre_malloc_count]));
  ResourceLeakageLog(Format('%-60s = %d',['pcre_stack_malloc_count',pcre_stack_malloc_count]));
 except
  on E:Exception do BugReport(E,nil,'pcre_finalize');
 end;
end;

 /////////////////////////////////////
 // TRegExpMaster class implementation
 /////////////////////////////////////

constructor TRegExpMaster.Create(aEngine:Integer=0; const aPattern:String=''; aOptions:String='');
begin
 inherited Create;
 myEngine:=0;
 myRegExpr:=nil;
 myStorage:=nil;
 mySavePar:=regexp_default_savepar;
 myExecMax:=regexp_default_execmax;
 myUseSubst:=regexp_default_usesubst;
 myUseSlash:=regexp_default_useslash;
 myErrors:=0;
 try
  if not (aEngine in regexp_valid_engines) then aEngine:=regexp_default_engine;
  if not (aEngine in regexp_valid_engines) then aEngine:=regexp_fallback_engine;
  myStorage:=TRegExpStorage.Create;
  myStorage.Master:=myStorage;
  case aEngine of
   regexp_pas : begin
    myEngine:=aEngine;
    myRegExpr:=TRegExpr.Create;
    Modifiers:=regexp_default_modifiers;
    Greedy:=regexp_default_greedy;
    Options:=aOptions;
    Pattern:=aPattern;
   end;
   regexp_vbs : begin
    myEngine:=aEngine;
    myVbsRex:=CreateOleObject(VbsRegExpProgId);
    Modifiers:=regexp_default_modifiers;
    Greedy:=regexp_default_greedy;
    Options:=aOptions;
    Pattern:=aPattern;
   end;
   regexp_pcrelib: begin
    myEngine:=aEngine;
    pcre_initialize_dll;
    myPcreRex:=TPerlRegEx.Create(nil);
    Modifiers:=regexp_default_modifiers;
    Greedy:=regexp_default_greedy;
    Options:=aOptions;
    Pattern:=aPattern;
   end;
   else BadEngine(aEngine);
  end;
  if (myErrors>0) then myEngine:=-1;
 except
  on E:Exception do begin
   BugReport(E,Self,'Create');
   myEngine:=-1;
  end;
 end;
end;

destructor TRegExpMaster.Destroy;
begin
 FreeAndNil(myStorage);
 FreeAndNil(myRegExpr);
 FreeAndNil(myPcreRex);
 VarClear(myVbsRex);
 inherited Destroy;
end;

procedure TRegExpMaster.BadEngine(aEngine:Integer);
begin
 raise ESoftException.Create(Format('Bad Engine %d.',[aEngine]));
end;

procedure TRegExpMaster.BugReport(E:Exception; Sender:TObject=nil; Note:LongString='');
begin
 _alloc.BugReport(E,Sender,Note);
 if Assigned(Self) then inc(myErrors);
end;

function TRegExpMaster.GetErrors:Cardinal;
begin
 Result:=0;
 if (Self=nil) then Exit;
 Result:=myErrors;
end;

class function TRegExpMaster.Engines:String;
begin
 Result:=TRegExpr.ClassName+LineEnding     // TRegExpr
        +VbsRegExpProgId+LineEnding        // VBScript.RegExp
        +TPerlRegEx.ClassName+LineEnding;  // TPerlRegEx
end;

class function TRegExpMaster.GetDefaultOptions:String;
const Delim=',';
begin
 Result:=Format('Engine=%d',[regexp_default_engine])+Delim
        +Format('Modifiers=%s',[regexp_default_modifiers])+Delim
        +Format('ExecMax=%d',[regexp_default_execmax])+Delim
        +Format('UseSubst=%d',[Ord(regexp_default_usesubst)])+Delim
        +Format('UseSlash=%d',[Ord(regexp_default_useslash)])+Delim
        +Format('Greedy=%d',[Ord(regexp_default_greedy)])+Delim
        +Format('SavePar=%d',[Ord(regexp_default_savepar)]);
end;

class procedure TRegExpMaster.SetDefaultOptions(aOptions:String);
var buff,sv:String; iv:Integer;
begin
 try
  buff:=aOptions;
  buff:=StringReplace(buff,',',LineEnding,[rfReplaceAll]);
  buff:=StringReplace(buff,';',LineEnding,[rfReplaceAll]);
  sv:=CookieScan(buff,'Engine');
  if Str2Int(sv,iv) then begin
   if (iv in regexp_valid_engines) then regexp_default_engine:=iv;
  end else begin
   iv:=WordIndex(sv,TRegExpMaster.Engines,ScanSpaces);
   if (iv in regexp_valid_engines) then regexp_default_engine:=iv;
  end;
  sv:=CookieScan(buff,'Modifiers'); if (sv<>'')       then regexp_default_modifiers:=sv;
  sv:=CookieScan(buff,'ExecMax');   if Str2Int(sv,iv) then regexp_default_execmax:=Max(0,iv);
  sv:=CookieScan(buff,'UseSubst');  if Str2Int(sv,iv) then regexp_default_usesubst:=(iv>0);
  sv:=CookieScan(buff,'UseSlash');  if Str2Int(sv,iv) then regexp_default_useslash:=(iv>0);
  sv:=CookieScan(buff,'SavePar');   if Str2Int(sv,iv) then regexp_default_savepar:=(iv>0);
  sv:=CookieScan(buff,'Greedy');    if Str2Int(sv,iv) then regexp_default_greedy:=(iv>0);
 except
  on E:Exception do _alloc.BugReport(E,nil,'SetDefaultOptions');
 end;
end;

class function TRegExpMaster.EscapeRegExpChars(const S:String; Mode:Integer=3):String;
var I:Integer;
begin
 Result:=S;
 I:=Length(Result);
 while (I>0) do begin
  case Result[I] of
   // Escape standard RegExp special chars:
   '.','[',']','(',')','?','*','+','{','}','^','$','|','\' : Insert('\',Result,I);
   // Escape space chars with well known metasymbols
   ASCII_HT            : if HasFlags(Mode,1) then Result:=Copy(Result,1,I-1)+'\t'+Copy(Result,I+1,MaxInt);
   ASCII_LF            : if HasFlags(Mode,1) then Result:=Copy(Result,1,I-1)+'\n'+Copy(Result,I+1,MaxInt);
   ASCII_VT            : if HasFlags(Mode,1) then Result:=Copy(Result,1,I-1)+'\v'+Copy(Result,I+1,MaxInt);
   ASCII_FF            : if HasFlags(Mode,1) then Result:=Copy(Result,1,I-1)+'\f'+Copy(Result,I+1,MaxInt);
   ASCII_CR            : if HasFlags(Mode,1) then Result:=Copy(Result,1,I-1)+'\r'+Copy(Result,I+1,MaxInt);
   // Escape control chars with \xHH:
   ASCII_NUL           : if HasFlags(Mode,2) then Result:=Copy(Result,1,I-1)+'\x'+HexB(Ord(Result[I]))+Copy(Result,I+1,MaxInt);
   ASCII_SOH..ASCII_BS : if HasFlags(Mode,2) then Result:=Copy(Result,1,I-1)+'\x'+HexB(Ord(Result[I]))+Copy(Result,I+1,MaxInt);
   ASCII_SO..ASCII_US  : if HasFlags(Mode,2) then Result:=Copy(Result,1,I-1)+'\x'+HexB(Ord(Result[I]))+Copy(Result,I+1,MaxInt);
   ASCII_DEL           : if HasFlags(Mode,2) then Result:=Copy(Result,1,I-1)+'\x'+HexB(Ord(Result[I]))+Copy(Result,I+1,MaxInt);
   // Escape addon chars:
   '/'                     : if HasFlags(Mode,4) then Insert('\',Result,I); // Useful for JavaScript
   '=','!','<','>',':','-' : if HasFlags(Mode,8) then Insert('\',Result,I); // Useful for safety
  end;
  Dec(I);
 end;
end;

function TRegExpMaster.GetEngine:Integer;
begin
 Result:=-1;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myEngine;
end;

function TRegExpMaster.GetVersion:String;
var s:String;
 function pcre_version:String; begin Result:='7.9 2009-04-11'; end;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=Format('%s %d.%d Copyright (c) 2004 Andrey Sorokin anso@mail.ru',
            [TRegExpr.ClassName,myRegExpr.VersionMajor,myRegExpr.VersionMinor])
   end;
   regexp_vbs: begin
    s:=GUIDToString(ProgIDToClassID(VbsRegExpProgId));
    if SameText(s,'{3F4DACA4-160D-11D2-A8E9-00104B365C9F}') then s:='5.5' else begin
     s:=Format('SOFTWARE\Classes\CLSID\%s\Version',[s]);
     s:=ReadRegistryString(HKEY_LOCAL_MACHINE,s,'');
    end;
    if (s='') then s:=' ?.?' else s:=' '+Trim(s);
    Result:=VbsRegExpProgId+s+' Copyright (c) 1996-2006 Microsoft';
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=Format('%s %s Copyright (c) Jan Goyvaerts 2008 www.regular-expressions.info/delphi.html',
            [TPerlRegEx.ClassName,pcre_version])
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetVersion');
 end;
end;

function TRegExpMaster.GetExecMax:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myExecMax;
end;

procedure TRegExpMaster.SetExecMax(v:Integer);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myExecMax:=Max(0,v);
end;

function TRegExpMaster.GetUseSubst:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myUseSubst;
end;

procedure TRegExpMaster.SetUseSubst(v:Boolean);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myUseSubst:=v;
end;

function TRegExpMaster.GetUseSlash:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myUseSlash;
end;

procedure TRegExpMaster.SetUseSlash(v:Boolean);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myUseSlash:=v;
end;

function TRegExpMaster.GetSavePar:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=mySavePar;
end;

procedure TRegExpMaster.SetSavePar(v:Boolean);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 mySavePar:=v;
end;

function TRegExpMaster.GetPattern:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.Expression;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=myVbsRex.Pattern;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=myPcreRex.RegEx;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetPattern');
 end;
end;

 // Extract Pattern (patt) and Modifiers (mods) form Expression = /Pattern/Modifiers like /Sample/igm
function ExtractPattern(const expr:String; var patt,mods:String):Boolean;
var i,p:Integer;
begin
 Result:=false;
 patt:=expr; mods:='';
 if (expr='') then Exit;
 if (expr[1]<>'/') then Exit;
 p:=0;
 for i:=Length(expr) downto 1 do begin
  if (expr[i]='/') then begin p:=i; break; end else
  if (Pos(expr[i],regexp_valid_modifiers)=0) then Exit;
 end;
 if (p<3) then Exit;
 mods:=Copy(expr,p+1,Length(expr)-p);
 patt:=Copy(expr,2,p-2);
 Result:=true;
end;

procedure TRegExpMaster.SetPattern(const aPattern:String);
var patt,mods:String;
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  myStorage.Clear;
  patt:=aPattern; mods:='';
  if myUseSlash and ExtractPattern(aPattern,patt,mods)
  then Modifiers:=regexp_reset_modifiers; // Start modifiers from scratch
  if (mods<>'') then Modifiers:=mods;     // Set only specified modifiers
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    myRegExpr.Expression:=patt;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    myVbsRex.Pattern:=patt;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    myPcreRex.RegEx:=patt;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'SetPattern');
 end;
end;

function TRegExpMaster.GetWordChars:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.WordChars;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=RegExprWordChars;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=RegExprWordChars;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetWordChars');
 end;
end;

function TRegExpMaster.GetSpaceChars:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.SpaceChars;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=RegExprSpaceChars;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=RegExprSpaceChars;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSpaceChars');
 end;
end;

function TRegExpMaster.GetLineSeparators:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.LineSeparators;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=RegExprLineSeparators;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=RegExprLineSeparators;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetLineSeparators');
 end;
end;

function TRegExpMaster.GetLinePairedSeparator:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.LinePairedSeparator;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=RegExprLinePairedSeparator;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:=RegExprLinePairedSeparator;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetLinePairedSeparator');
 end;
end;

function TRegExpMaster.AllModifiers:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:='igmrsx';
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:='igm';
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    Result:='igmsx';
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'AllModifiers');
 end;
end;

function TRegExpMaster.GetModifier(n:Char):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    case LoCase(n) of
     'i' : Result:=myRegExpr.ModifierI;
     'g' : Result:=myGlobal; // Result:=myRegExpr.ModifierG; // ModifierG is Greedy but need Global!
     'm' : Result:=myRegExpr.ModifierM;
     'r' : Result:=myRegExpr.ModifierR;
     's' : Result:=myRegExpr.ModifierS;
     'x' : Result:=myRegExpr.ModifierX;
    end;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    case LoCase(n) of
     'i' : Result:=myVbsRex.IgnoreCase;
     'g' : Result:=myVbsRex.Global;
     'm' : Result:=myVbsRex.Multiline;
    end;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    case LoCase(n) of
     'i' : Result:=(preCaseLess   in myPcreRex.Options);
     'g' : Result:=myGlobal;
     'm' : Result:=(preMultiLine  in myPcreRex.Options);
     's' : Result:=(preSingleLine in myPcreRex.Options);
     'x' : Result:=(preExtended   in myPcreRex.Options);
    end;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetModifier');
 end;
end;

procedure TRegExpMaster.SetModifier(n:Char; v:Boolean);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  myStorage.Clear;
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    case LoCase(n) of
     'i' : myRegExpr.ModifierI:=v;
     'g' : myGlobal:=v; // myRegExpr.ModifierG:=v; // ModifierG is Greedy but need Global!
     'm' : myRegExpr.ModifierM:=v;
     'r' : myRegExpr.ModifierR:=v;
     's' : myRegExpr.ModifierS:=v;
     'x' : myRegExpr.ModifierX:=v;
    end;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    case LoCase(n) of
     'i' : myVbsRex.IgnoreCase:=v;
     'g' : myVbsRex.Global:=v;
     'm' : myVbsRex.Multiline:=v;
    end;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    case LoCase(n) of
     'i' : if v then myPcreRex.Options:=myPcreRex.Options+[preCaseLess]   else myPcreRex.Options:=myPcreRex.Options-[preCaseLess];
     'g' : myGlobal:=v;
     'm' : if v then myPcreRex.Options:=myPcreRex.Options+[preMultiLine]  else myPcreRex.Options:=myPcreRex.Options-[preMultiLine];
     's' : if v then myPcreRex.Options:=myPcreRex.Options+[preSingleLine] else myPcreRex.Options:=myPcreRex.Options-[preSingleLine];
     'x' : if v then myPcreRex.Options:=myPcreRex.Options+[preExtended]   else myPcreRex.Options:=myPcreRex.Options-[preExtended];
    end;
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'SetModifier');
 end;
end;

function TRegExpMaster.GetIgnoreCase:Boolean;
begin
 Result:=Modifier['i'];
end;

procedure TRegExpMaster.SetIgnoreCase(v:Boolean);
begin
 Modifier['i']:=v;
end;

function TRegExpMaster.GetGlobal:Boolean;
begin
 Result:=Modifier['g'];
end;

procedure TRegExpMaster.SetGlobal(v:Boolean);
begin
 Modifier['g']:=v;
end;

function TRegExpMaster.GetGreedy:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myGreedy;
end;

procedure TRegExpMaster.SetGreedy(v:Boolean);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    myRegExpr.ModifierG:=v;
    myGreedy:=v;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    myGreedy:=true; // Always uses greedy mode
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    if v then myPcreRex.Options:=myPcreRex.Options-[preUnGreedy] else myPcreRex.Options:=myPcreRex.Options+[preUnGreedy];
    myGreedy:=not (preUnGreedy in myPcreRex.Options);
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'SetGreedy');
 end;
end;

function TRegExpMaster.GetMultiline:Boolean;
begin
 Result:=Modifier['m'];
end;

procedure TRegExpMaster.SetMultiline(v:Boolean);
begin
 Modifier['m']:=v;
end;

function TRegExpMaster.GetSingleline:Boolean;
begin
 Result:=Modifier['s'];
end;

procedure TRegExpMaster.SetSingleline(v:Boolean);
begin
 Modifier['s']:=v;
end;

function TRegExpMaster.GetRussian:Boolean;
begin
 Result:=Modifier['r'];
end;

procedure TRegExpMaster.SetRussian(v:Boolean);
begin
 Modifier['r']:=v;
end;

function TRegExpMaster.GetExtended:Boolean;
begin
 Result:=Modifier['x'];
end;

procedure TRegExpMaster.SetExtended(v:Boolean);
begin
 Modifier['x']:=v;
end;

function TRegExpMaster.GetStorage:TRegExpStorage;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 Result:=myStorage;
end;

function TRegExpMaster.GetMatchNum(i:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (i=0)
 then Result:=myStorage.Count
 else Result:=myStorage[i].Count;
end;

procedure TRegExpMaster.SetMatchNum(i:Integer; c:Integer);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (i=0)
 then myStorage.Count:=c
 else myStorage[i].Count:=c;
end;

function TRegExpMaster.GetMatchPos(i,j:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myStorage[i].Pos[j];
end;

procedure TRegExpMaster.SetMatchPos(i,j:Integer; p:Integer);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myStorage[i].Pos[j]:=p;
end;

function TRegExpMaster.GetMatchLen(i,j:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myStorage[i].Len[j];
end;

procedure TRegExpMaster.SetMatchLen(i,j:Integer; l:Integer);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myStorage[i].Len[j]:=l;
end;

function TRegExpMaster.GetMatchStr(i,j:Integer):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 Result:=myStorage[i].Str[j];
end;

procedure TRegExpMaster.SetMatchStr(i,j:Integer; s:String);
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 myStorage[i].Str[j]:=s;
end;

function TRegExpMaster.Test(const aInput:String):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (Pattern='') then Exit;
 try
  myStorage.Clear;
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.Exec(aInput);
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=myVbsRex.Test(aInput);
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    if not myPcreRex.Studied then myPcreRex.Study;
    myPcreRex.Subject:=aInput;
    Result:=myPcreRex.Match;
   end;
   else BadEngine(myEngine);
  end;
  if mySavePar then begin
   myStorage.Input:=aInput;
   myStorage.Pattern:=Pattern;
   myStorage.Modifiers:=Modifiers;
  end;
 except
  on E:Exception do BugReport(E,Self,'Test');
 end;
end;

function TRegExpMaster.Exec(const aInput:String):Integer;
var mac,mat,sub:Variant; i,j:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (Pattern='') then Exit;
 try
  myStorage.Clear;
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    i:=0;
    if myRegExpr.Exec(aInput) then
    repeat
     inc(i);
     MatchNum[0]:=i;
     MatchNum[i]:=myRegExpr.SubExprMatchCount;
     for j:=0 to myRegExpr.SubExprMatchCount do begin
      MatchPos[i,j]:=myRegExpr.MatchPos[j];
      MatchLen[i,j]:=myRegExpr.MatchLen[j];
      MatchStr[i,j]:=myRegExpr.Match[j];
     end;
     Result:=i;
     if not myGlobal then Break;
     if (Result=myExecMax) then Break;
    until not myRegExpr.ExecNext;
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    mac:=myVbsRex.Execute(aInput);
    for i:=1 to mac.Count do begin
     MatchNum[0]:=i;
     mat:=mac.Item[i-1];
     sub:=mat.SubMatches;
     MatchNum[i]:=sub.Count;
     MatchPos[i,0]:=mat.FirstIndex+1;
     MatchLen[i,0]:=mat.Length;
     MatchStr[i,0]:=mat.Value;
     for j:=1 to sub.Count do begin
      MatchPos[i,j]:=0;
      MatchLen[i,j]:=Length(sub.Item[j-1]);
      MatchStr[i,j]:=sub.Item[j-1];
     end;
     Result:=i;
     if (Result=myExecMax) then Break;
    end;
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    if not myPcreRex.Studied then myPcreRex.Study;
    myPcreRex.Subject:=aInput;
    i:=0;
    if myPcreRex.Match then
    repeat
     inc(i);
     MatchNum[0]:=i;
     MatchNum[i]:=myPcreRex.SubExpressionCount;
     MatchPos[i,0]:=myPcreRex.MatchedExpressionOffset;
     MatchLen[i,0]:=myPcreRex.MatchedExpressionLength;
     MatchStr[i,0]:=myPcreRex.MatchedExpression;
     for j:=1 to myPcreRex.SubExpressionCount do begin
      MatchPos[i,j]:=myPcreRex.SubExpressionOffsets[j];
      MatchLen[i,j]:=myPcreRex.SubExpressionLengths[j];
      MatchStr[i,j]:=myPcreRex.SubExpressions[j];
     end;
     Result:=i;
     if not myGlobal then Break;
     if (Result=myExecMax) then Break;
    until not myPcreRex.MatchAgain;
   end;
   else BadEngine(myEngine);
  end;
  if mySavePar then begin
   myStorage.Input:=aInput;
   myStorage.Pattern:=Pattern;
   myStorage.Modifiers:=Modifiers;
  end;
 except
  on E:Exception do BugReport(E,Self,'Exec');
 end;
end;

function TRegExpMaster.Replace(const aInput,aReplacer:String):String;
var i,n:Integer; ForceGlobal:Boolean;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (Pattern='') then Exit;
 try
  myStorage.Clear;
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    if myGlobal then n:=myExecMax else n:=1;
    Result:=myRegExpr.Replace(aInput,aReplacer,myUseSubst,n);
   end;
   regexp_vbs: begin
    if (VarType(myVbsRex)<>varDispatch) then Exit;
    Result:=myVbsRex.Replace(aInput,aReplacer);
   end;
   regexp_pcrelib: begin
    if (myPcreRex=nil) then Exit;
    if not myPcreRex.Studied then myPcreRex.Study;
    myPcreRex.Subject:=aInput;
    myPcreRex.Replacement:=aReplacer;
    ForceGlobal:=false;
    if ForceGlobal then begin
     if myPcreRex.ReplaceAll
     then Result:=myPcreRex.Subject
     else Result:=aInput;
    end else begin
     i:=0;
     if myPcreRex.Match then begin
      repeat
       inc(i);
       myPcreRex.Replace;
       if not myGlobal then Break;
       if (i=myExecMax) then Break;
      until not myPcreRex.MatchAgain;
      Result:=myPcreRex.Subject;
     end else Result:=aInput;
    end;
   end;
   else BadEngine(myEngine);
  end;
  if mySavePar then begin
   myStorage.Input:=aInput;
   myStorage.Pattern:=Pattern;
   myStorage.Replacer:=aReplacer;
   myStorage.Modifiers:=Modifiers;
  end;
 except
  on E:Exception do BugReport(E,Self,'Replace');
 end;
end;

function TRegExpMaster.GetModifiers:String;
var i:Integer; all,p,m:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  p:=''; m:='';
  all:=AllModifiers;
  for i:=1 to Length(all) do
  if Modifier[all[i]] then p:=p+all[i] else m:=m+all[i];
  if (m='') then Result:=p else Result:=p+'-'+m;
 except
  on E:Exception do BugReport(E,Self,'GetModifiers');
 end;
end;

procedure TRegExpMaster.SetModifiers(const arg:String);
var i:Integer; c,sign:Char; all:String;
begin
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  sign:='+'; all:=AllModifiers;
  for i:=1 to Length(arg) do begin
   c:=arg[i];
   if (c='-') then sign:=c else
   if (Pos(c,all)=0) then continue;
   Modifier[c]:=(sign<>'-');
  end;
 except
  on E:Exception do BugReport(E,Self,'SetModifiers');
 end;
end;

function TRegExpMaster.DumpCode:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (Pattern='') then Exit;
 try
  case myEngine of
   regexp_pas : begin
    if (myRegExpr=nil) then Exit;
    Result:=myRegExpr.Dump;
   end;
   regexp_vbs: begin
    Result:='<UNSUPPORTED>';
   end;
   regexp_pcrelib: begin
    Result:='<UNSUPPORTED>';
   end;
   else BadEngine(myEngine);
  end;
 except
  on E:Exception do BugReport(E,Self,'DumpCode');
 end;
end;

function TRegExpMaster.DumpData:String;
var i,j:Integer; List:TStringList;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 if (Pattern='') then Exit;
 try
  List:=TStringList.Create;
  try
   List.Add('Version='+Version);
   List.Add('Options='+Options);
   List.Add('Pattern='+Pattern);
   if (mySavePar) then begin
    if (myStorage.Input<>'') then List.Add('Input='+myStorage.Input);
    if (myStorage.Pattern<>'') then List.Add('Pattern='+myStorage.Pattern);
    if (myStorage.Replacer<>'') then List.Add('Replacer='+myStorage.Replacer);
    if (myStorage.Modifiers<>'') then List.Add('Modifiers='+myStorage.Modifiers);
   end;
   List.Add(Format('MatchNum[0]=%d',[MatchNum[0]]));
   for i:=1 to MatchNum[0] do begin
    List.Add(Format('MatchNum[%d]=%d',[i,MatchNum[i]]));
    for j:=0 to MatchNum[i] do begin
     List.Add(Format('MatchPos[%d,%d]=%d',[i,j,MatchPos[i,j]]));
     List.Add(Format('MatchLen[%d,%d]=%d',[i,j,MatchLen[i,j]]));
     List.Add(Format('MatchStr[%d,%d]=%s',[i,j,MatchStr[i,j]]));
    end;
   end;
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,Self,'DumpData');
 end;
end;

function TRegExpMaster.Control(arg:String):String;
var i,p:Integer; sn,sv:String; iv:Integer;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  p:=Pos('=',arg);
  if (p>0) then begin
   sn:=Copy(arg,1,p-1);
   sv:=Copy(arg,p+1,Length(arg)-p);
  end else begin
   sn:=arg;
   sv:='';
  end;
  case Identify(sn) of
   sid_Errors: begin
    Result:=Format('%u',[Errors]);
   end;
   sid_Engine: begin
    Result:=IntToStr(Engine);
   end;
   sid_Engines: begin
    Result:=Engines;
   end;
   sid_Version: begin
    Result:=Version;
   end;
   sid_Pattern: begin
    if (p>0) then Pattern:=sv;
    Result:=Pattern;
   end;
   sid_Input: begin
    Result:=myStorage.Input;
   end;
   sid_Replacer: begin
    Result:=myStorage.Replacer;
   end;
   sid_IgnoreCase: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then IgnoreCase:=(iv<>0);
    Result:=IntToStr(Ord(IgnoreCase));
   end;
   sid_Global: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Global:=(iv<>0);
    Result:=IntToStr(Ord(Global));
   end;
   sid_Greedy: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Greedy:=(iv<>0);
    Result:=IntToStr(Ord(Greedy));
   end;
   sid_Multiline: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Multiline:=(iv<>0);
    Result:=IntToStr(Ord(Multiline));
   end;
   sid_Singleline: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Singleline:=(iv<>0);
    Result:=IntToStr(Ord(Singleline));
   end;
   sid_Russian: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Russian:=(iv<>0);
    Result:=IntToStr(Ord(Russian));
   end;
   sid_Extended: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then Extended:=(iv<>0);
    Result:=IntToStr(Ord(Extended));
   end;
   sid_DumpCode: begin
    Result:=DumpCode;
   end;
   sid_DumpData: begin
    Result:=DumpData;
   end;
   sid_AllModifiers: begin
    Result:=AllModifiers;
   end;
   sid_Modifiers: begin
    if (p>0) then Modifiers:=sv;
    Result:=Modifiers;
   end;
   sid_UseSubst: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then UseSubst:=(iv<>0);
    Result:=IntToStr(Ord(UseSubst));
   end;
   sid_UseSlash: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then UseSlash:=(iv<>0);
    Result:=IntToStr(Ord(UseSlash));
   end;
   sid_ExecMax: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then ExecMax:=Max(0,iv);
    Result:=IntToStr(ExecMax);
   end;
   sid_SavePar: begin
    if (p>0) and (sv<>'') and atoi(PChar(sv),iv) then SavePar:=(iv<>0);
    Result:=IntToStr(Ord(SavePar));
   end;
   sid_WordChars: begin
    Result:=WordChars;
   end;
   sid_SpaceChars: begin
    Result:=SpaceChars;
   end;
   sid_LineSeparators: begin
    Result:=LineSeparators;
   end;
   sid_LinePairedSeparator: begin
    Result:=LinePairedSeparator;
   end;
   sid_Options : begin
    if (p>0) then Options:=Trim(sv);
    Result:=Options;
   end;
   sid_Asterisk: begin
    if (Dictionary<>nil) then
    for i:=0 to Dictionary.Count-1 do begin
     p:=Dictionary.Links[i];
     if (p<=Ord(sid_Unknown)) then continue;
     if (p>=Ord(sid_Asterisk)) then continue;
     Result:=Result+Dictionary.Keys[i]+LineEnding;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Control');
 end;
end;

function  TRegExpMaster.GetOptions:String;
const Delim:Char=',';
begin
 Result:='';
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  Result:=Result+'Engine='+ExtractFirstParam(Control('Version'))+Delim;
  Result:=Result+'Modifiers='+Control('Modifiers')+Delim;
  Result:=Result+'UseSubst='+Control('UseSubst')+Delim;
  Result:=Result+'UseSlash='+Control('UseSlash')+Delim;
  Result:=Result+'ExecMax='+Control('ExecMax')+Delim;
  Result:=Result+'Greedy='+Control('Greedy')+Delim;
  Result:=Result+'SavePar='+Control('SavePar');
 except
  on E:Exception do BugReport(E,Self,'GetOptions');
 end;
end;

procedure TRegExpMaster.SetOptions(Opt:String);
var List:TStringList; i,p:Integer; line:String;
begin
 if (Opt='') then Exit;
 if (Self=nil) then Exit;
 if not (myEngine in regexp_valid_engines) then Exit;
 try
  List:=TStringList.Create;
  try
   Opt:=StringReplace(Opt,',',LineEnding,[rfReplaceAll]);
   Opt:=StringReplace(Opt,';',LineEnding,[rfReplaceAll]);
   List.Text:=Opt;
   for i:=0 to List.Count-1 do begin
    line:=List[i];
    p:=Pos('=',line);
    if (p=0) then continue;
    Control(line);
   end;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetOptions');
 end;
end;

////////////////////////////////
// TRegExpMaster helper routines
////////////////////////////////

function NewRegExpMaster(Engine:Integer=0; Pattern:String=''; Options:String=''):TRegExpMaster;
begin
 Result:=nil;
 try
   Result:=TRegExpMaster.Create(Engine,Pattern,Options);
   if (Result.Engine<=0) then Kill(Result);
 except
  on E:Exception do BugReport(E,nil,'NewRegExpMaster');
 end;
end;

procedure Kill(var TheObject:TRegExpMaster); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

//////////////////////////////////
// Rex API - easy RegEx interface.
//////////////////////////////////

function regexp_init(engine:Integer; pattern:String; options:String=''):Integer;
begin
 Result:=0;
 try
  Result:=NewRegExpMaster(engine,pattern,options).Ref;
 except
  on E:Exception do BugReport(E,nil,'regexp_init');
 end;
end;

function regexp_free(rex:Integer):Boolean;
var obj:TObject;
begin
 Result:=false;
 if (rex<>0) then
 try
  obj:=regexp_ref(rex);
  if (obj is TRegExpMaster) then begin
   FreeAndNil(obj);
   Result:=true;
  end;
 except
  on E:Exception do BugReport(E,nil,'regexp_free');
 end;
end;

function regexp_ref(rex:Integer):TRegExpMaster;
var obj:TObject;
begin
 Result:=nil;
 if (rex=0) then Exit;
 obj:=ObjectRegistry[rex];
 if (obj is TRegExpMaster) then Result:=TRegExpMaster(obj);
end;

function regexp_ctrl(rex:Integer; arg:String):String;
begin
 Result:=regexp_ref(rex).Control(arg);
end;

function regexp_test(rex:Integer; arg:String):Boolean;
begin
 Result:=regexp_ref(rex).Test(arg);
end;

function regexp_exec(rex:Integer; arg:String):Integer;
begin
 Result:=regexp_ref(rex).Exec(arg);
end;

function regexp_replace(rex:Integer; arg,rep:String):String;
begin
 Result:=regexp_ref(rex).Replace(arg,rep);
end;

function regexp_matchnum(rex:Integer; i:Integer):Integer;
begin
 Result:=regexp_ref(rex).MatchNum[i];
end;

function regexp_matchpos(rex:Integer; i,j:Integer):Integer;
begin
 Result:=regexp_ref(rex).MatchPos[i,j];
end;

function regexp_matchlen(rex:Integer; i,j:Integer):Integer;
begin
 Result:=regexp_ref(rex).MatchLen[i,j];
end;

function regexp_matchstr(rex:Integer; i,j:Integer):String;
begin
 Result:=regexp_ref(rex).MatchStr[i,j];
end;

function regexp_escape(arg:String):String;
begin
 Result:=TRegExpMaster.EscapeRegExpChars(arg);
end;

initialization

 InitDictionary;
 
 lex_regexp_test:=regexp_test;

finalization

 FreeDictionary;
 pcre_finalize;

end.
