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	(* *** 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.