pcregexp.pas - This Pascal code defines a set of functions …

/vendor/pcre/pcregexp.pas

http://github.com/feyeleanor/RubyGoLightly · Pascal · 820 lines · 592 code · 71 blank · 157 comment · 24 complexity · 4043d7ec2eb2151cda15d815a1123cd6 MD5 · raw file

{

  pcRegExp - Perl compatible regular expressions for Virtual Pascal

  (c) 2001 Peter S. Voronov aka Chem O'Dun <petervrn@yahoo.com>



  Based on PCRE library interface unit for Virtual Pascal.

  (c) 2001 Alexander Tokarev <dwalin@dwalin.ru>



  The current PCRE version is: 3.7



  This software must be distributed as Freeware.



  The PCRE library is written by: Philip Hazel <ph10@cam.ac.uk>

  Copyright (c) 1997-2004 University of Cambridge



  AngelsHolocaust 4-11-04 updated to use version v5.0

  (INFO: this is regex-directed, NFA)

  AH:  9-11-04 - pcre_free: removed var, pcre already gives the ptr, now

			    everything works as it should (no more crashes)

		 -> removed CheckRegExp because pcre handles errors perfectly

      10-11-04 - added pcError (errorhandling), pcInit

      13-11-04 - removed the ErrorPos = 0 check -> always print erroroffset

      17-10-05 - support for \1-\9 backreferences in TpcRegExp.GetReplStr

      17-02-06 - added RunTimeOptions: caller can set options while searching

      19-02-06 - added SearchOfs(): let PCRE use the complete string and offset

		 into the string itself

      20-12-06 - support for version 7.0

      27.08.08 - support for v7.7

}



{$H+} {$DEFINE PCRE_3_7} {$DEFINE PCRE_5_0} {$DEFINE PCRE_7_0} {$DEFINE PCRE_7_7}



Unit pcregexp;



Interface



uses objects;



Type

 PpcRegExp = ^TpcRegExp;

// TpcRegExp = object

 TpcRegExp = object(TObject)

  MatchesCount: integer;

  RegExpC, RegExpExt : Pointer;

  Matches:Pointer;

  RegExp: shortstring;

  SourceLen: integer;

  PartialMatch : boolean;

  Error : boolean;

  ErrorMsg : Pchar;

  ErrorPos : integer;

  RunTimeOptions: Integer; // options which can be set by the caller

  constructor Init(const ARegExp : shortstring; AOptions : integer; ALocale : Pointer);

  function Search(AStr: Pchar; ALen : longint) : boolean; virtual;

  function SearchNext( AStr: Pchar; ALen : longint) : boolean; virtual;

  function SearchOfs ( AStr: Pchar; ALen, AOfs : longint) : boolean; virtual;

  function MatchSub(ANom: integer; var Pos, Len : longint) : boolean; virtual;

  function MatchFull(var Pos, Len : longint) : boolean; virtual;

  function GetSubStr(ANom: integer; AStr: Pchar) : string; virtual;

  function GetFullStr(AStr: Pchar) : string; virtual;

  function GetReplStr(AStr: Pchar; const ARepl: string) : string; virtual;

  function GetPreSubStr(AStr: Pchar) : string; virtual;

  function GetPostSubStr(AStr: Pchar) : string; virtual;

  function ErrorStr : string; virtual;

  destructor Done; virtual;

 end;



 function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean;

 function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string;



 function pcFastGrepMatch(WildCard, aStr: string): Boolean;

 function pcFastGrepSub(WildCard, aStr, aRepl: string): string;



{$IFDEF PCRE_5_0}

 function pcGetVersion : pchar;

{$ENDIF}



 function pcError (var pRegExp : Pointer) : Boolean;

 function pcInit  (const Pattern: Shortstring; CaseSens: Boolean) : Pointer;



Const { Options }

 PCRE_CASELESS         = $0001;

 PCRE_MULTILINE        = $0002;

 PCRE_DOTALL           = $0004;

 PCRE_EXTENDED         = $0008;

 PCRE_ANCHORED         = $0010;

 PCRE_DOLLAR_ENDONLY   = $0020;

 PCRE_EXTRA            = $0040;

 PCRE_NOTBOL           = $0080;

 PCRE_NOTEOL           = $0100;

 PCRE_UNGREEDY         = $0200;

 PCRE_NOTEMPTY         = $0400;

