/[pcre]/code/branches/pcre16/pcregexp.pas
ViewVC logotype

Contents of /code/branches/pcre16/pcregexp.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (hide annotations) (download)
Mon Apr 16 15:28:08 2007 UTC (7 years, 3 months ago) by ph10
Original Path: code/trunk/pcregexp.pas
File size: 23874 byte(s)
Add PCRE_NEWLINE_ANYCRLF.

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 ph10 149 PCRE_NEWLINE_ANYCRLF = $00500000;
108 ph10 101 {$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 ph10 149 + PCRE_NEWLINE_ANY + PCRE_NEWLINE_CRLF
117 ph10 101 {$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 ph10 149 + PCRE_NEWLINE_CRLF + PCRE_NEWLINE_ANY +PCRE_NEWLINE_ANYCRLF
124 ph10 101 {$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 ph10 149 PCRE_NEWLINE_ANY + PCRE_NEWLINE_ANYCRLF
133 ph10 101 {$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 ph10 149 PCRE_INFO_SIZE = 1;
168 ph10 101 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 ph10 149 PCRE_CONFIG_UTF8 = 0;
185     PCRE_CONFIG_NEWLINE = 1;
186     PCRE_CONFIG_LINK_SIZE = 2;
187 ph10 101 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 ph10 149 PCRE_EXTRA_STUDY_DATA = $0001;
199     PCRE_EXTRA_MATCH_LIMIT = $0002;
200 ph10 101 PCRE_EXTRA_CALLOUT_DATA = $0004;
201 ph10 149 PCRE_EXTRA_TABLES = $0008;
202 ph10 101 {$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 ph10 149 flags : longint; { Bits for which fields are set }
219 ph10 101 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 ph10 149 {$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 ph10 101
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 ph10 149 // l:=l1;
650 ph10 101 // 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 ph10 149 // l:=l1;
663 ph10 101 // 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