source/COM/_StRegEx.pas

(* ***** 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 SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   _STREGEX.PAS 3.00                   *}
{*********************************************************}

{$I STDEFINE.INC}
{$I STCOMDEF.INC}
unit _StRegEx;

interface

uses
  ComObj, ActiveX, AxCtrls, Classes, StUtils, StStrms, StRegEx, SysTools_TLB, StdVcl;

type
  TStRegEx = class(TAutoObject, IConnectionPointContainer, IStRegEx)
  private   { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FSinkList: TList;
    FEvents: IStRegExEvents;

    FStRegEx         : StRegEx.TStStreamRegEx;
    FMatchPattern    : IStStringList;
    FSelAvoidPattern : IStStringList;
    FReplacePattern  : IStStringList;

    FIsLicensed      : Boolean;
    procedure _OnProgress(Sender : TObject; Percent : Word);
  public    { Public declarations }
    procedure Initialize; override;
    destructor Destroy; override;
  protected { Protected declarations }
    { IConnectionPointContainer }
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;

    { IStRegEx properties (GET) }
    function Get_Avoid: WordBool; safecall;
    function Get_IgnoreCase: WordBool; safecall;
    function Get_InFixedLineLength: Integer; safecall;
    function Get_InLineTermChar: WideString; safecall;
    function Get_InLineTerminator: TStLineTerminator; safecall;
    function Get_LineCount: Integer; safecall;
    function Get_LineNumbers: WordBool; safecall;
    function Get_LinesMatched: Integer; safecall;
    function Get_LinesPerSecond: Integer; safecall;
    function Get_LinesReplaced: Integer; safecall;
    function Get_LinesSelected: Integer; safecall;
    function Get_MatchPattern: IStStringList; safecall;
    function Get_OutFixedLineLength: Integer; safecall;
    function Get_OutLineTermChar: WideString; safecall;
    function Get_OutLineTerminitor: Integer; safecall;
    function Get_OutputOptions: TStOutputOption; safecall;
    function Get_ReplacePattern: IStStringList; safecall;
    function Get_SelAvoidPattern: IStStringList; safecall;
    function Get_Stream: OleVariant; safecall;

    { IStRegEx properties (SET) }
    procedure Set_Avoid(Value: WordBool); safecall;
    procedure Set_IgnoreCase(Value: WordBool); safecall;
    procedure Set_InFixedLineLength(Value: Integer); safecall;
    procedure Set_InLineTermChar(const Value: WideString); safecall;
    procedure Set_InLineTerminator(Value: TStLineTerminator); safecall;
    procedure Set_LineNumbers(Value: WordBool); safecall;
    procedure Set_MatchPattern(const Value: IStStringList); safecall;
    procedure Set_OutFixedLineLength(Value: Integer); safecall;
    procedure Set_OutLineTermChar(const Value: WideString); safecall;
    procedure Set_OutLineTerminitor(Value: Integer); safecall;
    procedure Set_OutputOptions(Value: TStOutputOption); safecall;
    procedure Set_ReplacePattern(const Value: IStStringList); safecall;
    procedure Set_SelAvoidPattern(const Value: IStStringList); safecall;
    procedure Set_Stream(Value: OleVariant); safecall;

    { IStRegEx Methods }
    function CheckString(const S: WideString; var StartPos, EndPos, Length: Integer): WordBool; safecall;
    function DOSMaskToRegEx(const Masks: WideString): WordBool; safecall;
    function Execute: WordBool; safecall;
    procedure LoadFromFile(const FileName: WideString); safecall;
    procedure SaveToFile(const FileName: WideString); safecall;
    function License(const Key: WideString): WordBool; safecall;
  end;

implementation

uses ComServ, _StUtil {$IFDEF LICENSE}, StComLic {$ENDIF};

{ ********** TStRegExp Interface - IConnectionPointContainer Methods ********************* }
procedure TStRegEx.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IStRegExEvents;
  if FConnectionPoint <> nil then
     FSinkList := FConnectionPoint.SinkList;
end;

{ ********** TStRegExp Interface ********************************************************* }
procedure TStRegEx.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
      AutoFactory.EventIID, ckSingle, EventConnect)
  else FConnectionPoint := nil;

  {$IFDEF LICENSE}
  FIsLicensed := False;
  {$ELSE}
  FIsLicensed := True;
  {$ENDIF}

  FStRegEx := StRegEx.TStStreamRegEx.Create;
  FStRegEx.InputStream := Classes.TMemoryStream.Create;
  FStRegEx.OutputStream := Classes.TMemoryStream.Create;

  FMatchPattern    := TStStringList.Create(FStRegEx.MatchPattern);
  FSelAvoidPattern := TStStringList.Create(FStRegEx.SelAvoidPattern);
  FReplacePattern  := TStStringList.Create(FStRegEx.ReplacePattern);

  FStRegEx.OnProgress := _OnProgress;