{$IFDEF PCRE_5_0}

 PCRE_UTF8             = $0800;

 PCRE_NO_AUTO_CAPTURE  = $1000;

 PCRE_NO_UTF8_CHECK    = $2000;

 PCRE_AUTO_CALLOUT     = $4000;

 PCRE_PARTIAL          = $8000;

{$ENDIF}

{$IFDEF PCRE_7_0}

 PCRE_DFA_SHORTEST     = $00010000;

 PCRE_DFA_RESTART      = $00020000;

 PCRE_FIRSTLINE        = $00040000;

 PCRE_DUPNAMES         = $00080000;

 PCRE_NEWLINE_CR       = $00100000;

 PCRE_NEWLINE_LF       = $00200000;

 PCRE_NEWLINE_CRLF     = $00300000;

 PCRE_NEWLINE_ANY      = $00400000;

 PCRE_NEWLINE_ANYCRLF  = $00500000;



 PCRE_NEWLINE_BITS     = PCRE_NEWLINE_CR or PCRE_NEWLINE_LF or PCRE_NEWLINE_ANY;



{$ENDIF}

{$IFDEF PCRE_7_7}

 PCRE_BSR_ANYCRLF      = $00800000;

 PCRE_BSR_UNICODE      = $01000000;

 PCRE_JAVASCRIPT_COMPAT= $02000000;

{$ENDIF}



 PCRE_COMPILE_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_AUTO_CALLOUT + PCRE_CASELESS  +

				PCRE_DOLLAR_ENDONLY + PCRE_DOTALL + PCRE_EXTENDED  +

				PCRE_EXTRA + PCRE_MULTILINE + PCRE_NO_AUTO_CAPTURE +

				PCRE_UNGREEDY + PCRE_UTF8 + PCRE_NO_UTF8_CHECK

				{$IFDEF PCRE_7_0}

				+ PCRE_DUPNAMES + PCRE_FIRSTLINE + PCRE_NEWLINE_BITS

				{$ENDIF}

				{$IFDEF PCRE_7_7}

				+ PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE + PCRE_JAVASCRIPT_COMPAT

				{$ENDIF}

				;



 PCRE_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +

			     PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL

			     {$IFDEF PCRE_7_0}

			     + PCRE_NEWLINE_BITS

			     {$ENDIF}

			     {$IFDEF PCRE_7_7}

			     + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE

			     {$ENDIF}

			     ;



{$IFDEF PCRE_7_0}

 PCRE_DFA_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +

				 PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL +

				 PCRE_DFA_SHORTEST + PCRE_DFA_RESTART +

				 PCRE_NEWLINE_BITS

				 {$IFDEF PCRE_7_7}

				 + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE

				 {$ENDIF}

				 ;

{$ENDIF}



{ Exec-time and get/set-time error codes }

 PCRE_ERROR_NOMATCH        =  -1;

 PCRE_ERROR_NULL	   =  -2;

 PCRE_ERROR_BADOPTION      =  -3;

 PCRE_ERROR_BADMAGIC       =  -4;

 PCRE_ERROR_UNKNOWN_MODE   =  -5;

 PCRE_ERROR_NOMEMORY       =  -6;

 PCRE_ERROR_NOSUBSTRING    =  -7;

{$IFDEF PCRE_5_0}

 PCRE_ERROR_MATCHLIMIT     =  -8;

 PCRE_ERROR_CALLOUT        =  -9;  { Never used by PCRE itself }

 PCRE_ERROR_BADUTF8        = -10;

 PCRE_ERROR_BADUTF8_OFFSET = -11;

 PCRE_ERROR_PARTIAL        = -12;

 PCRE_ERROR_BADPARTIAL     = -13;

 PCRE_ERROR_INTERNAL       = -14;

 PCRE_ERROR_BADCOUNT       = -15;

{$ENDIF}

{$IFDEF PCRE_7_0}

 PCRE_ERROR_DFA_UITEM      = -16;

 PCRE_ERROR_DFA_UCOND      = -17;

 PCRE_ERROR_DFA_UMLIMIT    = -18;

 PCRE_ERROR_DFA_WSSIZE     = -19;

 PCRE_ERROR_DFA_RECURSE    = -20;

 PCRE_ERROR_RECURSIONLIMIT = -21;

 PCRE_ERROR_NULLWSLIMIT    = -22;

 PCRE_ERROR_BADNEWLINE     = -23;

