846 lines
26 KiB
ObjectPascal
846 lines
26 KiB
ObjectPascal
{
|
|
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 may be distributed under the terms of the modified BSD license
|
|
Copyright (c) 2001, Alexander Tokarev
|
|
All rights reserved.
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions are met:
|
|
|
|
* Redistributions of source code must retain the above copyright notice,
|
|
this list of conditions and the following disclaimer.
|
|
* Redistributions in binary form must reproduce the above copyright notice,
|
|
this list of conditions and the following disclaimer in the documentation
|
|
and/or other materials provided with the distribution.
|
|
* Neither the name of the <ORGANIZATION> nor the names of its contributors
|
|
may be used to endorse or promote products derived from this software without
|
|
specific prior written permission.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
|
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
|
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
|
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
|
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
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.
|