{ pcRegExp - Perl compatible regular expressions for Virtual Pascal (c) 2001 Peter S. Voronov aka Chem O'Dun <petervrn@yahoo.com> Based on PCRE library interface unit for Virtual Pascal. (c) 2001 Alexander Tokarev <dwalin@dwalin.ru> The current PCRE version is: 3.7 This software must be distributed as Freeware. The PCRE library is written by: Philip Hazel <ph10@cam.ac.uk> Copyright (c) 1997-2004 University of Cambridge AngelsHolocaust 4-11-04 updated to use version v5.0 (INFO: this is regex-directed, NFA) AH: 9-11-04 - pcre_free: removed var, pcre already gives the ptr, now everything works as it should (no more crashes) -> removed CheckRegExp because pcre handles errors perfectly 10-11-04 - added pcError (errorhandling), pcInit 13-11-04 - removed the ErrorPos = 0 check -> always print erroroffset 17-10-05 - support for \1-\9 backreferences in TpcRegExp.GetReplStr 17-02-06 - added RunTimeOptions: caller can set options while searching 19-02-06 - added SearchOfs(): let PCRE use the complete string and offset into the string itself 20-12-06 - support for version 7.0 27.08.08 - support for v7.7 } {$H+} {$DEFINE PCRE_3_7} {$DEFINE PCRE_5_0} {$DEFINE PCRE_7_0} {$DEFINE PCRE_7_7} Unit pcregexp; Interface uses objects; Type PpcRegExp = ^TpcRegExp; // TpcRegExp = object TpcRegExp = object(TObject) MatchesCount: integer; RegExpC, RegExpExt : Pointer; Matches:Pointer; RegExp: shortstring; SourceLen: integer; PartialMatch : boolean; Error : boolean; ErrorMsg : Pchar; ErrorPos : integer; RunTimeOptions: Integer; // options which can be set by the caller constructor Init(const ARegExp : shortstring; AOptions : integer; ALocale : Pointer); function Search(AStr: Pchar; ALen : longint) : boolean; virtual; function SearchNext( AStr: Pchar; ALen : longint) : boolean; virtual; function SearchOfs ( AStr: Pchar; ALen, AOfs : longint) : boolean; virtual; function MatchSub(ANom: integer; var Pos, Len : longint) : boolean; virtual; function MatchFull(var Pos, Len : longint) : boolean; virtual; function GetSubStr(ANom: integer; AStr: Pchar) : string; virtual; function GetFullStr(AStr: Pchar) : string; virtual; function GetReplStr(AStr: Pchar; const ARepl: string) : string; virtual; function GetPreSubStr(AStr: Pchar) : string; virtual; function GetPostSubStr(AStr: Pchar) : string; virtual; function ErrorStr : string; virtual; destructor Done; virtual; end; function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean; function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string; function pcFastGrepMatch(WildCard, aStr: string): Boolean; function pcFastGrepSub(WildCard, aStr, aRepl: string): string; {$IFDEF PCRE_5_0} function pcGetVersion : pchar; {$ENDIF} function pcError (var pRegExp : Pointer) : Boolean; function pcInit (const Pattern: Shortstring; CaseSens: Boolean) : Pointer; Const { Options } PCRE_CASELESS = $0001; PCRE_MULTILINE = $0002; PCRE_DOTALL = $0004; PCRE_EXTENDED = $0008; PCRE_ANCHORED = $0010; PCRE_DOLLAR_ENDONLY = $0020; PCRE_EXTRA = $0040; PCRE_NOTBOL = $0080; PCRE_NOTEOL = $0100; PCRE_UNGREEDY = $0200; PCRE_NOTEMPTY = $0400; {$IFDEF PCRE_5_0} PCRE_UTF8 = $0800; PCRE_NO_AUTO_CAPTURE = $1000; PCRE_NO_UTF8_CHECK = $2000; PCRE_AUTO_CALLOUT = $4000; PCRE_PARTIAL = $8000; {$ENDIF} {$IFDEF PCRE_7_0} PCRE_DFA_SHORTEST = $00010000; PCRE_DFA_RESTART = $00020000; PCRE_FIRSTLINE = $00040000; PCRE_DUPNAMES = $00080000; PCRE_NEWLINE_CR = $00100000; PCRE_NEWLINE_LF = $00200000; PCRE_NEWLINE_CRLF = $00300000; PCRE_NEWLINE_ANY = $00400000; PCRE_NEWLINE_ANYCRLF = $00500000; PCRE_NEWLINE_BITS = PCRE_NEWLINE_CR or PCRE_NEWLINE_LF or PCRE_NEWLINE_ANY; {$ENDIF} {$IFDEF PCRE_7_7} PCRE_BSR_ANYCRLF = $00800000; PCRE_BSR_UNICODE = $01000000; PCRE_JAVASCRIPT_COMPAT= $02000000; {$ENDIF} PCRE_COMPILE_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_AUTO_CALLOUT + PCRE_CASELESS + PCRE_DOLLAR_ENDONLY + PCRE_DOTALL + PCRE_EXTENDED + PCRE_EXTRA + PCRE_MULTILINE + PCRE_NO_AUTO_CAPTURE + PCRE_UNGREEDY + PCRE_UTF8 + PCRE_NO_UTF8_CHECK {$IFDEF PCRE_7_0} + PCRE_DUPNAMES + PCRE_FIRSTLINE + PCRE_NEWLINE_BITS {$ENDIF} {$IFDEF PCRE_7_7} + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE + PCRE_JAVASCRIPT_COMPAT {$ENDIF} ; PCRE_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL + PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL {$IFDEF PCRE_7_0} + PCRE_NEWLINE_BITS {$ENDIF} {$IFDEF PCRE_7_7} + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE {$ENDIF} ; {$IFDEF PCRE_7_0} PCRE_DFA_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL + PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL + PCRE_DFA_SHORTEST + PCRE_DFA_RESTART + PCRE_NEWLINE_BITS {$IFDEF PCRE_7_7} + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE {$ENDIF} ; {$ENDIF} { Exec-time and get/set-time error codes } PCRE_ERROR_NOMATCH = -1; PCRE_ERROR_NULL = -2; PCRE_ERROR_BADOPTION = -3; PCRE_ERROR_BADMAGIC = -4; PCRE_ERROR_UNKNOWN_MODE = -5; PCRE_ERROR_NOMEMORY = -6; PCRE_ERROR_NOSUBSTRING = -7; {$IFDEF PCRE_5_0} PCRE_ERROR_MATCHLIMIT = -8; PCRE_ERROR_CALLOUT = -9; { Never used by PCRE itself } PCRE_ERROR_BADUTF8 = -10; PCRE_ERROR_BADUTF8_OFFSET = -11; PCRE_ERROR_PARTIAL = -12; PCRE_ERROR_BADPARTIAL = -13; PCRE_ERROR_INTERNAL = -14; PCRE_ERROR_BADCOUNT = -15; {$ENDIF} {$IFDEF PCRE_7_0} PCRE_ERROR_DFA_UITEM = -16; PCRE_ERROR_DFA_UCOND = -17; PCRE_ERROR_DFA_UMLIMIT = -18; PCRE_ERROR_DFA_WSSIZE = -19; PCRE_ERROR_DFA_RECURSE = -20; PCRE_ERROR_RECURSIONLIMIT = -21; PCRE_ERROR_NULLWSLIMIT = -22; PCRE_ERROR_BADNEWLINE = -23; {$ENDIF} { Request types for pcre_fullinfo() } PCRE_INFO_OPTIONS = 0; PCRE_INFO_SIZE = 1; PCRE_INFO_CAPTURECOUNT = 2; PCRE_INFO_BACKREFMAX = 3; PCRE_INFO_FIRSTBYTE = 4; PCRE_INFO_FIRSTCHAR = 4; { For backwards compatibility } PCRE_INFO_FIRSTTABLE = 5; {$IFDEF PCRE_5_0} PCRE_INFO_LASTLITERAL = 6; PCRE_INFO_NAMEENTRYSIZE = 7; PCRE_INFO_NAMECOUNT = 8; PCRE_INFO_NAMETABLE = 9; PCRE_INFO_STUDYSIZE = 10; PCRE_INFO_DEFAULT_TABLES = 11; {$ENDIF PCRE_5_0} {$IFDEF PCRE_7_7} PCRE_INFO_OKPARTIAL = 12; PCRE_INFO_JCHANGED = 13; PCRE_INFO_HASCRORLF = 14; {$ENDIF} { Request types for pcre_config() } {$IFDEF PCRE_5_0} PCRE_CONFIG_UTF8 = 0; PCRE_CONFIG_NEWLINE = 1; PCRE_CONFIG_LINK_SIZE = 2; PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3; PCRE_CONFIG_MATCH_LIMIT = 4; PCRE_CONFIG_STACKRECURSE = 5; PCRE_CONFIG_UNICODE_PROPERTIES = 6; {$ENDIF PCRE_5_0} {$IFDEF PCRE_7_0} PCRE_CONFIG_MATCH_LIMIT_RECURSION = 7; {$ENDIF} {$IFDEF PCRE_7_7} PCRE_CONFIG_BSR = 8; {$ENDIF} { Bit flags for the pcre_extra structure } {$IFDEF PCRE_5_0} PCRE_EXTRA_STUDY_DATA = $0001; PCRE_EXTRA_MATCH_LIMIT = $0002; PCRE_EXTRA_CALLOUT_DATA = $0004; PCRE_EXTRA_TABLES = $0008; {$ENDIF PCRE_5_0} {$IFDEF PCRE_7_0} PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010; {$ENDIF} Const // DefaultOptions : integer = 0; DefaultLocaleTable : pointer = nil; {$IFDEF PCRE_5_0} { The structure for passing additional data to pcre_exec(). This is defined in such as way as to be extensible. Always add new fields at the end, in order to remain compatible. } type ppcre_extra = ^tpcre_extra; tpcre_extra = record flags : longint; { Bits for which fields are set } study_data : pointer; { Opaque data from pcre_study() } match_limit : longint; { Maximum number of calls to match() } callout_data : pointer; { Data passed back in callouts } tables : pointer; { Pointer to character tables } match_limit_recursion: longint; { Max recursive calls to match() } end; type ppcre_callout_block = ^pcre_callout_block; pcre_callout_block = record version, (* ------------------------ Version 0 ------------------------------- *) callout_number : integer; offset_vector : pointer; subject : pchar; subject_length, start_match, current_position, capture_top, capture_last : integer; callout_data : pointer; (* ------------------- Added for Version 1 -------------------------- *) pattern_position, next_item_length : integer; end; {$ENDIF PCRE_5_0} {$OrgName+} {$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL} { local replacement of external pcre memory management functions } function pcre_malloc( size : integer ) : pointer; procedure pcre_free( {var} p : pointer ); {$IFDEF PCRE_5_0} const pcre_stack_malloc: function ( size : integer ): pointer = pcre_malloc; pcre_stack_free: procedure ( {var} p : pointer ) = pcre_free; function pcre_callout(var p : ppcre_callout_block) : integer; {$ENDIF PCRE_5_0} {$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL} Implementation Uses strings, collect, messages, dnapp, commands, advance0, stringsx {$IFDEF VIRTUALPASCAL} ,vpsyslow {$ENDIF VIRTUALPASCAL}; Const MAGIC_NUMBER = $50435245; { 'PCRE' } MAX_MATCHES = 90; { changed in 3.5 version; should be divisible by 3, was 64} Type PMatchArray = ^TMatchArray; TMatchArray = array[0..( MAX_MATCHES * 3 )] of integer; PRegExpCollection = ^TRegExpCollection; TRegExpCollection = object(TSortedCollection) MaxRegExp : integer; SearchRegExp : shortstring; CompareModeInsert : boolean; constructor Init(AMaxRegExp:integer); procedure FreeItem(P: Pointer); virtual; function Compare(P1, P2: Pointer): Integer; virtual; function Find(ARegExp:shortstring;var P: PpcRegExp):boolean; virtual; function CheckNew(ARegExp:shortstring):PpcRegExp;virtual; end; Var PRegExpCache : PRegExpCollection; {$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL} { imported original pcre functions } function pcre_compile( const pattern : PChar; options : integer; var errorptr : PChar; var erroroffset : integer; const tables : PChar ) : pointer {pcre}; external; {$IFDEF PCRE_7_0} function pcre_compile2( const pattern : PChar; options : integer; var errorcodeptr : Integer; var errorptr : PChar; var erroroffset : integer; const tables : PChar ) : pointer {pcre}; external; {$ENDIF} {$IFDEF PCRE_5_0} function pcre_config( what : integer; where : pointer) : integer; external; function pcre_copy_named_substring( const code : pointer {pcre}; const subject : pchar; var ovector : integer; stringcount : integer; const stringname : pchar; var buffer : pchar; size : integer) : integer; external; function pcre_copy_substring( const subject : pchar; var ovector : integer; stringcount, stringnumber : integer; var buffer : pchar; size : integer ) : integer; external; function pcre_exec( const argument_re : pointer {pcre}; const extra_data : pointer {pcre_extra}; {$ELSE} function pcre_exec( const external_re : pointer; const external_extra : pointer; {$ENDIF} const subject : PChar; length, start_offset, options : integer; offsets : pointer; offsetcount : integer ) : integer; external; {$IFDEF PCRE_7_0} function pcre_dfa_exec( const argument_re : pointer {pcre}; const extra_data : pointer {pcre_extra}; const subject : pchar; length, start_offset, options : integer; offsets : pointer; offsetcount : integer; workspace : pointer; wscount : integer ) : integer; external; {$ENDIF} {$IFDEF PCRE_5_0} procedure pcre_free_substring( const p : pchar ); external; procedure pcre_free_substring_list( var p : pchar ); external; function pcre_fullinfo( const argument_re : pointer {pcre}; const extra_data : pointer {pcre_extra}; what : integer; where : pointer ) : integer; external; function pcre_get_named_substring( const code : pointer {pcre}; const subject : pchar; var ovector : integer; stringcount : integer; const stringname : pchar; var stringptr : pchar ) : integer; external; function pcre_get_stringnumber( const code : pointer {pcre}; const stringname : pchar ) : integer; external; function pcre_get_stringtable_entries( const code : pointer {pcre}; const stringname : pchar; var firstptr, lastptr : pchar ) : integer; external; function pcre_get_substring( const subject : pchar; var ovector : integer; stringcount, stringnumber : integer; var stringptr : pchar ) : integer; external; function pcre_get_substring_list( const subject : pchar; var ovector : integer; stringcount : integer; listptr : pointer {const char ***listptr}) : integer; external; function pcre_info( const argument_re : pointer {pcre}; var optptr : integer; var first_byte : integer ) : integer; external; function pcre_maketables : pchar; external; {$ENDIF} {$IFDEF PCRE_7_0} function pcre_refcount( const argument_re : pointer {pcre}; adjust : integer ) : pchar; external; {$ENDIF} function pcre_study( const external_re : pointer {pcre}; options : integer; var errorptr : PChar ) : pointer {pcre_extra}; external; {$IFDEF PCRE_5_0} function pcre_version : pchar; external; {$ENDIF} function pcre_malloc( size : integer ) : pointer; begin GetMem( result, size ); end; procedure pcre_free( {var} p : pointer ); begin if (p <> nil) then FreeMem( p, 0 ); {@p := nil;} end; {$IFDEF PCRE_5_0} (* Called from PCRE as a result of the (?C) item. We print out where we are in the match. Yield zero unless more callouts than the fail count, or the callout data is not zero. *) function pcre_callout; begin end; {$ENDIF} {$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL} // Always include the newest version of the library {$IFDEF PCRE_7_7} {$L pcre77.lib} {$ELSE} {$IFDEF PCRE_7_0} {$L pcre70.lib} {$ELSE} {$IFDEF PCRE_5_0} {$L pcre50.lib} {$ELSE} {$IFDEF PCRE_3_7} {$L pcre37.lib} {$ENDIF PCRE_3_7} {$ENDIF PCRE_5_0} {$ENDIF PCRE_7_0} {$ENDIF PCRE_7_7} {TpcRegExp} constructor TpcRegExp.Init(const ARegExp:shortstring; AOptions:integer; ALocale : Pointer); var pRegExp : PChar; begin RegExp:=ARegExp; RegExpC:=nil; RegExpExt:=nil; Matches:=nil; MatchesCount:=0; Error:=true; ErrorMsg:=nil; ErrorPos:=0; RunTimeOptions := 0; if length(RegExp) < 255 then begin RegExp[length(RegExp)+1]:=#0; pRegExp:=@RegExp[1]; end else begin GetMem(pRegExp,length(RegExp)+1); pRegExp:=strpcopy(pRegExp,RegExp); end; RegExpC := pcre_compile( pRegExp, AOptions and PCRE_COMPILE_ALLOWED_OPTIONS, ErrorMsg, ErrorPos, ALocale); if length(RegExp) = 255 then StrDispose(pRegExp); if RegExpC = nil then exit; ErrorMsg:=nil; RegExpExt := pcre_study( RegExpC, 0, ErrorMsg ); if (RegExpExt = nil) and (ErrorMsg <> nil) then begin pcre_free(RegExpC); exit; end; GetMem(Matches,SizeOf(TMatchArray)); Error:=false; end; destructor TpcRegExp.Done; begin if RegExpC <> nil then pcre_free(RegExpC); if RegExpExt <> nil then pcre_free(RegExpExt); if Matches <> nil then FreeMem(Matches,SizeOf(TMatchArray)); end; function TpcRegExp.SearchNext( AStr: Pchar; ALen : longint ) : boolean; var Options: Integer; begin // must handle PCRE_ERROR_PARTIAL here Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and PCRE_EXEC_ALLOWED_OPTIONS; if MatchesCount > 0 then MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, PMatchArray(Matches)^[1], Options, Matches, MAX_MATCHES ) else MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, 0, Options, Matches, MAX_MATCHES ); { if MatchesCount = 0 then MatchesCount := MatchesCount div 3;} PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL; SearchNext := MatchesCount > 0; end; function TpcRegExp.Search( AStr: Pchar; ALen : longint):boolean; begin MatchesCount:=0; Search:=SearchNext(AStr,ALen); SourceLen:=ALen; end; function TpcRegExp.SearchOfs( AStr: Pchar; ALen, AOfs: longint ) : boolean; var Options: Integer; begin MatchesCount:=0; Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and PCRE_EXEC_ALLOWED_OPTIONS; MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, AOfs, Options, Matches, MAX_MATCHES ); PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL; SearchOfs := MatchesCount > 0; SourceLen := ALen-AOfs; end; function TpcRegExp.MatchSub(ANom:integer; var Pos,Len:longint):boolean; begin if (MatchesCount > 0) and (ANom <= (MatchesCount-1)) then begin ANom:=ANom*2; Pos:=PMatchArray(Matches)^[ANom]; Len:=PMatchArray(Matches)^[ANom+1]-Pos; MatchSub:=true; end else MatchSub:=false; end; function TpcRegExp.MatchFull(var Pos,Len:longint):boolean; begin MatchFull:=MatchSub(0,Pos,Len); end; function TpcRegExp.GetSubStr(ANom: integer; AStr: Pchar):string; var s: ansistring; pos,len: longint; begin s:=''; if MatchSub(ANom, pos, len) then begin setlength(s, len); Move(AStr[pos], s[1], len); end; GetSubStr:=s; end; function TpcRegExp.GetPreSubStr(AStr: Pchar):string; var s: ansistring; l: longint; begin s:=''; if (MatchesCount > 0) then begin l:=PMatchArray(Matches)^[0]-1; if l > 0 then begin setlength(s,l); Move(AStr[1],s[1],l); end; end; GetPreSubStr:=s; end; function TpcRegExp.GetPostSubStr(AStr: Pchar):string; var s: ansistring; l: longint; ANom: integer; begin s:=''; if (MatchesCount > 0) then begin ANom:=(MatchesCount-1){*2} shl 1; l:=SourceLen-PMatchArray(Matches)^[ANom+1]+1; if l > 0 then begin setlength(s,l); Move(AStr[PMatchArray(Matches)^[ANom+1]],s[1],l); end; end; GetPostSubStr:=s; end; function TpcRegExp.GetFullStr(AStr: Pchar):string; var s: ansistring; l: longint; begin GetFullStr:=GetSubStr(0,AStr); end; function TpcRegExp.GetReplStr(AStr: Pchar; const ARepl: string):string; var s: ansistring; l,i,lasti: longint; begin l:=length(ARepl); i:=1; lasti:=1; s:=''; while i <= l do begin case ARepl[i] of '\' : begin if i < l then begin s:=s+copy(ARepl,lasti,i-lasti){+ARepl[i+1]}; {AH 17-10-05 support for POSIX \1-\9 backreferences} case ARepl[i+1] of '0' : s:=s+GetFullStr(AStr); '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr); else s:=s+ARepl[i+1]; // copy the escaped character end; end; inc(i); lasti:=i+1; end; '$' : begin if i < l then begin s:=s+copy(ARepl,lasti,i-lasti); case ARepl[i+1] of '&' : s:=s+GetFullStr(AStr); '1'..'9' : s:=s+GetSubStr(ord(ARepl[i+1])-ord('0'),AStr); '`' : s:=s+GetPreSubStr(AStr); #39 : s:=s+GetPostSubStr(AStr); end; end; inc(i); lasti:=i+1; end; end; inc(i); end; if lasti <= {AH 25-10-2004 added =, else l==1 won't work} l then s:=s+copy(ARepl,lasti,l-lasti+1); GetReplStr:=s; end; function TpcRegExp.ErrorStr:string; begin ErrorStr:=StrPas(ErrorMsg); end; {TRegExpCollection} constructor TRegExpCollection.Init(AMaxRegExp: integer); begin Inherited Init(1,1); MaxRegExp:=AMaxRegExp; CompareModeInsert:=true; end; procedure TRegExpCollection.FreeItem(P: Pointer); begin if P <> nil then begin Dispose(PpcRegExp(P),Done); end; end; function TRegExpCollection.Compare(P1, P2: Pointer): Integer; //var // l,l1,l2,i : byte; //// wPos: pchar; begin if CompareModeInsert then begin // l1:=length(PpcRegExp(P1)^.RegExp); // l2:=length(PpcRegExp(P2)^.RegExp); // if l1 > l2 then l:=l2 else // l:=l1; // for i:=1 to l do // if PpcRegExp(P1).RegExp[i] <> PpcRegExp(P2).RegExp[i] then break; // if i <=l then // Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(PpcRegExp(P2).RegExp[i]) else // Compare:=l1-l2; Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, PpcRegExp(P2).RegExp, False); end else begin // l1:=length(PpcRegExp(P1)^.RegExp); // l2:=length(SearchRegExp); // if l1 > l2 then l:=l2 else // l:=l1; // for i:=1 to l do // if PpcRegExp(P1).RegExp[i] <> SearchRegExp[i] then // begin // Compare:=ord(PpcRegExp(P1).RegExp[i])-ord(SearchRegExp[i]); // break; // end; // if i > l then Compare:=l1-l2; Compare := stringsx.PasStrCmp(PpcRegExp(P1).RegExp, SearchRegExp, False); end; end; function TRegExpCollection.Find(ARegExp:shortstring;var P: PpcRegExp):boolean; var I : integer; begin CompareModeInsert:=false; SearchRegExp:=ARegExp; if Search(nil,I) then begin P:=PpcRegExp(At(I)); Find:=true; end else begin P:=nil; Find:=false; end; CompareModeInsert:=true; end; function TRegExpCollection.CheckNew(ARegExp:shortstring):PpcRegExp; var P : PpcRegExp; begin if not Find(ARegExp,P) then begin if Count = MaxRegExp then AtFree(0); P:=New(ppcRegExp,Init(ARegExp,PCRE_CASELESS,nil)); Insert(P); end; CheckNew:=P; end; function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean; var PpcRE:PpcRegExp; begin PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale)); pcGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr)); Dispose(PpcRE,Done); end; function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string; var PpcRE:PpcRegExp; begin PpcRE:=New(ppcRegExp,Init(WildCard,AOptions,Alocale)); if PpcRE^.Search(pchar(AStr),Length(AStr)) then pcGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl) else pcGrepSub:=''; Dispose(PpcRE,Done); end; function pcFastGrepMatch(WildCard, aStr: string): Boolean; var PpcRE:PpcRegExp; begin PpcRE:=PRegExpCache^.CheckNew(WildCard); pcFastGrepMatch:=PpcRE^.Search(pchar(AStr),Length(AStr)); end; function pcFastGrepSub(WildCard, aStr, aRepl: string): string; var PpcRE:PpcRegExp; begin PpcRE:=PRegExpCache^.CheckNew(WildCard); if PpcRE^.Search(pchar(AStr),Length(AStr)) then pcFastGrepSub:=PpcRE^.GetReplStr(pchar(AStr),ARepl) else pcFastGrepSub:=''; end; {$IFDEF PCRE_5_0} function pcGetVersion : pchar; assembler; {$FRAME-}{$USES none} asm call pcre_version end; {$ENDIF PCRE_5_0} function pcError; var P: ppcRegExp absolute pRegExp; begin Result := (P = nil) or P^.Error; If Result and (P <> nil) then begin { if P^.ErrorPos = 0 then MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"', nil,mfConfirmation+mfOkButton) else} MessageBox(GetString(erRegExpCompile)+'"'+P^.ErrorStr+'"'+GetString(erRegExpCompPos), @P^.ErrorPos,mfConfirmation+mfOkButton); Dispose(P, Done); P:=nil; end; end; function pcInit; var Options : Integer; begin If CaseSens then Options := 0 else Options := PCRE_CASELESS; Result := New( PpcRegExp, Init( Pattern, {DefaultOptions} startup.MiscMultiData.cfgRegEx.DefaultOptions or Options, DefaultLocaleTable) ); end; Initialization PRegExpCache:=New(PRegExpCollection,Init(64)); Finalization Dispose(PRegExpCache,Done); End.