{$ENDIF}



{ Request types for pcre_fullinfo() }



 PCRE_INFO_OPTIONS         =  0;

 PCRE_INFO_SIZE 	   =  1;

 PCRE_INFO_CAPTURECOUNT    =  2;

 PCRE_INFO_BACKREFMAX      =  3;

 PCRE_INFO_FIRSTBYTE       =  4;

 PCRE_INFO_FIRSTCHAR       =  4; { For backwards compatibility }

 PCRE_INFO_FIRSTTABLE      =  5;

{$IFDEF PCRE_5_0}

 PCRE_INFO_LASTLITERAL     =  6;

 PCRE_INFO_NAMEENTRYSIZE   =  7;

 PCRE_INFO_NAMECOUNT       =  8;

 PCRE_INFO_NAMETABLE       =  9;

 PCRE_INFO_STUDYSIZE       = 10;

 PCRE_INFO_DEFAULT_TABLES  = 11;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_7}

 PCRE_INFO_OKPARTIAL       = 12;

 PCRE_INFO_JCHANGED        = 13;

 PCRE_INFO_HASCRORLF       = 14;

{$ENDIF}



{ Request types for pcre_config() }

{$IFDEF PCRE_5_0}

 PCRE_CONFIG_UTF8       	    = 0;

 PCRE_CONFIG_NEWLINE    	    = 1;

 PCRE_CONFIG_LINK_SIZE  	    = 2;

 PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3;

 PCRE_CONFIG_MATCH_LIMIT	    = 4;

 PCRE_CONFIG_STACKRECURSE           = 5;

 PCRE_CONFIG_UNICODE_PROPERTIES     = 6;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_0}

 PCRE_CONFIG_MATCH_LIMIT_RECURSION  = 7;

{$ENDIF}

{$IFDEF PCRE_7_7}

 PCRE_CONFIG_BSR		    = 8;

{$ENDIF}



{ Bit flags for the pcre_extra structure }

{$IFDEF PCRE_5_0}

 PCRE_EXTRA_STUDY_DATA  	  = $0001;

 PCRE_EXTRA_MATCH_LIMIT 	  = $0002;

 PCRE_EXTRA_CALLOUT_DATA	  = $0004;

 PCRE_EXTRA_TABLES      	  = $0008;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_0}

 PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010;

{$ENDIF}



Const

// DefaultOptions : integer = 0;

 DefaultLocaleTable : pointer = nil;



{$IFDEF PCRE_5_0}

{ The structure for passing additional data to pcre_exec(). This is defined in

such as way as to be extensible. Always add new fields at the end, in order to

remain compatible. }



type ppcre_extra = ^tpcre_extra;

     tpcre_extra = record

       flags : longint; 	       { Bits for which fields are set }

       study_data : pointer;           { Opaque data from pcre_study() }

       match_limit : longint;          { Maximum number of calls to match() }

       callout_data : pointer;         { Data passed back in callouts }

       tables : pointer;	       { Pointer to character tables }

       match_limit_recursion: longint; { Max recursive calls to match() }

     end;



type ppcre_callout_block = ^pcre_callout_block;

     pcre_callout_block = record

       version,

  (* ------------------------ Version 0 ------------------------------- *)

       callout_number : integer;

       offset_vector : pointer;

       subject : pchar;

       subject_length, start_match, current_position, capture_top,

       capture_last : integer;

       callout_data : pointer;

  (* ------------------- Added for Version 1 -------------------------- *)

       pattern_position, next_item_length : integer;

     end;

{$ENDIF PCRE_5_0}



{$OrgName+}

{$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}



 { local replacement of external pcre memory management functions }

 function pcre_malloc( size : integer ) : pointer;

 procedure pcre_free( {var} p : pointer );

{$IFDEF PCRE_5_0}

 const pcre_stack_malloc: function ( size : integer ): pointer = pcre_malloc;

       pcre_stack_free: procedure ( {var} p : pointer ) = pcre_free;

 function pcre_callout(var p : ppcre_callout_block) : integer;

{$ENDIF PCRE_5_0}

{$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}



Implementation



