8037f9f23a
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
295 lines
10 KiB
ObjectPascal
295 lines
10 KiB
ObjectPascal
{*********************************************************}
|
|
{* O32RXVLD.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* 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 TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit o32rxvld;
|
|
{Unit for the Orpheus RegEx Validator}
|
|
|
|
interface
|
|
|
|
uses Classes, O32Vldtr, O32RxNgn, SysUtils;
|
|
|
|
const
|
|
RXMaskCount = 13;
|
|
RXMaskLength = 80;
|
|
|
|
{Sample Regular Expressions for the Regex validator Property editor...}
|
|
RXMaskLookup : array [1..RXMaskCount] of string =
|
|
('.+ 1 or more of any characters allowed. Minimum of 1 character required. Note: This is the default behavior. No expression is needed.',
|
|
'.* Any number of any character allowed. Note: Although This expression allows an empty string, The RegexEngine will fail an empty string.',
|
|
'(1[012]|[1-9]):[0-5][0-9] (am|pm) Time of day: Standard AM/PM time display (9:17 am) or (12:30 pm)',
|
|
'(1[012]|[1-9]):[0-5][0-9]:[0-5][0-9] (am|pm) Time of day: Standard AM/PM time diplay with seconds. (9:17:22 am)',
|
|
'(([01]?[0-9])|(2[0-3])):[0-5][0-9] Time of day: 24 hour clock (15:22).',
|
|
'(([01]?[0-9])|(2[0-3])):[0-5][0-9]:[0-5][0-9] Time of day: 24 hour clock with seconds (15:22:07).',
|
|
'(\(?[1-9][0-9][0-9]\)? )?[1-9][0-9][0-9]\-[0-9][0-9][0-9][0-9] Telephone Number: Optional area-code with optional parenthesis',
|
|
'(0?[1-9]|1[012])(\\|/|\-)([012]?[1-9]|[123]0|31)(\\|/|\-)([123][0-9])?[0-9][0-9] Date: (mm\dd\yy) or (mm\dd\yyyy) formats. Also accepts / and - separators. Note: Only covers years from 1000-3999',
|
|
'(y(es)?)|(no?) Boolean: Y, y, N, n, Yes, yes, No or no',
|
|
'(t(rue)?)|(f(alse)?) Boolean: T, t, F, f, True, False, true or false',
|
|
'([0-9]|[A-F])+ Hexadecimal: Allows any number of characters in the range 0-9 and A-F',
|
|
'[0-7]+ Octal: Allows any number of characters in the range 0-7.',
|
|
'[01]+ Binary:Allows any number of binary characters (0 and 1).');
|
|
|
|
{Error Codes}
|
|
EC_NO_ERROR = 0;
|
|
EC_INVALID_EXPR = 1;
|
|
EC_INVALID_INPUT = 2;
|
|
EC_NO_MATCH = 3;
|
|
|
|
type
|
|
{class - TO32RegExValidator}
|
|
TO32RegExValidator = class(TO32BaseValidator)
|
|
protected {private}
|
|
FLogging : Boolean; {Log validator parsing?}
|
|
FLogFile : String; {Logging file name}
|
|
FRegexEngine : TO32RegExEngine; {Regex engine used by the validator}
|
|
FExprErrorPos : Integer; {Error position in the Regex string}
|
|
FExprErrorCode : TO32RegexError; {Regex string error code}
|
|
FIgnoreCase : Boolean; {Case sensitive matching}
|
|
procedure SetIgnoreCase(const Value: Boolean);
|
|
procedure SetLogging(const Value: Boolean);
|
|
procedure SetLogFile(const Value: String);
|
|
procedure SetMask(const Value: String); override;
|
|
function GetValid: Boolean; override;
|
|
function GetSampleMasks: TStringList; override;
|
|
procedure SetInput(const Value: string); override;
|
|
function CheckExpression(var ErrorPos: Integer): Boolean;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function IsValid: Boolean; override;
|
|
function GetExprError: String;
|
|
property Valid;
|
|
property ExprErrorPos: Integer read FExprErrorPos write FExprErrorPos;
|
|
published
|
|
property Input;
|
|
{ Surfaced the Mask property as "Expression" for the Regex validator
|
|
Left Mask exposed as public for automated use such as the ValidatorPool}
|
|
property Expression: string read FMask write SetMask stored true;
|
|
property Logging: Boolean read FLogging write SetLogging
|
|
default False;
|
|
property LogFile: String read FLogFile write SetLogFile;
|
|
property IgnoreCase: Boolean read FIgnoreCase write SetIgnoreCase stored true
|
|
default True;
|
|
{Events}
|
|
property BeforeValidation;
|
|
property AfterValidation;
|
|
property OnValidationError;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
O32VlReg;
|
|
|
|
{=== TO32RegExValidator ==============================================}
|
|
constructor TO32RegExValidator.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FLogging := false;
|
|
FLogFile := 'parse.log';
|
|
FIgnoreCase := true;
|
|
|
|
FRegexEngine := TO32RegExEngine.Create('');
|
|
FRegexEngine.Logging := FLogging;
|
|
FRegexEngine.LogFile := FLogFile;
|
|
FRegexEngine.IgnoreCase := FIgnoreCase;
|
|
end;
|
|
{=====}
|
|
|
|
destructor TO32RegExValidator.Destroy;
|
|
begin
|
|
FRegexEngine.Free;
|
|
inherited Destroy;
|
|
end;
|
|
{=====}
|
|
|
|
function TO32RegExValidator.GetSampleMasks: TStringList;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
{ Set the length of the mask portion of the string }
|
|
FSampleMaskLength := RXMaskLength;
|
|
|
|
FSampleMasks.Clear;
|
|
|
|
{ Load the string list }
|
|
for I := 1 to RXMaskCount do
|
|
FSampleMasks.Add(RXMaskLookup[I]);
|
|
result := FSampleMasks;
|
|
end;
|
|
{=====}
|
|
|
|
procedure TO32RegExValidator.SetMask(const Value: String);
|
|
var
|
|
OldExpression: String;
|
|
begin
|
|
OldExpression := FMask;
|
|
FMask := Value;
|
|
if not CheckExpression(FExprErrorPos) then
|
|
FMask := OldExpression;
|
|
end;
|
|
{=====}
|
|
|
|
procedure TO32RegExValidator.SetInput(const Value: string);
|
|
begin
|
|
if FInput <> Value then
|
|
FInput := Value;
|
|
end;
|
|
{=====}
|
|
|
|
function TO32RegExValidator.CheckExpression(var ErrorPos: Integer): Boolean;
|
|
begin
|
|
if (FMask <> '') then begin
|
|
FRegexEngine.RegexString := FMask;
|
|
if not FRegexEngine.Parse(FExprErrorPos, FExprErrorCode) then begin
|
|
result := false;
|
|
FErrorCode := EC_INVALID_EXPR;
|
|
DoOnError(self, GetExprError);
|
|
end else
|
|
result := true;
|
|
end else begin
|
|
{Allow the user to initialize the Validator with an empty string}
|
|
result := true;
|
|
ErrorPos := 0;
|
|
FExprErrorPos := 0;
|
|
FErrorCode := EC_NO_ERROR;
|
|
FExprErrorCode := recNone;
|
|
end;
|
|
end;
|
|
{=====}
|
|
|
|
function TO32RegExValidator.GetValid: Boolean;
|
|
begin
|
|
result := IsValid;
|
|
end;
|
|
{=====}
|
|
|
|
function TO32RegExValidator.IsValid: Boolean;
|
|
var
|
|
RegExStr: String;
|
|
begin
|
|
DoBeforeValidation;
|
|
|
|
{assume the worst}
|
|
FValid := false;
|
|
|
|
{Create a copy of the Expression and then enclose it in anchor operators so
|
|
that the RegexEngine only matches the whole string...}
|
|
RegExStr := FMask;
|
|
{Check for Anchor operator ^}
|
|
if (Pos('^', RegExStr) <> 1) then
|
|
Insert('^', RegExStr, 1);
|
|
{Check for Anchor operator $}
|
|
if (Pos('$', RegExStr) <> Length(RegExStr)) then
|
|
RegexStr := RegExStr + '$';
|
|
|
|
{Pass the RegexStr into the RegexEngine}
|
|
FRegexEngine.RegexString := RegExStr;
|
|
|
|
if (RegExStr = '') then begin
|
|
FErrorCode := EC_INVALID_EXPR;
|
|
FValid := false;
|
|
end else if (FInput = '') then begin
|
|
FErrorCode := EC_INVALID_INPUT;
|
|
FValid := false;
|
|
end else begin
|
|
if (FRegexEngine.MatchString(FInput) = 1) then begin
|
|
FValid := true;
|
|
FErrorCode := 0;
|
|
end else begin
|
|
FValid := false;
|
|
FErrorCode := EC_NO_MATCH;
|
|
end;
|
|
end;
|
|
|
|
result := FValid;
|
|
|
|
DoAfterValidation
|
|
end;
|
|
{=====}
|
|
|
|
procedure TO32RegExValidator.SetLogging(const Value: Boolean);
|
|
begin
|
|
if (FLogging <> Value) then begin
|
|
FLogging := Value;
|
|
FRegexEngine.Logging := FLogging;
|
|
end;
|
|
end;
|
|
{=====}
|
|
|
|
procedure TO32RegExValidator.SetIgnoreCase(const Value: Boolean);
|
|
begin
|
|
if (FIgnoreCase <> Value) then begin
|
|
FIgnoreCase := Value;
|
|
FRegexEngine.IgnoreCase := FIgnoreCase;
|
|
end;
|
|
end;
|
|
{=====}
|
|
|
|
procedure TO32RegExValidator.SetLogFile(const Value: String);
|
|
begin
|
|
if (FLogFile <> Value) then begin
|
|
FLogFile := Value;
|
|
FRegexEngine.LogFile := FLogFile;
|
|
end;
|
|
end;
|
|
{=====}
|
|
|
|
function TO32RegExValidator.GetExprError: String;
|
|
begin
|
|
case FExprErrorCode of
|
|
recNone : result := '';
|
|
recSuddenEnd : result := 'Incomplete Expression';
|
|
recMetaChar : result := 'Read a metacharacter where there should have'
|
|
+ ' been a normal character';
|
|
recNoCloseParen : result := 'Missing closing parenthesis';
|
|
recExtraChars : result := 'Unrecognizable text at the end of the'
|
|
+ ' expression';
|
|
end;
|
|
end;
|
|
{=====}
|
|
|
|
initialization
|
|
|
|
RegisterValidator(TO32RegexValidator);
|
|
|
|
finalization
|
|
|
|
UnRegisterValidator(TO32RegexValidator);
|
|
|
|
end.
|