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