Uses strings, collect, messages, dnapp, commands, advance0, stringsx

    {$IFDEF VIRTUALPASCAL} ,vpsyslow {$ENDIF VIRTUALPASCAL};



Const

 MAGIC_NUMBER = $50435245; { 'PCRE' }

 MAX_MATCHES = 90; { changed in 3.5 version; should be divisible by 3, was 64}



Type

 PMatchArray = ^TMatchArray;

 TMatchArray = array[0..( MAX_MATCHES * 3 )] of integer;



 PRegExpCollection = ^TRegExpCollection;

 TRegExpCollection =  object(TSortedCollection)

   MaxRegExp : integer;

   SearchRegExp : shortstring;

   CompareModeInsert : boolean;

   constructor Init(AMaxRegExp:integer);

   procedure FreeItem(P: Pointer); virtual;

   function  Compare(P1, P2: Pointer): Integer; virtual;

   function  Find(ARegExp:shortstring;var P: PpcRegExp):boolean; virtual;

   function CheckNew(ARegExp:shortstring):PpcRegExp;virtual;

 end;



Var

 PRegExpCache : PRegExpCollection;





{$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}



 { imported original pcre functions }



 function pcre_compile( const pattern : PChar; options : integer;

			var errorptr : PChar; var erroroffset : integer;

			const tables : PChar ) : pointer {pcre}; external;

{$IFDEF PCRE_7_0}

 function pcre_compile2( const pattern : PChar; options : integer;

			 var errorcodeptr : Integer;

			 var errorptr : PChar; var erroroffset : integer;

			 const tables : PChar ) : pointer {pcre}; external;

{$ENDIF}

