/[pcre]/code/tags/pcre-7.3/pcregexp.pas
ViewVC logotype

Contents of /code/tags/pcre-7.3/pcregexp.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 101 - (hide annotations) (download)
Tue Mar 6 15:19:44 2007 UTC (7 years, 5 months ago) by ph10
Original Path: code/trunk/pcregexp.pas
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 ph10 101 {
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