pcregexp.pas

   1 {\r
   2   pcRegExp - Perl compatible regular expressions for Virtual Pascal\r
   3   (c) 2001 Peter S. Voronov aka Chem O'Dun <petervrn@yahoo.com>\r
   4 \r
   5   Based on PCRE library interface unit for Virtual Pascal.\r
   6   (c) 2001 Alexander Tokarev <dwalin@dwalin.ru>\r
   7 \r
   8   The current PCRE version is: 3.7\r
   9 \r
  10   This software may be distributed under the terms of the modified BSD license\r
  11   Copyright (c) 2001, Alexander Tokarev\r
  12   All rights reserved.\r
  13 \r
  14   Redistribution and use in source and binary forms, with or without\r
  15   modification, are permitted provided that the following conditions are met:\r
  16 \r
  17     * Redistributions of source code must retain the above copyright notice,\r
  18       this list of conditions and the following disclaimer.\r
  19     * Redistributions in binary form must reproduce the above copyright notice,\r
  20       this list of conditions and the following disclaimer in the documentation\r
  21       and/or other materials provided with the distribution.\r
  22     * Neither the name of the <ORGANIZATION> nor the names of its contributors\r
  23       may be used to endorse or promote products derived from this software without\r
  24       specific prior written permission.\r
  25 \r
  26   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND\r
  27   ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\r
  28   WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\r
  29   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\r
  30   FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\r
  31   DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\r
  32   SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\r
  33   CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\r
  34   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\r
  35   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\r
  36 \r
  37   The PCRE library is written by: Philip Hazel <ph10@cam.ac.uk>\r
  38   Copyright (c) 1997-2004 University of Cambridge\r
  39 \r
  40   AngelsHolocaust 4-11-04 updated to use version v5.0\r
  41   (INFO: this is regex-directed, NFA)\r
  42   AH:  9-11-04 - pcre_free: removed var, pcre already gives the ptr, now\r
  43                             everything works as it should (no more crashes)\r
  44                  -> removed CheckRegExp because pcre handles errors perfectly\r
  45       10-11-04 - added pcError (errorhandling), pcInit\r
  46       13-11-04 - removed the ErrorPos = 0 check -> always print erroroffset\r
  47       17-10-05 - support for \1-\9 backreferences in TpcRegExp.GetReplStr\r
  48       17-02-06 - added RunTimeOptions: caller can set options while searching\r
  49       19-02-06 - added SearchOfs(): let PCRE use the complete string and offset\r
  50                  into the string itself\r
  51       20-12-06 - support for version 7.0\r
  52       27.08.08 - support for v7.7\r
  53 }\r
  54 \r
  55 {$H+} {$DEFINE PCRE_3_7} {$DEFINE PCRE_5_0} {$DEFINE PCRE_7_0} {$DEFINE PCRE_7_7}\r
  56 \r
  57 Unit pcregexp;\r
  58 \r
  59 Interface\r
  60 \r
  61 uses objects;\r
  62 \r
  63 Type\r
  64  PpcRegExp = ^TpcRegExp;\r
  65 // TpcRegExp = object\r
  66  TpcRegExp = object(TObject)\r
  67   MatchesCount: integer;\r
  68   RegExpC, RegExpExt : Pointer;\r
  69   Matches:Pointer;\r
  70   RegExp: shortstring;\r
  71   SourceLen: integer;\r
  72   PartialMatch : boolean;\r
  73   Error : boolean;\r
  74   ErrorMsg : Pchar;\r
  75   ErrorPos : integer;\r
  76   RunTimeOptions: Integer; // options which can be set by the caller\r
  77   constructor Init(const ARegExp : shortstring; AOptions : integer; ALocale : Pointer);\r
  78   function Search(AStr: Pchar; ALen : longint) : boolean; virtual;\r
  79   function SearchNext( AStr: Pchar; ALen : longint) : boolean; virtual;\r
  80   function SearchOfs ( AStr: Pchar; ALen, AOfs : longint) : boolean; virtual;\r
  81   function MatchSub(ANom: integer; var Pos, Len : longint) : boolean; virtual;\r
  82   function MatchFull(var Pos, Len : longint) : boolean; virtual;\r
  83   function GetSubStr(ANom: integer; AStr: Pchar) : string; virtual;\r
  84   function GetFullStr(AStr: Pchar) : string; virtual;\r
  85   function GetReplStr(AStr: Pchar; const ARepl: string) : string; virtual;\r
  86   function GetPreSubStr(AStr: Pchar) : string; virtual;\r
  87   function GetPostSubStr(AStr: Pchar) : string; virtual;\r
  88   function ErrorStr : string; virtual;\r
  89   destructor Done; virtual;\r
  90  end;\r
  91 \r
  92  function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean;\r
  93  function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string;\r
  94 \r
  95  function pcFastGrepMatch(WildCard, aStr: string): Boolean;\r
  96  function pcFastGrepSub(WildCard, aStr, aRepl: string): string;\r
  97 \r
  98 {$IFDEF PCRE_5_0}\r
  99  function pcGetVersion : pchar;\r
 100 {$ENDIF}\r
 101 \r
 102  function pcError (var pRegExp : Pointer) : Boolean;\r
 103  function pcInit  (const Pattern: Shortstring; CaseSens: Boolean) : Pointer;\r
 104 \r
 105 Const { Options }\r
 106  PCRE_CASELESS         = $0001;\r
 107  PCRE_MULTILINE        = $0002;\r
 108  PCRE_DOTALL           = $0004;\r
 109  PCRE_EXTENDED         = $0008;\r
 110  PCRE_ANCHORED         = $0010;\r
 111  PCRE_DOLLAR_ENDONLY   = $0020;\r
 112  PCRE_EXTRA            = $0040;\r
 113  PCRE_NOTBOL           = $0080;\r
 114  PCRE_NOTEOL           = $0100;\r
 115  PCRE_UNGREEDY         = $0200;\r
 116  PCRE_NOTEMPTY         = $0400;\r
 117 {$IFDEF PCRE_5_0}\r
 118  PCRE_UTF8             = $0800;\r
 119  PCRE_NO_AUTO_CAPTURE  = $1000;\r
 120  PCRE_NO_UTF8_CHECK    = $2000;\r
 121  PCRE_AUTO_CALLOUT     = $4000;\r
 122  PCRE_PARTIAL          = $8000;\r
 123 {$ENDIF}\r
 124 {$IFDEF PCRE_7_0}\r
 125  PCRE_DFA_SHORTEST     = $00010000;\r
 126  PCRE_DFA_RESTART      = $00020000;\r
 127  PCRE_FIRSTLINE        = $00040000;\r
 128  PCRE_DUPNAMES         = $00080000;\r
 129  PCRE_NEWLINE_CR       = $00100000;\r
 130  PCRE_NEWLINE_LF       = $00200000;\r
 131  PCRE_NEWLINE_CRLF     = $00300000;\r
 132  PCRE_NEWLINE_ANY      = $00400000;\r
 133  PCRE_NEWLINE_ANYCRLF  = $00500000;\r
 134 \r
 135  PCRE_NEWLINE_BITS     = PCRE_NEWLINE_CR or PCRE_NEWLINE_LF or PCRE_NEWLINE_ANY;\r
 136 \r
 137 {$ENDIF}\r
 138 {$IFDEF PCRE_7_7}\r
 139  PCRE_BSR_ANYCRLF      = $00800000;\r
 140  PCRE_BSR_UNICODE      = $01000000;\r
 141  PCRE_JAVASCRIPT_COMPAT= $02000000;\r
 142 {$ENDIF}\r
 143 \r
 144  PCRE_COMPILE_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_AUTO_CALLOUT + PCRE_CASELESS  +\r
 145                                 PCRE_DOLLAR_ENDONLY + PCRE_DOTALL + PCRE_EXTENDED  +\r
 146                                 PCRE_EXTRA + PCRE_MULTILINE + PCRE_NO_AUTO_CAPTURE +\r
 147                                 PCRE_UNGREEDY + PCRE_UTF8 + PCRE_NO_UTF8_CHECK\r
 148                                 {$IFDEF PCRE_7_0}\r
 149                                 + PCRE_DUPNAMES + PCRE_FIRSTLINE + PCRE_NEWLINE_BITS\r
 150                                 {$ENDIF}\r
 151                                 {$IFDEF PCRE_7_7}\r
 152                                 + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE + PCRE_JAVASCRIPT_COMPAT\r
 153                                 {$ENDIF}\r
 154                                 ;\r
 155 \r
 156  PCRE_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +\r
 157                              PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL\r
 158                              {$IFDEF PCRE_7_0}\r
 159                              + PCRE_NEWLINE_BITS\r
 160                              {$ENDIF}\r
 161                              {$IFDEF PCRE_7_7}\r
 162                              + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE\r
 163                              {$ENDIF}\r
 164                              ;\r
 165 \r
 166 {$IFDEF PCRE_7_0}\r
 167  PCRE_DFA_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +\r
 168                                  PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL +\r
 169                                  PCRE_DFA_SHORTEST + PCRE_DFA_RESTART +\r
 170                                  PCRE_NEWLINE_BITS\r
 171                                  {$IFDEF PCRE_7_7}\r
 172                                  + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE\r
 173                                  {$ENDIF}\r
 174                                  ;\r
 175 {$ENDIF}\r
 176 \r
 177 { Exec-time and get/set-time error codes }\r
 178  PCRE_ERROR_NOMATCH        =  -1;\r
 179  PCRE_ERROR_NULL           =  -2;\r
 180  PCRE_ERROR_BADOPTION      =  -3;\r
 181  PCRE_ERROR_BADMAGIC       =  -4;\r
 182  PCRE_ERROR_UNKNOWN_MODE   =  -5;\r
 183  PCRE_ERROR_NOMEMORY       =  -6;\r
 184  PCRE_ERROR_NOSUBSTRING    =  -7;\r
 185 {$IFDEF PCRE_5_0}\r
 186  PCRE_ERROR_MATCHLIMIT     =  -8;\r
 187  PCRE_ERROR_CALLOUT        =  -9;  { Never used by PCRE itself }\r
 188  PCRE_ERROR_BADUTF8        = -10;\r
 189  PCRE_ERROR_BADUTF8_OFFSET = -11;\r
 190  PCRE_ERROR_PARTIAL        = -12;\r
 191  PCRE_ERROR_BADPARTIAL     = -13;\r
 192  PCRE_ERROR_INTERNAL       = -14;\r
 193  PCRE_ERROR_BADCOUNT       = -15;\r
 194 {$ENDIF}\r
 195 {$IFDEF PCRE_7_0}\r
 196  PCRE_ERROR_DFA_UITEM      = -16;\r
 197  PCRE_ERROR_DFA_UCOND      = -17;\r
 198  PCRE_ERROR_DFA_UMLIMIT    = -18;\r
 199  PCRE_ERROR_DFA_WSSIZE     = -19;\r
 200  PCRE_ERROR_DFA_RECURSE    = -20;\r
 201  PCRE_ERROR_RECURSIONLIMIT = -21;\r
 202  PCRE_ERROR_NULLWSLIMIT    = -22;\r
 203  PCRE_ERROR_BADNEWLINE     = -23;\r
 204 {$ENDIF}\r
 205 \r
 206 { Request types for pcre_fullinfo() }\r
 207 \r
 208  PCRE_INFO_OPTIONS         =  0;\r
 209  PCRE_INFO_SIZE            =  1;\r
 210  PCRE_INFO_CAPTURECOUNT    =  2;\r
 211  PCRE_INFO_BACKREFMAX      =  3;\r
 212  PCRE_INFO_FIRSTBYTE       =  4;\r
 213  PCRE_INFO_FIRSTCHAR       =  4; { For backwards compatibility }\r
 214  PCRE_INFO_FIRSTTABLE      =  5;\r
 215 {$IFDEF PCRE_5_0}\r
 216  PCRE_INFO_LASTLITERAL     =  6;\r
 217  PCRE_INFO_NAMEENTRYSIZE   =  7;\r
 218  PCRE_INFO_NAMECOUNT       =  8;\r
 219  PCRE_INFO_NAMETABLE       =  9;\r
 220  PCRE_INFO_STUDYSIZE       = 10;\r
 221  PCRE_INFO_DEFAULT_TABLES  = 11;\r
 222 {$ENDIF PCRE_5_0}\r
 223 {$IFDEF PCRE_7_7}\r
 224  PCRE_INFO_OKPARTIAL       = 12;\r
 225  PCRE_INFO_JCHANGED        = 13;\r
 226  PCRE_INFO_HASCRORLF       = 14;\r
 227 {$ENDIF}\r
 228 \r
 229 { Request types for pcre_config() }\r
 230 {$IFDEF PCRE_5_0}\r
 231  PCRE_CONFIG_UTF8                   = 0;\r
 232  PCRE_CONFIG_NEWLINE                = 1;\r
 233  PCRE_CONFIG_LINK_SIZE              = 2;\r
 234  PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3;\r
 235  PCRE_CONFIG_MATCH_LIMIT            = 4;\r
 236  PCRE_CONFIG_STACKRECURSE           = 5;\r
 237  PCRE_CONFIG_UNICODE_PROPERTIES     = 6;\r
 238 {$ENDIF PCRE_5_0}\r
 239 {$IFDEF PCRE_7_0}\r
 240  PCRE_CONFIG_MATCH_LIMIT_RECURSION  = 7;\r
 241 {$ENDIF}\r
 242 {$IFDEF PCRE_7_7}\r
 243  PCRE_CONFIG_BSR                    = 8;\r
 244 {$ENDIF}\r
 245 \r
 246 { Bit flags for the pcre_extra structure }\r
 247 {$IFDEF PCRE_5_0}\r
 248  PCRE_EXTRA_STUDY_DATA            = $0001;\r
 249  PCRE_EXTRA_MATCH_LIMIT           = $0002;\r
 250  PCRE_EXTRA_CALLOUT_DATA          = $0004;\r
 251  PCRE_EXTRA_TABLES                = $0008;\r
 252 {$ENDIF PCRE_5_0}\r
 253 {$IFDEF PCRE_7_0}\r
 254  PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010;\r
 255 {$ENDIF}\r
 256 \r
 257 Const\r
 258 // DefaultOptions : integer = 0;\r
 259  DefaultLocaleTable : pointer = nil;\r
 260 \r
 261 {$IFDEF PCRE_5_0}\r
 262 { The structure for passing additional data to pcre_exec(). This is defined in\r
 263 such as way as to be extensible. Always add new fields at the end, in order to\r
 264 remain compatible. }\r
 265 \r
 266 type ppcre_extra = ^tpcre_extra;\r
 267      tpcre_extra = record\r
 268        flags : longint;                { Bits for which fields are set }\r
 269        study_data : pointer;           { Opaque data from pcre_study() }\r
 270        match_limit : longint;          { Maximum number of calls to match() }\r
 271        callout_data : pointer;         { Data passed back in callouts }\r
 272        tables : pointer;               { Pointer to character tables }\r
 273        match_limit_recursion: longint; { Max recursive calls to match() }\r
 274      end;\r
 275 \r
 276 type ppcre_callout_block = ^pcre_callout_block;\r
 277      pcre_callout_block = record\r
 278        version,\r
 279   (* ------------------------ Version 0 ------------------------------- *)\r
 280        callout_number : integer;\r
 281        offset_vector : pointer;\r
 282        subject : pchar;\r
 283        subject_length, start_match, current_position, capture_top,\r
 284        capture_last : integer;\r
 285        callout_data : pointer;\r
 286   (* ------------------- Added for Version 1 -------------------------- *)\r
 287        pattern_position, next_item_length : integer;\r
 288      end;\r
 289 {$ENDIF PCRE_5_0}\r
 290 \r
 291 {$OrgName+}\r
 292 {$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}\r
 293 \r
 294  { local replacement of external pcre memory management functions }\r
 295  function pcre_malloc( size : integer ) : pointer;\r
 296  procedure pcre_free( {var} p : pointer );\r
 297 {$IFDEF PCRE_5_0}\r
 298  const pcre_stack_malloc: function ( size : integer ): pointer = pcre_malloc;\r
 299        pcre_stack_free: procedure ( {var} p : pointer ) = pcre_free;\r
 300  function pcre_callout(var p : ppcre_callout_block) : integer;\r
 301 {$ENDIF PCRE_5_0}\r
 302 {$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}\r
 303 \r
 304 Implementation\r
 305 \r
 306 Uses strings, collect, messages, dnapp, commands, advance0, stringsx\r
 307     {$IFDEF VIRTUALPASCAL} ,vpsyslow {$ENDIF VIRTUALPASCAL};\r
 308 \r
 309 Const\r
 310  MAGIC_NUMBER = $50435245; { 'PCRE' }\r
 311  MAX_MATCHES = 90; { changed in 3.5 version; should be divisible by 3, was 64}\r
 312 \r
 313 Type\r
 314  PMatchArray = ^TMatchArray;\r
 315  TMatchArray = array[0..( MAX_MATCHES * 3 )] of integer;\r
 316 \r
 317  PRegExpCollection = ^TRegExpCollection;\r
 318  TRegExpCollection =  object(TSortedCollection)\r
 319    MaxRegExp : integer;\r
 320    SearchRegExp : shortstring;\r
 321    CompareModeInsert : boolean;\r
 322    constructor Init(AMaxRegExp:integer);\r
 323    procedure FreeItem(P: Pointer); virtual;\r
 324    function  Compare(P1, P2: Pointer): Integer; virtual;\r
 325    function  Find(ARegExp:shortstring;var P: PpcRegExp):boolean; virtual;\r
 326    function CheckNew(ARegExp:shortstring):PpcRegExp;virtual;\r
 327  end;\r
 328 \r
 329 Var\r
 330  PRegExpCache : PRegExpCollection;\r
 331 \r
 332 \r
 333 {$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}\r
 334 \r
 335  { imported original pcre functions }\r
 336 \r
 337  function pcre_compile( const pattern : PChar; options : integer;\r
 338                         var errorptr : PChar; var erroroffset : integer;\r
 339                         const tables : PChar ) : pointer {pcre}; external;\r
 340 {$IFDEF PCRE_7_0}\r
 341  function pcre_compile2( const pattern : PChar; options : integer;\r
 342                          var errorcodeptr : Integer;\r
 343                          var errorptr : PChar; var erroroffset : integer;\r
 344                          const tables : PChar ) : pointer {pcre}; external;\r
 345 {$ENDIF}\r
 346 {$IFDEF PCRE_5_0}\r
 347  function pcre_config( what : integer; where : pointer) : integer; external;\r
 348  function pcre_copy_named_substring( const code : pointer {pcre};\r
 349                                      const subject : pchar;\r
 350                                      var ovector : integer;\r
 351                                      stringcount : integer;\r
 352                                      const stringname : pchar;\r
 353                                      var buffer : pchar;\r
 354                                      size : integer) : integer; external;\r
 355  function pcre_copy_substring( const subject : pchar; var ovector : integer;\r
 356                                stringcount, stringnumber : integer;\r
 357                                var buffer : pchar; size : integer )\r
 358                                : integer; external;\r
 359  function pcre_exec( const argument_re : pointer {pcre};\r
 360                      const extra_data : pointer {pcre_extra};\r
 361 {$ELSE}\r
 362  function pcre_exec( const external_re : pointer;\r
 363                      const external_extra : pointer;\r
 364 {$ENDIF}\r
 365                      const subject : PChar;\r
 366                      length, start_offset, options : integer;\r
 367                      offsets : pointer;\r
 368                      offsetcount : integer ) : integer; external;\r
 369 {$IFDEF PCRE_7_0}\r
 370  function pcre_dfa_exec( const argument_re : pointer {pcre};\r
 371                          const extra_data : pointer {pcre_extra};\r
 372                          const subject : pchar;\r
 373                          length, start_offset, options : integer;\r
 374                          offsets : pointer;\r
 375                          offsetcount : integer;\r
 376                          workspace : pointer;\r
 377                          wscount : integer ) : integer; external;\r
 378 {$ENDIF}\r
 379 {$IFDEF PCRE_5_0}\r
 380  procedure pcre_free_substring( const p : pchar ); external;\r
 381  procedure pcre_free_substring_list( var p : pchar ); external;\r
 382  function pcre_fullinfo( const argument_re : pointer {pcre};\r
 383                          const extra_data : pointer {pcre_extra};\r
 384                          what : integer;\r
 385                          where : pointer ) : integer; external;\r
 386  function pcre_get_named_substring( const code : pointer {pcre};\r
 387                                     const subject : pchar;\r
 388                                     var ovector : integer;\r
 389                                     stringcount : integer;\r
 390                                     const stringname : pchar;\r
 391                                     var stringptr : pchar ) : integer; external;\r
 392  function pcre_get_stringnumber( const code : pointer {pcre};\r
 393                                  const stringname : pchar ) : integer; external;\r
 394  function pcre_get_stringtable_entries( const code : pointer {pcre};\r
 395                                         const stringname : pchar;\r
 396                                         var firstptr,\r
 397                                             lastptr : pchar ) : integer; external;\r
 398  function pcre_get_substring( const subject : pchar; var ovector : integer;\r
 399                               stringcount, stringnumber : integer;\r
 400                               var stringptr : pchar ) : integer; external;\r
 401  function pcre_get_substring_list( const subject : pchar; var ovector : integer;\r
 402                                    stringcount : integer;\r
 403                                    listptr : pointer {const char ***listptr}) : integer; external;\r
 404  function pcre_info( const argument_re : pointer {pcre};\r
 405                      var optptr : integer;\r
 406                      var first_byte : integer ) : integer; external;\r
 407  function pcre_maketables : pchar; external;\r
 408 {$ENDIF}\r
 409 {$IFDEF PCRE_7_0}\r
 410  function pcre_refcount( const argument_re : pointer {pcre};\r
 411                          adjust : integer ) : pchar; external;\r
 412 {$ENDIF}\r
 413  function pcre_study( const external_re : pointer {pcre};\r
 414                       options : integer;\r
 415                       var errorptr : PChar ) : pointer {pcre_extra}; external;\r
 416 {$IFDEF PCRE_5_0}\r
 417  function pcre_version : pchar; external;\r
 418 {$ENDIF}\r
 419 \r
 420  function pcre_malloc( size : integer ) : pointer;\r
 421  begin\r
 422   GetMem( result, size );\r
 423  end;\r
 424 \r
 425  procedure pcre_free( {var} p : pointer );\r
 426  begin\r
 427   if (p <> nil) then\r
 428     FreeMem( p, 0 );\r
 429   {@p := nil;}\r
 430  end;\r
 431 \r
 432 {$IFDEF PCRE_5_0}\r
 433 (* Called from PCRE as a result of the (?C) item. We print out where we are in\r
 434 the match. Yield zero unless more callouts than the fail count, or the callout\r
 435 data is not zero. *)\r
 436 \r
 437  function pcre_callout;\r
 438  begin\r
 439  end;\r
 440 {$ENDIF}\r
 441 \r
 442 {$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}\r
 443 \r
 444 // Always include the newest version of the library\r
 445 {$IFDEF PCRE_7_7}\r
 446   {$L pcre77.lib}\r
 447 {$ELSE}\r
 448   {$IFDEF PCRE_7_0}\r
 449     {$L pcre70.lib}\r
 450   {$ELSE}\r
 451     {$IFDEF PCRE_5_0}\r
 452       {$L pcre50.lib}\r
 453     {$ELSE}\r
 454       {$IFDEF PCRE_3_7}\r
 455         {$L pcre37.lib}\r
 456       {$ENDIF PCRE_3_7}\r
 457     {$ENDIF PCRE_5_0}\r
 458   {$ENDIF PCRE_7_0}\r
 459 {$ENDIF PCRE_7_7}\r
 460 \r
 461 {TpcRegExp}\r
 462 \r
 463  constructor TpcRegExp.Init(const ARegExp:shortstring; AOptions:integer; ALocale : Pointer);\r
 464  var\r
 465   pRegExp : PChar;\r
 466  begin\r
 467   RegExp:=ARegExp;\r
 468   RegExpC:=nil;\r
 469   RegExpExt:=nil;\r
 470   Matches:=nil;\r
 471   MatchesCount:=0;\r
 472   Error:=true;\r
 473   ErrorMsg:=nil;\r
 474   ErrorPos:=0;\r
 475   RunTimeOptions := 0;\r
 476   if length(RegExp) < 255 then\r
 477    begin\r
 478     RegExp[length(RegExp)+1]:=#0;\r
 479     pRegExp:=@RegExp[1];\r
 480    end\r
 481   else\r
 482    begin\r
 483     GetMem(pRegExp,length(RegExp)+1);\r
 484     pRegExp:=strpcopy(pRegExp,RegExp);\r
 485    end;\r
 486   RegExpC := pcre_compile( pRegExp,\r
 487                            AOptions and PCRE_COMPILE_ALLOWED_OPTIONS,\r
 488                            ErrorMsg, ErrorPos, ALocale);\r
 489   if length(RegExp) = 255 then\r
 490    StrDispose(pRegExp);\r
 491   if RegExpC = nil then\r
 492    exit;\r
 493   ErrorMsg:=nil;\r
 494   RegExpExt := pcre_study( RegExpC, 0, ErrorMsg );\r
 495   if (RegExpExt = nil) and (ErrorMsg <> nil) then\r
 496    begin\r
 497     pcre_free(RegExpC);\r
 498     exit;\r
 499    end;\r
 500   GetMem(Matches,SizeOf(TMatchArray));\r
 501   Error:=false;\r
 502  end;\r
 503 \r
 504  destructor TpcRegExp.Done;\r
 505  begin\r
 506   if RegExpC <> nil then\r
 507     pcre_free(RegExpC);\r
 508   if RegExpExt <> nil then\r
 509     pcre_free(RegExpExt);\r
 510   if Matches <> nil then\r
 511     FreeMem(Matches,SizeOf(TMatchArray));\r
 512  end;\r
 513 \r
 514  function TpcRegExp.SearchNext( AStr: Pchar; ALen : longint ) : boolean;\r
 515  var Options: Integer;\r
 516  begin // must handle PCRE_ERROR_PARTIAL here\r
 517   Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and\r
 518              PCRE_EXEC_ALLOWED_OPTIONS;\r
 519   if MatchesCount > 0 then\r
 520     MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, PMatchArray(Matches)^[1],\r
 521                              Options, Matches, MAX_MATCHES ) else\r
 522     MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, 0,\r
 523                              Options, Matches, MAX_MATCHES );\r
 524 {  if MatchesCount = 0 then\r
 525     MatchesCount := MatchesCount div 3;}\r
 526   PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;\r
 527   SearchNext := MatchesCount > 0;\r
 528  end;\r
 529 \r
 530  function TpcRegExp.Search( AStr: Pchar; ALen : longint):boolean;\r
 531  begin\r
 532   MatchesCount:=0;\r
 533   Search:=SearchNext(AStr,ALen);\r
 534   SourceLen:=ALen;\r
 535  end;\r
 536 \r
 537  function TpcRegExp.SearchOfs( AStr: Pchar; ALen, AOfs: longint ) : boolean;\r
 538  var Options: Integer;\r
 539  begin\r
 540   MatchesCount:=0;\r
 541   Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and\r
 542              PCRE_EXEC_ALLOWED_OPTIONS;\r
 543   MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, AOfs,\r
 544                            Options, Matches, MAX_MATCHES );\r
 545   PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;\r
 546   SearchOfs := MatchesCount > 0;\r
 547   SourceLen := ALen-AOfs;\r
 548  end;\r
 549 \r
 550  function TpcRegExp.MatchSub(ANom:integer; var Pos,Len:longint):boolean;\r
 551  begin\r
 552   if (MatchesCount > 0) and (ANom <= (MatchesCount-1)) then\r
 553    begin\r
 554     ANom:=ANom*2;\r
 555     Pos:=PMatchArray(Matches)^[ANom];\r
 556     Len:=PMatchArray(Matches)^[ANom+1]-Pos;\r
 557     MatchSub:=true;\r
 558    end\r
 559   else\r
 560    MatchSub:=false;\r
 561  end;\r
 562 \r
 563  function TpcRegExp.MatchFull(var Pos,Len:longint):boolean;\r
 564  begin\r
 565   MatchFull:=MatchSub(0,Pos,Len);\r
 566  end;\r
 567 \r
 568  function TpcRegExp.GetSubStr(ANom: integer; AStr: Pchar):string;\r
 569  var\r
 570   s: ansistring;\r
 571   pos,len: longint;\r
 572  begin\r
 573   s:='';\r
 574   if MatchSub(ANom, pos, len) then\r
 575    begin\r
 576     setlength(s, len);\r
 577     Move(AStr[pos], s[1], len);\r
 578    end;\r
 579   GetSubStr:=s;\r
 580  end;\r
 581 \r
 582  function TpcRegExp.GetPreSubStr(AStr: Pchar):string;\r
 583  var\r
 584   s: ansistring;\r
 585   l: longint;\r
 586  begin\r
 587   s:='';\r
 588   if (MatchesCount > 0) then\r
 589    begin\r
 590     l:=PMatchArray(Matches)^[0]-1;\r
 591     if l > 0 then\r
 592      begin\r
 593       setlength(s,l);\r
 594       Move(AStr[1],s[1],l);\r
 595      end;\r
 596    end;\r
 597   GetPreSubStr:=s;\r
 598  end;\r
 599 \r
 600  function TpcRegExp.GetPostSubStr(AStr: Pchar):string;\r
 601  var\r
 602   s: ansistring;\r
 603   l: longint;\r
 604   ANom: integer;\r
 605  begin\r
 606   s:='';\r
 607   if (MatchesCount > 0) then\r
 608    begin\r
 609     ANom:=(MatchesCount-1){*2} shl 1;\r
 610     l:=SourceLen-PMatchArray(Matches)^[ANom+1]+1;\r
 611     if l > 0 then\r
 612      begin\r
 613       setlength(s,l);\r
 614       Move(AStr[PMatchArray(Matches)^[ANom+1]],s[1],l);\r
 615      end;\r
 616    end;\r
 617   GetPostSubStr:=s;\r
 618  end;\r
 619 \r
 620 \r
 621  function TpcRegExp.GetFullStr(AStr: Pchar):string;\r
 622  var\r
 623   s: ansistring;\r
 624   l: longint;\r
 625  begin\r
 626   GetFullStr:=GetSubStr(0,AStr);\r
 627  end;\r
 628 \r
 629  function TpcRegExp.GetReplStr(AStr: Pchar; const ARepl: string):string;\r
 630  var\r
 631   s: ansistring;\r
 632   l,i,lasti: longint;\r
 633  begin\r
 634   l:=length(ARepl);\r
 635   i:=1;\r
 636   lasti:=1;\r
 637   s:='';\r
 638   while i <= l do\r
 639    begin\r
 640     case ARepl[i] of\r
 641      '\' :\r
 642       begin\r
 643        if i < l then\r
 644         begin\r
 645          s:=s+copy(ARepl,lasti,i-lasti){+ARepl[i+1]};\r
 646          {AH 17-10-05 support for POSIX \1-\9 backreferences}\r
 647          case ARepl[i+1] of\r
 648           '0' : s:=s+GetFullStr(AStr);\r
 649           '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr);\r
 650           else s:=s+ARepl[i+1]; // copy the escaped character\r
 651          end;\r
 652         end;\r
 653        inc(i);\r
 654        lasti:=i+1;\r
 655       end;\r
 656      '$' :\r
 657       begin\r
 658        if i < l then\r
 659         begin\r
 660          s:=s+copy(ARepl,lasti,i-lasti);\r
 661          case ARepl[i+1] of\r
 662           '&' : s:=s+GetFullStr(AStr);\r
 663           '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr);\r
 664           '`' : s:=s+GetPreSubStr(AStr);\r
 665           #39 : s:=s+GetPostSubStr(AStr);\r
 666          end;\r
 667         end;\r
 668        inc(i);\r
 669        lasti:=i+1;\r
 670       end;\r
 671     end;\r
 672     inc(i);\r
 673    end;\r
 674   if lasti <= {AH 25-10-2004 added =, else l==1 won't work} l then\r
 675     s:=s+copy(ARepl,lasti,l-lasti+1);\r
 676   GetReplStr:=s;\r
 677  end;\r
 678 \r
 679  function TpcRegExp.ErrorStr:string;\r
 680   begin\r
 681    ErrorStr:=StrPas(ErrorMsg);\r
 682   end;\r
 683 \r
 684 {TRegExpCollection}\r
 685 \r
 686 constructor TRegExpCollection.Init(AMaxRegExp: integer);\r
 687 begin\r
 688  Inherited Init(1,1);\r
 689  MaxRegExp:=AMaxRegExp;\r
 690  CompareModeInsert:=true;\r
 691 end;\r
 692 \r
 693 procedure TRegExpCollection.FreeItem(P: Pointer);\r
 694 begin\r
 695  if P <> nil then\r
 696   begin\r
 697    Dispose(PpcRegExp(P),Done);\r
 698   end;\r
 699 end;\r
 700 \r
 701 function  TRegExpCollection.Compare(P1, P2: Pointer): Integer;\r
 702 //var\r
 703 // l,l1,l2,i : byte;\r
 704 //// wPos: pchar;\r
 705 begin\r
 706  if CompareModeInsert then\r
 707   begin\r
 708 //   l1:=length(PpcRegExp(P1)^.RegExp);\r
 709 //   l2:=length(PpcRegExp(P2)^.RegExp);\r
 710 //   if l1 > l2 then l:=l2 else\r
 711 //                   l:=l1;\r
 712 //   for i:=1 to l do\r
 713 //     if PpcRegExp(P1).RegExp[i] <> PpcRegExp(P2).RegExp[i] then break;\r
 714 //   if i <=l then\r
 715 //     Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(PpcRegExp(P2).RegExp[i]) else\r
 716 //     Compare:=l1-l2;\r
 717     Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, PpcRegExp(P2).RegExp, False);\r
 718   end\r
 719  else\r
 720   begin\r
 721 //   l1:=length(PpcRegExp(P1)^.RegExp);\r
 722 //   l2:=length(SearchRegExp);\r
 723 //   if l1 > l2 then l:=l2 else\r
 724 //                   l:=l1;\r
 725 //   for i:=1 to l do\r
 726 //     if PpcRegExp(P1).RegExp[i] <> SearchRegExp[i] then\r
 727 //     begin\r
 728 //       Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(SearchRegExp[i]);\r
 729 //       break;\r
 730 //     end;\r
 731 //   if i > l then Compare:=l1-l2;\r
 732     Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, SearchRegExp, False);\r
 733   end;\r
 734 end;\r
 735 \r
 736 function  TRegExpCollection.Find(ARegExp:shortstring;var P: PpcRegExp):boolean;\r
 737 var I : integer;\r
 738 begin\r
 739  CompareModeInsert:=false;\r
 740  SearchRegExp:=ARegExp;\r
 741  if Search(nil,I) then\r
 742   begin\r
 743    P:=PpcRegExp(At(I));\r
 744    Find:=true;\r
 745   end\r
 746  else\r
 747   begin\r
 748    P:=nil;\r
 749    Find:=false;\r
 750   end;\r
 751  CompareModeInsert:=true;\r
 752 end;\r
 753 \r
 754 function TRegExpCollection.CheckNew(ARegExp:shortstring):PpcRegExp;\r
 755 var\r
 756  P : PpcRegExp;\r
 757 begin\r
 758  if not Find(ARegExp,P) then\r
 759   begin\r
 760    if Count = MaxRegExp then\r
 761     AtFree(0);\r
 762    P:=New(ppcRegExp,Init(ARegExp,PCRE_CASELESS,nil));\r
 763    Insert(P);\r
 764   end;\r
 765  CheckNew:=P;\r
 766 end;\r
 767 \r
 768 function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean;\r
 769 var\r
 770  PpcRE:PpcRegExp;\r
 771 begin\r
 772  PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale));\r
 773  pcGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr));\r
 774  Dispose(PpcRE,Done);\r
 775 end;\r
 776 \r
 777 function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string;\r
 778 var\r
 779  PpcRE:PpcRegExp;\r
 780 begin\r
 781  PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale));\r
 782  if PpcRE^.Search(pchar(AStr),Length(AStr)) then\r
 783   pcGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl)\r
 784  else\r
 785   pcGrepSub:='';\r
 786  Dispose(PpcRE,Done);\r
 787 end;\r
 788 \r
 789 function pcFastGrepMatch(WildCard, aStr: string): Boolean;\r
 790 var\r
 791  PpcRE:PpcRegExp;\r
 792 begin\r
 793  PpcRE:=PRegExpCache^.CheckNew(WildCard);\r
 794  pcFastGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr));\r
 795 end;\r
 796 \r
 797 function pcFastGrepSub(WildCard, aStr, aRepl: string): string;\r
 798 var\r
 799  PpcRE:PpcRegExp;\r
 800 begin\r
 801  PpcRE:=PRegExpCache^.CheckNew(WildCard);\r
 802  if PpcRE^.Search(pchar(AStr),Length(AStr)) then\r
 803   pcFastGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl)\r
 804  else\r
 805   pcFastGrepSub:='';\r
 806 end;\r
 807 \r
 808 {$IFDEF PCRE_5_0}\r
 809 function pcGetVersion : pchar; assembler; {$FRAME-}{$USES none}\r
 810 asm\r
 811   call pcre_version\r
 812 end;\r
 813 {$ENDIF PCRE_5_0}\r
 814 \r
 815 function pcError;\r
 816 var P: ppcRegExp absolute pRegExp;\r
 817 begin\r
 818   Result := (P = nil) or P^.Error;\r
 819   If Result and (P <> nil) then\r
 820   begin\r
 821 {     if P^.ErrorPos = 0 then\r
 822       MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"', nil,mfConfirmation+mfOkButton)\r
 823     else}\r
 824       MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"'+GetString(erRegExpCompPos),\r
 825                  @P^.ErrorPos,mfConfirmation+mfOkButton);\r
 826     Dispose(P, Done);\r
 827     P:=nil;\r
 828   end;\r
 829 end;\r
 830 \r
 831 function pcInit;\r
 832 var Options : Integer;\r
 833 begin\r
 834   If CaseSens then Options := 0 else Options := PCRE_CASELESS;\r
 835   Result := New( PpcRegExp, Init( Pattern,\r
 836                                   {DefaultOptions}\r
 837                                   startup.MiscMultiData.cfgRegEx.DefaultOptions or Options,\r
 838                                   DefaultLocaleTable) );\r
 839 end;\r
 840 \r
 841 Initialization\r
 842  PRegExpCache:=New(PRegExpCollection,Init(64));\r
 843 Finalization\r
 844  Dispose(PRegExpCache,Done);\r
 845 End.\r