{$IFDEF PCRE_5_0}

 function pcre_config( what : integer; where : pointer) : integer; external;

 function pcre_copy_named_substring( const code : pointer {pcre};

				     const subject : pchar;

				     var ovector : integer;

				     stringcount : integer;

				     const stringname : pchar;

				     var buffer : pchar;

				     size : integer) : integer; external;

 function pcre_copy_substring( const subject : pchar; var ovector : integer;

			       stringcount, stringnumber : integer;

			       var buffer : pchar; size : integer )

			       : integer; external;

 function pcre_exec( const argument_re : pointer {pcre};

		     const extra_data : pointer {pcre_extra};

{$ELSE}

 function pcre_exec( const external_re : pointer;

		     const external_extra : pointer;

{$ENDIF}

		     const subject : PChar;

		     length, start_offset, options : integer;

		     offsets : pointer;

		     offsetcount : integer ) : integer; external;

{$IFDEF PCRE_7_0}

 function pcre_dfa_exec( const argument_re : pointer {pcre};

			 const extra_data : pointer {pcre_extra};

			 const subject : pchar;

			 length, start_offset, options : integer;

			 offsets : pointer;

			 offsetcount : integer;

			 workspace : pointer;

			 wscount : integer ) : integer; external;

{$ENDIF}

{$IFDEF PCRE_5_0}

 procedure pcre_free_substring( const p : pchar ); external;

 procedure pcre_free_substring_list( var p : pchar ); external;

 function pcre_fullinfo( const argument_re : pointer {pcre};

			 const extra_data : pointer {pcre_extra};

			 what : integer;

			 where : pointer ) : integer; external;

 function pcre_get_named_substring( const code : pointer {pcre};

				    const subject : pchar;

				    var ovector : integer;

				    stringcount : integer;

				    const stringname : pchar;

				    var stringptr : pchar ) : integer; external;

 function pcre_get_stringnumber( const code : pointer {pcre};

				 const stringname : pchar ) : integer; external;

 function pcre_get_stringtable_entries( const code : pointer {pcre};

					const stringname : pchar;

					var firstptr,

					    lastptr : pchar ) : integer; external;

 function pcre_get_substring( const subject : pchar; var ovector : integer;

			      stringcount, stringnumber : integer;

			      var stringptr : pchar ) : integer; external;

 function pcre_get_substring_list( const subject : pchar; var ovector : integer;

				   stringcount : integer;

				   listptr : pointer {const char ***listptr}) : integer; external;

 function pcre_info( const argument_re : pointer {pcre};

		     var optptr : integer;

		     var first_byte : integer ) : integer; external;

 function pcre_maketables : pchar; external;

{$ENDIF}

{$IFDEF PCRE_7_0}

 function pcre_refcount( const argument_re : pointer {pcre};

			 adjust : integer ) : pchar; external;

{$ENDIF}

 function pcre_study( const external_re : pointer {pcre};

		      options : integer;

		      var errorptr : PChar ) : pointer {pcre_extra}; external;

{$IFDEF PCRE_5_0}

 function pcre_version : pchar; external;

{$ENDIF}



 function pcre_malloc( size : integer ) : pointer;

 begin

  GetMem( result, size );

 end;



 procedure pcre_free( {var} p : pointer );

 begin

  if (p <> nil) then

    FreeMem( p, 0 );

  {@p := nil;}

 end;



{$IFDEF PCRE_5_0}

(* Called from PCRE as a result of the (?C) item. We print out where we are in

the match. Yield zero unless more callouts than the fail count, or the callout

data is not zero. *)



 function pcre_callout;

 begin

 end;

{$ENDIF}



{$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}



// Always include the newest version of the library

{$IFDEF PCRE_7_7}

  {$L pcre77.lib}

{$ELSE}

  {$IFDEF PCRE_7_0}

    {$L pcre70.lib}

  {$ELSE}

    {$IFDEF PCRE_5_0}

      {$L pcre50.lib}

    {$ELSE}

      {$IFDEF PCRE_3_7}

	{$L pcre37.lib}

      {$ENDIF PCRE_3_7}

    {$ENDIF PCRE_5_0}

  {$ENDIF PCRE_7_0}

{$ENDIF PCRE_7_7}



{TpcRegExp}



 constructor TpcRegExp.Init(const ARegExp:shortstring; AOptions:integer; ALocale : Pointer);

 var

  pRegExp : PChar;

 begin

  RegExp:=ARegExp;

  RegExpC:=nil;

  RegExpExt:=nil;

  Matches:=nil;

  MatchesCount:=0;

  Error:=true;

  ErrorMsg:=nil;

  ErrorPos:=0;

  RunTimeOptions := 0;

  if length(RegExp) < 255 then

   begin

    RegExp[length(RegExp)+1]:=#0;

    pRegExp:=@RegExp[1];

   end

  else

   begin

    GetMem(pRegExp,length(RegExp)+1);

    pRegExp:=strpcopy(pRegExp,RegExp);

   end;

  RegExpC := pcre_compile( pRegExp,

			   AOptions and PCRE_COMPILE_ALLOWED_OPTIONS,

			   ErrorMsg, ErrorPos, ALocale);

  if length(RegExp) = 255 then

   StrDispose(pRegExp);

  if RegExpC = nil then

   exit;

  ErrorMsg:=nil;

  RegExpExt := pcre_study( RegExpC, 0, ErrorMsg );

  if (RegExpExt = nil) and (ErrorMsg <> nil) then

   begin

    pcre_free(RegExpC);

    exit;

   end;

  GetMem(Matches,SizeOf(TMatchArray));

  Error:=false;

 end;



 destructor TpcRegExp.Done;

 begin

  if RegExpC <> nil then

    pcre_free(RegExpC);

  if RegExpExt <> nil then

    pcre_free(RegExpExt);

  if Matches <> nil then

    FreeMem(Matches,SizeOf(TMatchArray));

 end;



 function TpcRegExp.SearchNext( AStr: Pchar; ALen : longint ) : boolean;

 var Options: Integer;

 begin // must handle PCRE_ERROR_PARTIAL here

  Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and

	     PCRE_EXEC_ALLOWED_OPTIONS;

  if MatchesCount > 0 then

    MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, PMatchArray(Matches)^[1],

			     Options, Matches, MAX_MATCHES ) else

    MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, 0,

			     Options, Matches, MAX_MATCHES );

