retronetworking
/
freeswitch
13
0
Fork 0
Code Pull Requests Releases Activity
freeswitch/libs/pcre/pcregexp.pas

821 lines
24 KiB
ObjectPascal
Raw Blame History

{
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.
View Git Blame Copy Permalink