659 lines
21 KiB
ObjectPascal
659 lines
21 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclPCRE.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Peter Thornqvist. }
|
|
{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Robert Rossmair (rrossmair) }
|
|
{ Mario R. Carro }
|
|
{ Florent Ouchet (outchy) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Class wrapper for PCRE (PERL Compatible Regular Expression) }
|
|
{ }
|
|
{ Unit owner: Peter Th?nqvist }
|
|
{ Last modified: $Date: 2007-05-25 13:08:11 +0200 (ven., 25 mai 2007) $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclPCRE;
|
|
|
|
{$I jcl.inc}
|
|
|
|
{$RANGECHECKS OFF}
|
|
|
|
interface
|
|
|
|
uses
|
|
pcre,
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF HAS_UNIT_LIBC}
|
|
Libc,
|
|
{$ENDIF HAS_UNIT_LIBC}
|
|
Classes, SysUtils, JclBase;
|
|
|
|
const
|
|
JCL_PCRE_CALLOUT_NOERROR = 0;
|
|
JCL_PCRE_CALLOUT_FAILCONTINUE = 1;
|
|
|
|
JCL_PCRE_ERROR_CALLOUTERROR = -998;
|
|
JCL_PCRE_ERROR_STUDYFAILED = -999;
|
|
|
|
type
|
|
TJclAnsiRegEx = class;
|
|
|
|
EPCREError = class(EJclError)
|
|
private
|
|
FErrorCode: Integer;
|
|
public
|
|
constructor CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer);
|
|
property ErrorCode: Integer read FErrorCode;
|
|
end;
|
|
|
|
TPCREIntArray = array [0 .. 0] of Integer;
|
|
PPCREIntArray = ^TPCREIntArray;
|
|
|
|
TJclAnsiRegExOption = (roIgnoreCase, roMultiLine, roDotAll, roExtended,
|
|
roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy,
|
|
roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout,
|
|
roPartial, roDfaShortest, roDfaRestart, roDfaFirstLine, roDupNames,
|
|
roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny);
|
|
TJclAnsiRegExOptions = set of TJclAnsiRegExOption;
|
|
TJclAnsiCaptureRange = record
|
|
FirstPos: Integer;
|
|
LastPos: Integer;
|
|
end;
|
|
|
|
TJclAnsiRegExCallout = procedure (Sender: TJclAnsiRegEx;
|
|
Index, MatchStart, SubjectPos, LastCapture, PatternPos, NextItemLength: Integer;
|
|
var ErrorCode: Integer) of object;
|
|
TPCRECalloutIndex = 0 .. 255;
|
|
|
|
TJclAnsiRegEx = class(TObject)
|
|
private
|
|
FCode: PPCRE;
|
|
FExtra: PPCREExtra;
|
|
FOptions: TJclAnsiRegExOptions;
|
|
FPattern: AnsiString;
|
|
FDfaMode: Boolean;
|
|
FSubject: AnsiString;
|
|
|
|
FViewChanges: Boolean;
|
|
FChangedCaptures: TList;
|
|
FResultValues: array of String;
|
|
|
|
FErrorCode: Integer;
|
|
FErrorMessage: AnsiString;
|
|
FErrorOffset: Integer;
|
|
|
|
FVector: PPCREIntArray;
|
|
FVectorSize: Integer;
|
|
FCaptureCount: Integer;
|
|
|
|
FOnCallout: TJclAnsiRegExCallout;
|
|
|
|
function GetResult: AnsiString;
|
|
function GetCapture(Index: Integer): AnsiString;
|
|
procedure SetCapture(Index: Integer; const Value: AnsiString);
|
|
function GetCaptureRange(Index: Integer): TJclAnsiCaptureRange;
|
|
function GetNamedCapture(const Name: AnsiString): AnsiString;
|
|
procedure SetNamedCapture(const Name, Value: Ansistring);
|
|
function GetCaptureNameCount: Integer;
|
|
function GetCaptureName(Index: Integer): String;
|
|
function GetAPIOptions(RunTime: Boolean): Integer;
|
|
function CalloutHandler(var CalloutBlock: pcre_callout_block): Integer;
|
|
|
|
public
|
|
destructor Destroy; override;
|
|
|
|
property Options: TJclAnsiRegExOptions read FOptions write FOptions;
|
|
function Compile(const Pattern: AnsiString; Study: Boolean;
|
|
UserLocale: Boolean = False): Boolean;
|
|
property Pattern: AnsiString read FPattern;
|
|
property DfaMode: Boolean read FDfaMode write FDfaMode;
|
|
function Match(const Subject: AnsiString; StartOffset: Cardinal = 1): Boolean;
|
|
property Subject: AnsiString read FSubject;
|
|
property Result: AnsiString read GetResult;
|
|
|
|
property ViewChanges: Boolean read FViewChanges write FViewChanges;
|
|
property CaptureCount: Integer read FCaptureCount write FCaptureCount;
|
|
property Captures[Index: Integer]: AnsiString read GetCapture write SetCapture;
|
|
property CaptureRanges[Index: Integer]: TJclAnsiCaptureRange read GetCaptureRange;
|
|
|
|
property NamedCaptures[const Name: AnsiString]: AnsiString
|
|
read GetNamedCapture write SetNamedCapture;
|
|
property CaptureNameCount: Integer read GetCaptureNameCount;
|
|
property CaptureNames[Index: Integer]: AnsiString read GetCaptureName;
|
|
function IndexOfName(const Name: String): Integer;
|
|
function IsNameValid(const Name: String): Boolean;
|
|
|
|
property ErrorCode: Integer read FErrorCode;
|
|
property ErrorMessage: AnsiString read FErrorMessage;
|
|
property ErrorOffset: Integer read FErrorOffset;
|
|
|
|
property oncallout: TJclAnsiRegExCallout
|
|
read FOnCallout write FOnCallout;
|
|
end;
|
|
|
|
procedure InitializeLocaleSupport;
|
|
procedure TerminateLocaleSupport;
|
|
|
|
// Args is an array of pairs (CaptureIndex, Value) or (CaptureName, Value).
|
|
// For example: NewIp := StrReplaceRegEx(DirIP, '(\d+)\.(\d+)\.(\d+)\.(\d+)', [3, '128', 4, '254']);
|
|
function StrReplaceRegEx(const Subject, Pattern: AnsiString; Args: array of const): AnsiString;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net:443/svnroot/jcl/tags/JCL-1.100-Build2646/jcl/source/common/JclPCRE.pas $';
|
|
Revision: '$Revision: 2015 $';
|
|
Date: '$Date: 2007-05-25 13:08:11 +0200 (ven., 25 mai 2007) $';
|
|
LogPath: 'JCL\source\common'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysConst,
|
|
JclResources;
|
|
|
|
var
|
|
GTables: PChar;
|
|
|
|
function JclPCREGetMem(Size: Integer): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
|
|
begin
|
|
GetMem(Result, Size);
|
|
end;
|
|
|
|
procedure JclPCREFreeMem(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
|
|
begin
|
|
FreeMem(P);
|
|
end;
|
|
|
|
function JclPCRECallout(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
|
|
begin
|
|
Result := TJclAnsiRegEx(callout_block.callout_data).CalloutHandler(callout_block);
|
|
end;
|
|
|
|
function PCRECheck(Value: Integer): Boolean;
|
|
var
|
|
PErr: PResStringRec;
|
|
begin
|
|
Result := Value >= 0;
|
|
if Result then Exit;
|
|
|
|
case Value of
|
|
PCRE_ERROR_NOMATCH:
|
|
PErr := @RsErrNoMatch;
|
|
PCRE_ERROR_NULL:
|
|
PErr := @RsErrNull;
|
|
PCRE_ERROR_BADOPTION:
|
|
PErr := @RsErrBadOption;
|
|
PCRE_ERROR_BADMAGIC:
|
|
PErr := @RsErrBadMagic;
|
|
PCRE_ERROR_UNKNOWN_NODE:
|
|
PErr := @RsErrUnknownNode;
|
|
PCRE_ERROR_NOMEMORY:
|
|
PErr := @RsErrNoMemory;
|
|
PCRE_ERROR_NOSUBSTRING:
|
|
PErr := @RsErrNoSubString;
|
|
PCRE_ERROR_MATCHLIMIT:
|
|
PErr := @RsErrMatchLimit;
|
|
PCRE_ERROR_CALLOUT:
|
|
PErr := @RsErrCallout;
|
|
PCRE_ERROR_BADUTF8:
|
|
PErr := @RsErrBadUTF8;
|
|
PCRE_ERROR_BADUTF8_OFFSET:
|
|
PErr := @RsErrBadUTF8Offset;
|
|
PCRE_ERROR_PARTIAL:
|
|
PErr := @RsErrPartial;
|
|
PCRE_ERROR_BADPARTIAL:
|
|
PErr := @RsErrBadPartial;
|
|
PCRE_ERROR_INTERNAL:
|
|
PErr := @RsErrInternal;
|
|
PCRE_ERROR_BADCOUNT:
|
|
PErr := @RsErrBadCount;
|
|
PCRE_ERROR_DFA_UITEM:
|
|
PErr := @RsErrDfaUItem;
|
|
PCRE_ERROR_DFA_UCOND:
|
|
PErr := @RsErrDfaUCond;
|
|
PCRE_ERROR_DFA_UMLIMIT:
|
|
PErr := @RsErrDfaUMLimit;
|
|
PCRE_ERROR_DFA_WSSIZE:
|
|
PErr := @RsErrDfaWSSize;
|
|
PCRE_ERROR_DFA_RECURSE:
|
|
PErr := @RsErrDfaRecurse;
|
|
PCRE_ERROR_RECURSIONLIMIT:
|
|
PErr := @RsErrRecursionLimit;
|
|
JCL_PCRE_ERROR_STUDYFAILED:
|
|
PErr := @RsErrStudyFailed;
|
|
JCL_PCRE_ERROR_CALLOUTERROR:
|
|
PErr := @RsErrCalloutError;
|
|
else
|
|
PErr := @RsErrUnknownError;
|
|
end;
|
|
|
|
raise EPCREError.CreateRes(PErr, Value);
|
|
end;
|
|
|
|
//=== { TJclAnsiRegEx } ======================================================
|
|
|
|
destructor TJclAnsiRegEx.Destroy;
|
|
begin
|
|
if Assigned(FCode) then
|
|
CallPCREFree(FCode);
|
|
if Assigned(FExtra) then
|
|
CallPCREFree(FExtra);
|
|
if Assigned(FVector) then
|
|
FreeMem(FVector);
|
|
if Assigned(FChangedCaptures) then
|
|
FChangedCaptures.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.Compile(const Pattern: AnsiString; Study: Boolean;
|
|
UserLocale: Boolean = False): Boolean;
|
|
var
|
|
ErrMsgPtr: PChar;
|
|
Tables: PChar;
|
|
begin
|
|
if UserLocale then
|
|
begin
|
|
InitializeLocaleSupport;
|
|
Tables := GTables;
|
|
end
|
|
else
|
|
Tables := nil;
|
|
|
|
FPattern := Pattern;
|
|
if FPattern = '' then
|
|
raise EPCREError.CreateRes(@RsErrNull, PCRE_ERROR_NULL);
|
|
|
|
if Assigned(FCode) then CallPCREFree(FCode);
|
|
FCode := pcre_compile2(PChar(FPattern), GetAPIOptions(False),
|
|
@FErrorCode, @ErrMsgPtr, @FErrorOffset, Tables);
|
|
Inc(FErrorOffset);
|
|
FErrorMessage := ErrMsgPtr;
|
|
Result := Assigned(FCode);
|
|
if Result then
|
|
begin
|
|
if Study then
|
|
begin
|
|
if Assigned(FExtra) then CallPCREFree(FExtra);
|
|
FExtra := pcre_study(FCode, 0, @ErrMsgPtr);
|
|
Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr));
|
|
if not Result then
|
|
begin
|
|
FErrorCode := JCL_PCRE_ERROR_STUDYFAILED;
|
|
FErrorMessage := ErrMsgPtr;
|
|
end;
|
|
end;
|
|
|
|
if FDfaMode then
|
|
FVectorSize := FCaptureCount
|
|
else
|
|
begin
|
|
PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @FCaptureCount));
|
|
FVectorSize := (FCaptureCount + 1) * 3;
|
|
end;
|
|
ReAllocMem(FVector, FVectorSize * SizeOf(Integer));
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetAPIOptions(RunTime: Boolean): Integer;
|
|
const
|
|
{ roIgnoreCase, roMultiLine, roDotAll, roExtended,
|
|
roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy,
|
|
roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout,
|
|
roPartial, roDfaShortest, roDfaRestart, roDfaFirstLine, roDupNames,
|
|
roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny }
|
|
cDesignOptions: array [TJclAnsiRegExOption] of Integer =
|
|
(PCRE_CASELESS, PCRE_MULTILINE, PCRE_DOTALL, PCRE_EXTENDED, PCRE_ANCHORED,
|
|
PCRE_DOLLAR_ENDONLY, PCRE_EXTRA, 0, 0, PCRE_UNGREEDY, 0, PCRE_UTF8,
|
|
PCRE_NO_AUTO_CAPTURE, PCRE_NO_UTF8_CHECK, PCRE_AUTO_CALLOUT, 0, 0, 0, 0,
|
|
PCRE_DUPNAMES, PCRE_NEWLINE_CR, PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF,
|
|
PCRE_NEWLINE_ANY);
|
|
cRunOptions: array [TJclAnsiRegExOption] of Integer =
|
|
(0, 0, 0, 0, 0, 0, 0, PCRE_NOTBOL, PCRE_NOTEOL, 0, PCRE_NOTEMPTY, 0, 0,
|
|
PCRE_NO_UTF8_CHECK, 0, PCRE_PARTIAL, 0, 0, 0, 0, PCRE_NEWLINE_CR,
|
|
PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF, PCRE_NEWLINE_ANY);
|
|
var
|
|
I: TJclAnsiRegExOption;
|
|
begin
|
|
Result := 0;
|
|
if RunTime then
|
|
begin
|
|
for I := Low(TJclAnsiRegExOption) to High(TJclAnsiRegExOption) do
|
|
if I in Options then
|
|
Result := Result or cRunOptions[I];
|
|
end
|
|
else
|
|
begin
|
|
for I := Low(TJclAnsiRegExOption) to High(TJclAnsiRegExOption) do
|
|
if I in Options then
|
|
Result := Result or cDesignOptions[I];
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetResult: AnsiString;
|
|
var
|
|
Index, CaptureIndex, Pos: Integer;
|
|
Range: TJclAnsiCaptureRange;
|
|
begin
|
|
if Assigned(FChangedCaptures) and (FChangedCaptures.Count > 0) then
|
|
begin
|
|
Pos := 1;
|
|
Result := '';
|
|
for Index := 0 to FChangedCaptures.Count - 1 do
|
|
begin
|
|
CaptureIndex := Integer(FChangedCaptures[Index]);
|
|
Range := GetCaptureRange(CaptureIndex);
|
|
|
|
Result := Result +
|
|
Copy(FSubject, Pos, Range.FirstPos - Pos) +
|
|
FResultValues[CaptureIndex];
|
|
|
|
Pos := Range.LastPos + 1;
|
|
end;
|
|
if Pos <= Length(FSubject) then
|
|
Result := Result + Copy(FSubject, Pos, Length(FSubject) - Pos + 1);
|
|
end
|
|
else
|
|
Result := FSubject;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetCapture(Index: Integer): AnsiString;
|
|
var
|
|
From, Len: Integer;
|
|
begin
|
|
if (Index < 0) or (Index >= FCaptureCount) then
|
|
PCRECheck(PCRE_ERROR_NOSUBSTRING)
|
|
else
|
|
begin
|
|
if FViewChanges and (FChangedCaptures.IndexOf(Pointer(Index)) >= 0) then
|
|
begin
|
|
Result := FResultValues[Index];
|
|
Exit;
|
|
end;
|
|
|
|
Index := Index * 2;
|
|
From := FVector^[Index];
|
|
Len := FVector^[Index + 1] - From;
|
|
SetLength(Result, Len);
|
|
Move(FSubject[From + 1], PChar(Result)^, Len);
|
|
end;
|
|
end;
|
|
|
|
procedure TJclAnsiRegEx.SetCapture(Index: Integer; const Value: String);
|
|
begin
|
|
if (Index < 0) or (Index >= FCaptureCount) then
|
|
PCRECheck(PCRE_ERROR_NOSUBSTRING)
|
|
else
|
|
begin
|
|
if (not Assigned(FChangedCaptures)) or (FChangedCaptures.Count = 0) then
|
|
begin
|
|
if not Assigned(FChangedCaptures) then
|
|
FChangedCaptures := TList.Create;
|
|
|
|
// Always resize to the max length to avoid repeated allocations.
|
|
FChangedCaptures.Capacity := FCaptureCount;
|
|
SetLength(FResultValues, FCaptureCount);
|
|
end;
|
|
|
|
if FChangedCaptures.IndexOf(Pointer(Index)) < 0 then
|
|
FChangedCaptures.Add(Pointer(Index));
|
|
FResultValues[Index] := Value;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetCaptureRange(Index: Integer): TJclAnsiCaptureRange;
|
|
begin
|
|
if (Index < 0) or (Index >= FCaptureCount) then
|
|
PCRECheck(PCRE_ERROR_NOSUBSTRING)
|
|
else
|
|
begin
|
|
Index := Index * 2;
|
|
Result.FirstPos := FVector^[Index] + 1;
|
|
Result.LastPos := FVector^[Index + 1];
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetNamedCapture(const Name: AnsiString): AnsiString;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := pcre_get_stringnumber(FCode, PChar(Name));
|
|
PCRECheck(Index);
|
|
|
|
Result := GetCapture(Index);
|
|
end;
|
|
|
|
procedure TJclAnsiRegEx.SetNamedCapture(const Name, Value: String);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := pcre_get_stringnumber(FCode, PChar(Name));
|
|
PCRECheck(Index);
|
|
|
|
SetCapture(Index, Value);
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetCaptureNameCount: Integer;
|
|
begin
|
|
PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMECOUNT, @Result));
|
|
end;
|
|
|
|
function TJclAnsiRegEx.GetCaptureName(Index: Integer): String;
|
|
var
|
|
NameTable: PChar;
|
|
EntrySize: Integer;
|
|
begin
|
|
PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMETABLE, @NameTable));
|
|
PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMEENTRYSIZE, @EntrySize));
|
|
|
|
Result := NameTable + EntrySize * Index + 2;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.CalloutHandler(var CalloutBlock: pcre_callout_block): Integer;
|
|
begin
|
|
try
|
|
Result := JCL_PCRE_CALLOUT_NOERROR;
|
|
if Assigned(FOnCallout) then
|
|
begin
|
|
with CalloutBlock do
|
|
begin
|
|
FCaptureCount := capture_top;
|
|
FOnCallout(Self, callout_number, start_match + 1, current_position + 1,
|
|
capture_last, pattern_position + 1, next_item_length, Result);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FErrorMessage := E.Message;
|
|
Result := JCL_PCRE_ERROR_CALLOUTERROR;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.Match(const Subject: AnsiString; StartOffset: Cardinal = 1): Boolean;
|
|
var
|
|
LocalExtra: real_pcre_extra;
|
|
Extra: Pointer;
|
|
WorkSpace: array [0 .. 19] of Integer;
|
|
ExecRslt: Integer;
|
|
begin
|
|
if Assigned(FOnCallout) then
|
|
begin
|
|
if Assigned(FExtra) then
|
|
begin
|
|
LocalExtra.flags := PCRE_EXTRA_STUDY_DATA or PCRE_EXTRA_CALLOUT_DATA;
|
|
LocalExtra.study_data := FExtra;
|
|
end
|
|
else
|
|
LocalExtra.flags := PCRE_EXTRA_CALLOUT_DATA;
|
|
LocalExtra.callout_data := Self;
|
|
Extra := @LocalExtra;
|
|
SetPCRECalloutCallback(JclPCRECallout);
|
|
end
|
|
else
|
|
begin
|
|
Extra := FExtra;
|
|
SetPCRECalloutCallback(nil);
|
|
end;
|
|
|
|
FSubject := Subject;
|
|
if Assigned(FChangedCaptures) then
|
|
FChangedCaptures.Clear;
|
|
if FDfaMode then
|
|
begin
|
|
ExecRslt := pcre_dfa_exec(FCode, Extra, PChar(FSubject), Length(FSubject),
|
|
StartOffset - 1, GetAPIOptions(True), pcre.PInteger(FVector), FVectorSize, @Workspace, 20);
|
|
end
|
|
else
|
|
begin
|
|
ExecRslt := pcre_exec(FCode, Extra, PChar(FSubject), Length(FSubject),
|
|
StartOffset - 1, GetAPIOptions(True), pcre.PInteger(FVector), FVectorSize);
|
|
end;
|
|
Result := ExecRslt >= 0;
|
|
if Result then
|
|
begin
|
|
FCaptureCount := ExecRslt;
|
|
FErrorCode := 0;
|
|
end
|
|
else
|
|
begin
|
|
FErrorCode := ExecRslt;
|
|
if FErrorCode <> PCRE_ERROR_NOMATCH then
|
|
PCRECheck(FErrorCode);
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiRegEx.IndexOfName(const Name: String): Integer;
|
|
begin
|
|
Result := pcre_get_stringnumber(FCode, PChar(Name));
|
|
end;
|
|
|
|
function TJclAnsiRegEx.IsNameValid(const Name: String): Boolean;
|
|
begin
|
|
Result := pcre_get_stringnumber(FCode, PChar(Name)) >= 0;
|
|
end;
|
|
|
|
procedure InitializeLocaleSupport;
|
|
begin
|
|
if not Assigned(GTables) then
|
|
GTables := pcre_maketables;
|
|
end;
|
|
|
|
procedure TerminateLocaleSupport;
|
|
begin
|
|
if Assigned(GTables) then
|
|
begin
|
|
CallPCREFree(GTables);
|
|
GTables := nil;
|
|
end;
|
|
end;
|
|
|
|
// TODO: Better/specific error messages, show index when available.
|
|
function StrReplaceRegEx(const Subject, Pattern: AnsiString; Args: array of const): AnsiString;
|
|
|
|
function ArgToString(Index: Integer): AnsiString;
|
|
begin
|
|
// TODO: Any other type?
|
|
case TVarRec(Args[Index]).VType of
|
|
vtString: Result := TVarRec(Args[Index]).VString^;
|
|
vtPChar: Result := TVarRec(Args[Index]).VPChar;
|
|
vtAnsiString: Result := AnsiString(TVarRec(Args[Index]).VAnsiString);
|
|
else
|
|
raise EConvertError.Create(SInvalidFormat);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Re: TJclAnsiRegEx;
|
|
Index, ArgIndex: Integer;
|
|
Value: AnsiString;
|
|
begin
|
|
if Odd(Length(Args)) then
|
|
raise EConvertError.Create(SArgumentMissing)
|
|
else
|
|
begin
|
|
Re := TJclAnsiRegEx.Create;
|
|
try
|
|
if Re.Compile(Pattern, False) and Re.Match(Subject) then
|
|
begin
|
|
for Index := 0 to Length(Args) div 2 - 1 do
|
|
begin
|
|
ArgIndex := Index * 2;
|
|
Value := ArgToString(ArgIndex + 1);
|
|
|
|
if TVarRec(Args[ArgIndex]).VType = vtInteger then
|
|
Re.Captures[TVarRec(Args[ArgIndex]).VInteger] := Value
|
|
else
|
|
Re.NamedCaptures[ArgToString(ArgIndex)] := Value;
|
|
end;
|
|
|
|
Result := Re.Result;
|
|
end
|
|
else
|
|
raise EConvertError.Create(SInvalidFormat);
|
|
finally
|
|
Re.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//=== { EPCREError } =========================================================
|
|
|
|
constructor EPCREError.CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer);
|
|
begin
|
|
FErrorCode := ErrorCode;
|
|
inherited CreateRes(ResStringRec);
|
|
end;
|
|
|
|
procedure LibNotLoadedHandler; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
|
|
begin
|
|
raise EPCREError.CreateRes(@RsErrLibNotLoaded, 0);
|
|
end;
|
|
|
|
initialization
|
|
pcre.LibNotLoadedHandler := LibNotLoadedHandler;
|
|
if LoadPCRE then
|
|
begin
|
|
SetPCREMallocCallback(JclPCREGetMem);
|
|
SetPCREFreeCallback(JclPCREFreeMem);
|
|
end;
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
finalization
|
|
TerminateLocaleSupport;
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
UnloadPCRE;
|
|
|
|
end.
|
|
|