{  if MatchesCount = 0 then

    MatchesCount := MatchesCount div 3;}

  PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;

  SearchNext := MatchesCount > 0;

 end;



 function TpcRegExp.Search( AStr: Pchar; ALen : longint):boolean;

 begin

  MatchesCount:=0;

  Search:=SearchNext(AStr,ALen);

  SourceLen:=ALen;

 end;



 function TpcRegExp.SearchOfs( AStr: Pchar; ALen, AOfs: longint ) : boolean;

 var Options: Integer;

 begin

  MatchesCount:=0;

  Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and

	     PCRE_EXEC_ALLOWED_OPTIONS;

  MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, AOfs,

			   Options, Matches, MAX_MATCHES );

  PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;

  SearchOfs := MatchesCount > 0;

  SourceLen := ALen-AOfs;

 end;



 function TpcRegExp.MatchSub(ANom:integer; var Pos,Len:longint):boolean;

 begin

  if (MatchesCount > 0) and (ANom <= (MatchesCount-1)) then

   begin

    ANom:=ANom*2;

    Pos:=PMatchArray(Matches)^[ANom];

    Len:=PMatchArray(Matches)^[ANom+1]-Pos;

    MatchSub:=true;

   end

  else

   MatchSub:=false;

 end;



 function TpcRegExp.MatchFull(var Pos,Len:longint):boolean;

 begin

  MatchFull:=MatchSub(0,Pos,Len);

 end;



 function TpcRegExp.GetSubStr(ANom: integer; AStr: Pchar):string;

 var

  s: ansistring;

  pos,len: longint;

 begin

  s:='';

  if MatchSub(ANom, pos, len) then

   begin

    setlength(s, len);

    Move(AStr[pos], s[1], len);

   end;

  GetSubStr:=s;

 end;



 function TpcRegExp.GetPreSubStr(AStr: Pchar):string;

 var

  s: ansistring;

  l: longint;

 begin

  s:='';

  if (MatchesCount > 0) then

   begin

    l:=PMatchArray(Matches)^[0]-1;

    if l > 0 then

     begin

      setlength(s,l);

      Move(AStr[1],s[1],l);

     end;

   end;

  GetPreSubStr:=s;

 end;



 function TpcRegExp.GetPostSubStr(AStr: Pchar):string;

 var

  s: ansistring;

  l: longint;

  ANom: integer;

 begin

  s:='';

  if (MatchesCount > 0) then

   begin

    ANom:=(MatchesCount-1){*2} shl 1;

    l:=SourceLen-PMatchArray(Matches)^[ANom+1]+1;

    if l > 0 then

     begin

      setlength(s,l);

      Move(AStr[PMatchArray(Matches)^[ANom+1]],s[1],l);

     end;

   end;

  GetPostSubStr:=s;

 end;





 function TpcRegExp.GetFullStr(AStr: Pchar):string;

 var

  s: ansistring;

  l: longint;

 begin

  GetFullStr:=GetSubStr(0,AStr);

 end;



 function TpcRegExp.GetReplStr(AStr: Pchar; const ARepl: string):string;

 var

  s: ansistring;

  l,i,lasti: longint;

 begin

  l:=length(ARepl);

  i:=1;

  lasti:=1;

  s:='';

  while i <= l do

   begin

    case ARepl[i] of

     '\' :

      begin

       if i < l then

	begin

	 s:=s+copy(ARepl,lasti,i-lasti){+ARepl[i+1]};

	 {AH 17-10-05 support for POSIX \1-\9 backreferences}

	 case ARepl[i+1] of

	  '0' : s:=s+GetFullStr(AStr);

	  '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr);

	  else s:=s+ARepl[i+1]; // copy the escaped character

	 end;

	end;

       inc(i);

       lasti:=i+1;

      end;

     '$' :

      begin

       if i < l then

	begin

	 s:=s+copy(ARepl,lasti,i-lasti);

	 case ARepl[i+1] of

	  '&' : s:=s+GetFullStr(AStr);

	  '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr);

	  '`' : s:=s+GetPreSubStr(AStr);

	  #39 : s:=s+GetPostSubStr(AStr);

	 end;

	end;

       inc(i);

       lasti:=i+1;

      end;

    end;

    inc(i);

   end;

  if lasti <= {AH 25-10-2004 added =, else l==1 won't work} l then

    s:=s+copy(ARepl,lasti,l-lasti+1);

  GetReplStr:=s;

 end;



 function TpcRegExp.ErrorStr:string;

  begin

   ErrorStr:=StrPas(ErrorMsg);

  end;



{TRegExpCollection}



constructor TRegExpCollection.Init(AMaxRegExp: integer);

begin

 Inherited Init(1,1);

 MaxRegExp:=AMaxRegExp;

 CompareModeInsert:=true;

end;



procedure TRegExpCollection.FreeItem(P: Pointer);

begin

 if P <> nil then

  begin

   Dispose(PpcRegExp(P),Done);

  end;

end;



function  TRegExpCollection.Compare(P1, P2: Pointer): Integer;

//var

// l,l1,l2,i : byte;

//// wPos: pchar;

begin

 if CompareModeInsert then

  begin

//   l1:=length(PpcRegExp(P1)^.RegExp);

//   l2:=length(PpcRegExp(P2)^.RegExp);

//   if l1 > l2 then l:=l2 else

//      	     l:=l1;

//   for i:=1 to l do

//     if PpcRegExp(P1).RegExp[i] <> PpcRegExp(P2).RegExp[i] then break;

//   if i <=l then

//     Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(PpcRegExp(P2).RegExp[i]) else

//     Compare:=l1-l2;

    Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, PpcRegExp(P2).RegExp, False);

  end

 else

  begin