end;

destructor TStRegEx.Destroy;
begin
  if Assigned(FStRegEx.InputStream) then
    FStRegEx.InputStream.Free;

  if Assigned(FStRegEx.OutputStream) then
    FStRegEx.OutputStream.Free;

  FMatchPattern    := nil;
  FSelAvoidPattern := nil;
  FReplacePattern  := nil;

  if Assigned(FStRegEx) then
    FStRegEx.Free;

  inherited Destroy;
end;

{ ********** TStRegExp Events ************************************************************ }
procedure TStRegEx._OnProgress(Sender : TObject; Percent : Word);
begin
  if Assigned(FEvents) then
    FEvents.OnProgress(Integer(Percent));
end;

{ ********** TStRegExp Properties *** (Get) ********************************************** }
function TStRegEx.Get_Avoid: WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.Avoid;
end;

function TStRegEx.Get_IgnoreCase: WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.IgnoreCase;
end;

function TStRegEx.Get_InFixedLineLength: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.InFixedLineLength;
end;

function TStRegEx.Get_InLineTermChar: WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.InLineTermChar;
end;

function TStRegEx.Get_InLineTerminator: TStLineTerminator;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := TStLineTerminator(FStRegEx.InLineTerminator);
end;

function TStRegEx.Get_LineCount: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LineCount;
end;

function TStRegEx.Get_LineNumbers: WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LineNumbers;
end;

function TStRegEx.Get_LinesMatched: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LinesMatched;
end;

function TStRegEx.Get_LinesPerSecond: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LinesPerSecond;
end;

function TStRegEx.Get_LinesReplaced: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LinesReplaced;
end;

function TStRegEx.Get_LinesSelected: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.LinesSelected;
end;

function TStRegEx.Get_MatchPattern: IStStringList;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FMatchPattern;
end;

function TStRegEx.Get_OutFixedLineLength: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.OutFixedLineLength;
end;

function TStRegEx.Get_OutLineTermChar: WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.OutLineTermChar;
end;

function TStRegEx.Get_OutLineTerminitor: Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := TStLineTerminator(FStRegEx.OutLineTerminator);
end;

function TStRegEx.Get_OutputOptions: TStOutputOption;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := 0;
  if (StRegEx.ooUnSelected in FStRegEx.OutputOptions) then
    Result := Result + ooUnSelected;

  if (StRegEx.ooModified in FStRegEx.OutputOptions) then
    Result := Result + ooModified;

  if (StRegEx.ooUnSelected in FStRegEx.OutputOptions) then
    Result := Result + ooCountOnly;
end;

function TStRegEx.Get_ReplacePattern: IStStringList;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FReplacePattern;
end;

function TStRegEx.Get_SelAvoidPattern: IStStringList;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FSelAvoidPattern;
end;

function TStRegEx.Get_Stream: OleVariant;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := StStreamToOleVariant(FStRegEx.OutputStream);
end;

