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

Contents of /code/trunk/pcregexp.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

webmaster@exim.org
ViewVC Help
Powered by ViewVC 1.1.12