//   l1:=length(PpcRegExp(P1)^.RegExp);

//   l2:=length(SearchRegExp);

//   if l1 > l2 then l:=l2 else

//      	     l:=l1;

//   for i:=1 to l do

//     if PpcRegExp(P1).RegExp[i] <> SearchRegExp[i] then

//     begin

//       Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(SearchRegExp[i]);

//       break;

//     end;

//   if i > l then Compare:=l1-l2;

    Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, SearchRegExp, False);

  end;

end;



function  TRegExpCollection.Find(ARegExp:shortstring;var P: PpcRegExp):boolean;

var I : integer;

begin

 CompareModeInsert:=false;

 SearchRegExp:=ARegExp;

 if Search(nil,I) then

  begin

   P:=PpcRegExp(At(I));

   Find:=true;

  end

 else

  begin

   P:=nil;

   Find:=false;

  end;

 CompareModeInsert:=true;

end;



function TRegExpCollection.CheckNew(ARegExp:shortstring):PpcRegExp;

var

 P : PpcRegExp;

begin

 if not Find(ARegExp,P) then

  begin

   if Count = MaxRegExp then

    AtFree(0);

   P:=New(ppcRegExp,Init(ARegExp,PCRE_CASELESS,nil));

   Insert(P);

  end;

 CheckNew:=P;

end;



function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean;

var

 PpcRE:PpcRegExp;

begin

 PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale));

 pcGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr));

 Dispose(PpcRE,Done);

end;



function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string;

var

 PpcRE:PpcRegExp;

begin

 PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale));

 if PpcRE^.Search(pchar(AStr),Length(AStr)) then

  pcGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl)

 else

  pcGrepSub:='';

 Dispose(PpcRE,Done);

end;



function pcFastGrepMatch(WildCard, aStr: string): Boolean;

var

 PpcRE:PpcRegExp;

begin

 PpcRE:=PRegExpCache^.CheckNew(WildCard);

 pcFastGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr));

end;



function pcFastGrepSub(WildCard, aStr, aRepl: string): string;

var

 PpcRE:PpcRegExp;

begin

 PpcRE:=PRegExpCache^.CheckNew(WildCard);

 if PpcRE^.Search(pchar(AStr),Length(AStr)) then

  pcFastGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl)

 else

  pcFastGrepSub:='';

end;



{$IFDEF PCRE_5_0}

function pcGetVersion : pchar; assembler; {$FRAME-}{$USES none}

asm

  call pcre_version

end;

{$ENDIF PCRE_5_0}



function pcError;

var P: ppcRegExp absolute pRegExp;

begin

  Result := (P = nil) or P^.Error;

  If Result and (P <> nil) then

  begin

{     if P^.ErrorPos = 0 then

      MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"', nil,mfConfirmation+mfOkButton)

    else}

      MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"'+GetString(erRegExpCompPos),

		 @P^.ErrorPos,mfConfirmation+mfOkButton);

    Dispose(P, Done);

    P:=nil;

  end;

end;



function pcInit;

var Options : Integer;

begin

  If CaseSens then Options := 0 else Options := PCRE_CASELESS;

  Result := New( PpcRegExp, Init( Pattern,

				  {DefaultOptions}

				  startup.MiscMultiData.cfgRegEx.DefaultOptions or Options,

				  DefaultLocaleTable) );

end;



Initialization

 PRegExpCache:=New(PRegExpCollection,Init(64));

Finalization

 Dispose(PRegExpCache,Done);

End.