/[pcre]/code/trunk/pcregexp.pas
ViewVC logotype

Contents of /code/trunk/pcregexp.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (show annotations) (download)
Mon Apr 16 15:28:08 2007 UTC (7 years, 5 months ago) by ph10
File size: 23874 byte(s)
Add PCRE_NEWLINE_ANYCRLF.

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

webmaster@exim.org
ViewVC Help
Powered by ViewVC 1.1.12