release/src/router/pcre/pcregexp.pas

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