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
main(int argc,char ** argv)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.
846