{ ********** TStRegExp Properties *** (Set) ********************************************** }
procedure TStRegEx.Set_Avoid(Value: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.Avoid := Value;
end;

procedure TStRegEx.Set_IgnoreCase(Value: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.IgnoreCase := Value;
end;

procedure TStRegEx.Set_InFixedLineLength(Value: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.InFixedLineLength := Value;
end;

procedure TStRegEx.Set_InLineTermChar(const Value: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.InLineTermChar := Char(Value[1]);
end;

procedure TStRegEx.Set_InLineTerminator(Value: TStLineTerminator);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.InLineTerminator := StStrms.TStLineTerminator(Value);
end;

procedure TStRegEx.Set_LineNumbers(Value: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.LineNumbers := Value;
end;

procedure TStRegEx.Set_MatchPattern(const Value: IStStringList);
var
  MS : TStream;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  MS := nil;
  try
    MS := StOleVariantToStream(Value.Stream, True);
    FStRegEx.MatchPattern.LoadFromStream(MS);
  finally
    MS.Free;
  end;
end;

procedure TStRegEx.Set_OutFixedLineLength(Value: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.OutFixedLineLength := Value;
end;

procedure TStRegEx.Set_OutLineTermChar(const Value: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.OutLineTermChar := Char(Value[1]);
end;

procedure TStRegEx.Set_OutLineTerminitor(Value: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.OutLineTerminator := StStrms.TStLineTerminator(Value);
end;

procedure TStRegEx.Set_OutputOptions(Value: TStOutputOption);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FStRegEx.OutputOptions := [];
  if FlagIsSet(ooUnSelected, Value) then
    FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooUnselected];

  if FlagIsSet(ooModified, Value) then
    FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooModified];

  if FlagIsSet(ooCountOnly, Value) then
    FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooCountOnly];
end;

procedure TStRegEx.Set_ReplacePattern(const Value: IStStringList);
var
  MS : TStream;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  MS := nil;
  try
    MS := StOleVariantToStream(Value.Stream, True);
    FStRegEx.ReplacePattern.LoadFromStream(MS);
  finally
    MS.Free;
  end;
end;

procedure TStRegEx.Set_SelAvoidPattern(const Value: IStStringList);
var
  MS : TStream;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  MS := nil;
  try
    MS := StOleVariantToStream(Value.Stream, True);
    FStRegEx.SelAvoidPattern.LoadFromStream(MS);
  finally
    MS.Free;
  end;
end;

procedure TStRegEx.Set_Stream(Value: OleVariant);
var
  MS : TStream;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  MS := nil;
  try
    MS := StOleVariantToStream(Value, True);
    FStRegEx.InputStream.CopyFrom(MS, 0);
    FStRegEx.InputStream.Position := 0;
  finally
    MS.Free;
  end;
end;

{ ********** TStRegExp Methods *********************************************************** }
function TStRegEx.CheckString(const S: WideString; var StartPos, EndPos,
  Length: Integer): WordBool;
var
  MP : TMatchPosition;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  MP.StartPos := StartPos;
  MP.EndPos   := EndPos;
  MP.Length   := Length;
  Result := FStRegEx.CheckString(S, MP);
  StartPos := MP.StartPos;
  EndPos   := MP.EndPos;
  Length   := MP.Length;
end;

function TStRegEx.DOSMaskToRegEx(const Masks: WideString): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.DOSMasksToRegEx(Masks);
end;

function TStRegEx.Execute: WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FStRegEx.Execute;
end;

procedure TStRegEx.LoadFromFile(const FileName: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  TMemoryStream(FStRegEx.InputStream).LoadFromFile(FileName);
end;

procedure TStRegEx.SaveToFile(const FileName: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  TMemoryStream(FStRegEx.OutputStream).SaveToFile(FileName);
end;


function TStRegEx.License(const Key: WideString): WordBool;
begin
  {$IFDEF LICENSE}
  Result := COMIsValidKey(Key);

  { License the objects used in this class }
  FMatchPattern.License(Key);
  FSelAvoidPattern.License(Key);
  FReplacePattern.License(Key);

  {$ELSE}
  Result := True;
  {$ENDIF}
  FIsLicensed := Result;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TStRegEx, Class_StRegEx, ciMultiInstance, tmBoth);
end.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			{*********************************************************}
27			{* _STREGEX.PAS 3.00 *}
28			{*********************************************************}
29
30			{$I STDEFINE.INC}
31			{$I STCOMDEF.INC}
32			unit _StRegEx;
33
34			interface
35
36			uses
37			ComObj, ActiveX, AxCtrls, Classes, StUtils, StStrms, StRegEx, SysTools_TLB, StdVcl;
38
39			type
40			TStRegEx = class(TAutoObject, IConnectionPointContainer, IStRegEx)
41			private { Private declarations }
42			FConnectionPoints: TConnectionPoints;
43			FConnectionPoint: TConnectionPoint;
44			FSinkList: TList;
45			FEvents: IStRegExEvents;
46
47			FStRegEx : StRegEx.TStStreamRegEx;
48			FMatchPattern : IStStringList;
49			FSelAvoidPattern : IStStringList;
50			FReplacePattern : IStStringList;
51
52			FIsLicensed : Boolean;
53			procedure _OnProgress(Sender : TObject; Percent : Word);
54			public { Public declarations }
55			procedure Initialize; override;
56			destructor Destroy; override;
57			protected { Protected declarations }
58			{ IConnectionPointContainer }
59			property ConnectionPoints: TConnectionPoints read FConnectionPoints
60			implements IConnectionPointContainer;
61			procedure EventSinkChanged(const EventSink: IUnknown); override;
62
63			{ IStRegEx properties (GET) }
64			function Get_Avoid: WordBool; safecall;
65			function Get_IgnoreCase: WordBool; safecall;
66			function Get_InFixedLineLength: Integer; safecall;
67			function Get_InLineTermChar: WideString; safecall;
68			function Get_InLineTerminator: TStLineTerminator; safecall;
69			function Get_LineCount: Integer; safecall;
70			function Get_LineNumbers: WordBool; safecall;
71			function Get_LinesMatched: Integer; safecall;
72			function Get_LinesPerSecond: Integer; safecall;
73			function Get_LinesReplaced: Integer; safecall;
74			function Get_LinesSelected: Integer; safecall;
75			function Get_MatchPattern: IStStringList; safecall;
76			function Get_OutFixedLineLength: Integer; safecall;
77			function Get_OutLineTermChar: WideString; safecall;
78			function Get_OutLineTerminitor: Integer; safecall;
79			function Get_OutputOptions: TStOutputOption; safecall;
80			function Get_ReplacePattern: IStStringList; safecall;
81			function Get_SelAvoidPattern: IStStringList; safecall;
82			function Get_Stream: OleVariant; safecall;
83
84			{ IStRegEx properties (SET) }
85			procedure Set_Avoid(Value: WordBool); safecall;
86			procedure Set_IgnoreCase(Value: WordBool); safecall;
87			procedure Set_InFixedLineLength(Value: Integer); safecall;
88			procedure Set_InLineTermChar(const Value: WideString); safecall;
89			procedure Set_InLineTerminator(Value: TStLineTerminator); safecall;
90			procedure Set_LineNumbers(Value: WordBool); safecall;
91			procedure Set_MatchPattern(const Value: IStStringList); safecall;
92			procedure Set_OutFixedLineLength(Value: Integer); safecall;
93			procedure Set_OutLineTermChar(const Value: WideString); safecall;
94			procedure Set_OutLineTerminitor(Value: Integer); safecall;
95			procedure Set_OutputOptions(Value: TStOutputOption); safecall;
96			procedure Set_ReplacePattern(const Value: IStStringList); safecall;
97			procedure Set_SelAvoidPattern(const Value: IStStringList); safecall;
98			procedure Set_Stream(Value: OleVariant); safecall;
99
100			{ IStRegEx Methods }
101			function CheckString(const S: WideString; var StartPos, EndPos, Length: Integer): WordBool; safecall;
102			function DOSMaskToRegEx(const Masks: WideString): WordBool; safecall;
103			function Execute: WordBool; safecall;
104			procedure LoadFromFile(const FileName: WideString); safecall;
105			procedure SaveToFile(const FileName: WideString); safecall;
106			function License(const Key: WideString): WordBool; safecall;
107			end;
108
109			implementation
110
111			uses ComServ, _StUtil {$IFDEF LICENSE}, StComLic {$ENDIF};
112
113			{ ******** TStRegExp Interface - IConnectionPointContainer Methods ******************* }
114			procedure TStRegEx.EventSinkChanged(const EventSink: IUnknown);
115			begin
116			FEvents := EventSink as IStRegExEvents;
117			if FConnectionPoint <> nil then
118			FSinkList := FConnectionPoint.SinkList;
119			end;
120
121			{ ******** TStRegExp Interface ******************************************************* }
122			procedure TStRegEx.Initialize;
123			begin
124			inherited Initialize;
125			FConnectionPoints := TConnectionPoints.Create(Self);
126			if AutoFactory.EventTypeInfo <> nil then
127			FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
128			AutoFactory.EventIID, ckSingle, EventConnect)
129			else FConnectionPoint := nil;
130
131			{$IFDEF LICENSE}
132			FIsLicensed := False;
133			{$ELSE}
134			FIsLicensed := True;
135			{$ENDIF}
136
137			FStRegEx := StRegEx.TStStreamRegEx.Create;
138			FStRegEx.InputStream := Classes.TMemoryStream.Create;
139			FStRegEx.OutputStream := Classes.TMemoryStream.Create;
140
141			FMatchPattern := TStStringList.Create(FStRegEx.MatchPattern);
142			FSelAvoidPattern := TStStringList.Create(FStRegEx.SelAvoidPattern);
143			FReplacePattern := TStStringList.Create(FStRegEx.ReplacePattern);
144
145			FStRegEx.OnProgress := _OnProgress;
146			end;
147
148			destructor TStRegEx.Destroy;
149			begin
150			if Assigned(FStRegEx.InputStream) then
151			FStRegEx.InputStream.Free;
152
153			if Assigned(FStRegEx.OutputStream) then
154			FStRegEx.OutputStream.Free;
155
156			FMatchPattern := nil;
157			FSelAvoidPattern := nil;
158			FReplacePattern := nil;
159
160			if Assigned(FStRegEx) then
161			FStRegEx.Free;
162
163			inherited Destroy;
164			end;
165
166			{ ******** TStRegExp Events ********************************************************** }
167			procedure TStRegEx._OnProgress(Sender : TObject; Percent : Word);
168			begin
169			if Assigned(FEvents) then
170			FEvents.OnProgress(Integer(Percent));
171			end;
172
173			{ ******** TStRegExp Properties * (Get) ********************************************** }
174			function TStRegEx.Get_Avoid: WordBool;
175			begin
176			{$IFDEF LICENSE}
177			if (not FIsLicensed) or (not COMHasBeenLicensed) then
178			OleError(CLASS_E_NOTLICENSED);
179			{$ENDIF}
180			Result := FStRegEx.Avoid;
181			end;
182
183			function TStRegEx.Get_IgnoreCase: WordBool;
184			begin
185			{$IFDEF LICENSE}
186			if (not FIsLicensed) or (not COMHasBeenLicensed) then
187			OleError(CLASS_E_NOTLICENSED);
188			{$ENDIF}
189			Result := FStRegEx.IgnoreCase;
190			end;
191
192			function TStRegEx.Get_InFixedLineLength: Integer;
193			begin
194			{$IFDEF LICENSE}
195			if (not FIsLicensed) or (not COMHasBeenLicensed) then
196			OleError(CLASS_E_NOTLICENSED);
197			{$ENDIF}
198			Result := FStRegEx.InFixedLineLength;
199			end;
200
201			function TStRegEx.Get_InLineTermChar: WideString;
202			begin
203			{$IFDEF LICENSE}
204			if (not FIsLicensed) or (not COMHasBeenLicensed) then
205			OleError(CLASS_E_NOTLICENSED);
206			{$ENDIF}
207			Result := FStRegEx.InLineTermChar;
208			end;
209
210			function TStRegEx.Get_InLineTerminator: TStLineTerminator;
211			begin
212			{$IFDEF LICENSE}
213			if (not FIsLicensed) or (not COMHasBeenLicensed) then
214			OleError(CLASS_E_NOTLICENSED);
215			{$ENDIF}
216			Result := TStLineTerminator(FStRegEx.InLineTerminator);
217			end;
218
219			function TStRegEx.Get_LineCount: Integer;
220			begin
221			{$IFDEF LICENSE}
222			if (not FIsLicensed) or (not COMHasBeenLicensed) then
223			OleError(CLASS_E_NOTLICENSED);
224			{$ENDIF}
225			Result := FStRegEx.LineCount;
226			end;
227
228			function TStRegEx.Get_LineNumbers: WordBool;
229			begin
230			{$IFDEF LICENSE}
231			if (not FIsLicensed) or (not COMHasBeenLicensed) then
232			OleError(CLASS_E_NOTLICENSED);
233			{$ENDIF}
234			Result := FStRegEx.LineNumbers;
235			end;
236
237			function TStRegEx.Get_LinesMatched: Integer;
238			begin
239			{$IFDEF LICENSE}
240			if (not FIsLicensed) or (not COMHasBeenLicensed) then
241			OleError(CLASS_E_NOTLICENSED);
242			{$ENDIF}
243			Result := FStRegEx.LinesMatched;
244			end;
245
246			function TStRegEx.Get_LinesPerSecond: Integer;
247			begin
248			{$IFDEF LICENSE}
249			if (not FIsLicensed) or (not COMHasBeenLicensed) then
250			OleError(CLASS_E_NOTLICENSED);
251			{$ENDIF}
252			Result := FStRegEx.LinesPerSecond;
253			end;
254
255			function TStRegEx.Get_LinesReplaced: Integer;
256			begin
257			{$IFDEF LICENSE}
258			if (not FIsLicensed) or (not COMHasBeenLicensed) then
259			OleError(CLASS_E_NOTLICENSED);
260			{$ENDIF}
261			Result := FStRegEx.LinesReplaced;
262			end;
263
264			function TStRegEx.Get_LinesSelected: Integer;
265			begin
266			{$IFDEF LICENSE}
267			if (not FIsLicensed) or (not COMHasBeenLicensed) then
268			OleError(CLASS_E_NOTLICENSED);
269			{$ENDIF}
270			Result := FStRegEx.LinesSelected;
271			end;
272
273			function TStRegEx.Get_MatchPattern: IStStringList;
274			begin
275			{$IFDEF LICENSE}
276			if (not FIsLicensed) or (not COMHasBeenLicensed) then
277			OleError(CLASS_E_NOTLICENSED);
278			{$ENDIF}
279			Result := FMatchPattern;
280			end;
281
282			function TStRegEx.Get_OutFixedLineLength: Integer;
283			begin
284			{$IFDEF LICENSE}
285			if (not FIsLicensed) or (not COMHasBeenLicensed) then
286			OleError(CLASS_E_NOTLICENSED);
287			{$ENDIF}
288			Result := FStRegEx.OutFixedLineLength;
289			end;
290
291			function TStRegEx.Get_OutLineTermChar: WideString;
292			begin
293			{$IFDEF LICENSE}
294			if (not FIsLicensed) or (not COMHasBeenLicensed) then
295			OleError(CLASS_E_NOTLICENSED);
296			{$ENDIF}
297			Result := FStRegEx.OutLineTermChar;
298			end;
299
300			function TStRegEx.Get_OutLineTerminitor: Integer;
301			begin
302			{$IFDEF LICENSE}
303			if (not FIsLicensed) or (not COMHasBeenLicensed) then
304			OleError(CLASS_E_NOTLICENSED);
305			{$ENDIF}
306			Result := TStLineTerminator(FStRegEx.OutLineTerminator);
307			end;
308
309			function TStRegEx.Get_OutputOptions: TStOutputOption;
310			begin
311			{$IFDEF LICENSE}
312			if (not FIsLicensed) or (not COMHasBeenLicensed) then
313			OleError(CLASS_E_NOTLICENSED);
314			{$ENDIF}
315			Result := 0;
316			if (StRegEx.ooUnSelected in FStRegEx.OutputOptions) then
317			Result := Result + ooUnSelected;
318
319			if (StRegEx.ooModified in FStRegEx.OutputOptions) then
320			Result := Result + ooModified;
321
322			if (StRegEx.ooUnSelected in FStRegEx.OutputOptions) then
323			Result := Result + ooCountOnly;
324			end;
325
326			function TStRegEx.Get_ReplacePattern: IStStringList;
327			begin
328			{$IFDEF LICENSE}
329			if (not FIsLicensed) or (not COMHasBeenLicensed) then
330			OleError(CLASS_E_NOTLICENSED);
331			{$ENDIF}
332			Result := FReplacePattern;
333			end;
334
335			function TStRegEx.Get_SelAvoidPattern: IStStringList;
336			begin
337			{$IFDEF LICENSE}
338			if (not FIsLicensed) or (not COMHasBeenLicensed) then
339			OleError(CLASS_E_NOTLICENSED);
340			{$ENDIF}
341			Result := FSelAvoidPattern;
342			end;
343
344			function TStRegEx.Get_Stream: OleVariant;
345			begin
346			{$IFDEF LICENSE}
347			if (not FIsLicensed) or (not COMHasBeenLicensed) then
348			OleError(CLASS_E_NOTLICENSED);
349			{$ENDIF}
350			Result := StStreamToOleVariant(FStRegEx.OutputStream);
351			end;
352
353			{ ******** TStRegExp Properties * (Set) ********************************************** }
354			procedure TStRegEx.Set_Avoid(Value: WordBool);
355			begin
356			{$IFDEF LICENSE}
357			if (not FIsLicensed) or (not COMHasBeenLicensed) then
358			OleError(CLASS_E_NOTLICENSED);
359			{$ENDIF}
360			FStRegEx.Avoid := Value;
361			end;
362
363			procedure TStRegEx.Set_IgnoreCase(Value: WordBool);
364			begin
365			{$IFDEF LICENSE}
366			if (not FIsLicensed) or (not COMHasBeenLicensed) then
367			OleError(CLASS_E_NOTLICENSED);
368			{$ENDIF}
369			FStRegEx.IgnoreCase := Value;
370			end;
371
372			procedure TStRegEx.Set_InFixedLineLength(Value: Integer);
373			begin
374			{$IFDEF LICENSE}
375			if (not FIsLicensed) or (not COMHasBeenLicensed) then
376			OleError(CLASS_E_NOTLICENSED);
377			{$ENDIF}
378			FStRegEx.InFixedLineLength := Value;
379			end;
380
381			procedure TStRegEx.Set_InLineTermChar(const Value: WideString);
382			begin
383			{$IFDEF LICENSE}
384			if (not FIsLicensed) or (not COMHasBeenLicensed) then
385			OleError(CLASS_E_NOTLICENSED);
386			{$ENDIF}
387			FStRegEx.InLineTermChar := Char(Value[1]);
388			end;
389
390			procedure TStRegEx.Set_InLineTerminator(Value: TStLineTerminator);
391			begin
392			{$IFDEF LICENSE}
393			if (not FIsLicensed) or (not COMHasBeenLicensed) then
394			OleError(CLASS_E_NOTLICENSED);
395			{$ENDIF}
396			FStRegEx.InLineTerminator := StStrms.TStLineTerminator(Value);
397			end;
398
399			procedure TStRegEx.Set_LineNumbers(Value: WordBool);
400			begin
401			{$IFDEF LICENSE}
402			if (not FIsLicensed) or (not COMHasBeenLicensed) then
403			OleError(CLASS_E_NOTLICENSED);
404			{$ENDIF}
405			FStRegEx.LineNumbers := Value;
406			end;
407
408			procedure TStRegEx.Set_MatchPattern(const Value: IStStringList);
409			var
410			MS : TStream;
411			begin
412			{$IFDEF LICENSE}
413			if (not FIsLicensed) or (not COMHasBeenLicensed) then
414			OleError(CLASS_E_NOTLICENSED);
415			{$ENDIF}
416			MS := nil;
417			try
418			MS := StOleVariantToStream(Value.Stream, True);
419			FStRegEx.MatchPattern.LoadFromStream(MS);
420			finally
421			MS.Free;
422			end;
423			end;
424
425			procedure TStRegEx.Set_OutFixedLineLength(Value: Integer);
426			begin
427			{$IFDEF LICENSE}
428			if (not FIsLicensed) or (not COMHasBeenLicensed) then
429			OleError(CLASS_E_NOTLICENSED);
430			{$ENDIF}
431			FStRegEx.OutFixedLineLength := Value;
432			end;
433
434			procedure TStRegEx.Set_OutLineTermChar(const Value: WideString);
435			begin
436			{$IFDEF LICENSE}
437			if (not FIsLicensed) or (not COMHasBeenLicensed) then
438			OleError(CLASS_E_NOTLICENSED);
439			{$ENDIF}
440			FStRegEx.OutLineTermChar := Char(Value[1]);
441			end;
442
443			procedure TStRegEx.Set_OutLineTerminitor(Value: Integer);
444			begin
445			{$IFDEF LICENSE}
446			if (not FIsLicensed) or (not COMHasBeenLicensed) then
447			OleError(CLASS_E_NOTLICENSED);
448			{$ENDIF}
449			FStRegEx.OutLineTerminator := StStrms.TStLineTerminator(Value);
450			end;
451
452			procedure TStRegEx.Set_OutputOptions(Value: TStOutputOption);
453			begin
454			{$IFDEF LICENSE}
455			if (not FIsLicensed) or (not COMHasBeenLicensed) then
456			OleError(CLASS_E_NOTLICENSED);
457			{$ENDIF}
458			FStRegEx.OutputOptions := [];
459			if FlagIsSet(ooUnSelected, Value) then
460			FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooUnselected];
461
462			if FlagIsSet(ooModified, Value) then
463			FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooModified];
464
465			if FlagIsSet(ooCountOnly, Value) then
466			FStRegEx.OutputOptions := FStRegEx.OutputOptions + [StRegEx.ooCountOnly];
467			end;
468
469			procedure TStRegEx.Set_ReplacePattern(const Value: IStStringList);
470			var
471			MS : TStream;
472			begin
473			{$IFDEF LICENSE}
474			if (not FIsLicensed) or (not COMHasBeenLicensed) then
475			OleError(CLASS_E_NOTLICENSED);
476			{$ENDIF}
477			MS := nil;
478			try
479			MS := StOleVariantToStream(Value.Stream, True);
480			FStRegEx.ReplacePattern.LoadFromStream(MS);
481			finally
482			MS.Free;
483			end;
484			end;
485
486			procedure TStRegEx.Set_SelAvoidPattern(const Value: IStStringList);
487			var
488			MS : TStream;
489			begin
490			{$IFDEF LICENSE}
491			if (not FIsLicensed) or (not COMHasBeenLicensed) then
492			OleError(CLASS_E_NOTLICENSED);
493			{$ENDIF}
494			MS := nil;
495			try
496			MS := StOleVariantToStream(Value.Stream, True);
497			FStRegEx.SelAvoidPattern.LoadFromStream(MS);
498			finally
499			MS.Free;
500			end;
501			end;
502
503			procedure TStRegEx.Set_Stream(Value: OleVariant);
504			var
505			MS : TStream;
506			begin
507			{$IFDEF LICENSE}
508			if (not FIsLicensed) or (not COMHasBeenLicensed) then
509			OleError(CLASS_E_NOTLICENSED);
510			{$ENDIF}
511			MS := nil;
512			try
513			MS := StOleVariantToStream(Value, True);
514			FStRegEx.InputStream.CopyFrom(MS, 0);
515			FStRegEx.InputStream.Position := 0;
516			finally
517			MS.Free;
518			end;
519			end;
520
521			{ ******** TStRegExp Methods ********************************************************* }
522			function TStRegEx.CheckString(const S: WideString; var StartPos, EndPos,
523			Length: Integer): WordBool;
524			var
525			MP : TMatchPosition;
526			begin
527			{$IFDEF LICENSE}
528			if (not FIsLicensed) or (not COMHasBeenLicensed) then
529			OleError(CLASS_E_NOTLICENSED);
530			{$ENDIF}
531			MP.StartPos := StartPos;
532			MP.EndPos := EndPos;
533			MP.Length := Length;
534			Result := FStRegEx.CheckString(S, MP);
535			StartPos := MP.StartPos;
536			EndPos := MP.EndPos;
537			Length := MP.Length;
538			end;
539
540			function TStRegEx.DOSMaskToRegEx(const Masks: WideString): WordBool;
541			begin
542			{$IFDEF LICENSE}
543			if (not FIsLicensed) or (not COMHasBeenLicensed) then
544			OleError(CLASS_E_NOTLICENSED);
545			{$ENDIF}
546			Result := FStRegEx.DOSMasksToRegEx(Masks);
547			end;
548
549			function TStRegEx.Execute: WordBool;
550			begin
551			{$IFDEF LICENSE}
552			if (not FIsLicensed) or (not COMHasBeenLicensed) then
553			OleError(CLASS_E_NOTLICENSED);
554			{$ENDIF}
555			Result := FStRegEx.Execute;
556			end;
557
558			procedure TStRegEx.LoadFromFile(const FileName: WideString);
559			begin
560			{$IFDEF LICENSE}
561			if (not FIsLicensed) or (not COMHasBeenLicensed) then
562			OleError(CLASS_E_NOTLICENSED);
563			{$ENDIF}
564			TMemoryStream(FStRegEx.InputStream).LoadFromFile(FileName);
565			end;
566
567			procedure TStRegEx.SaveToFile(const FileName: WideString);
568			begin
569			{$IFDEF LICENSE}
570			if (not FIsLicensed) or (not COMHasBeenLicensed) then
571			OleError(CLASS_E_NOTLICENSED);
572			{$ENDIF}
573			TMemoryStream(FStRegEx.OutputStream).SaveToFile(FileName);
574			end;
575
576
577			function TStRegEx.License(const Key: WideString): WordBool;
578			begin
579			{$IFDEF LICENSE}
580			Result := COMIsValidKey(Key);
581
582			{ License the objects used in this class }
583			FMatchPattern.License(Key);
584			FSelAvoidPattern.License(Key);
585			FReplacePattern.License(Key);
586
587			{$ELSE}
588			Result := True;
589			{$ENDIF}
590			FIsLicensed := Result;
591			end;
592
593			initialization
594			TAutoObjectFactory.Create(ComServer, TStRegEx, Class_StRegEx, ciMultiInstance, tmBoth);
595			end.