source/COM/_StRegINI.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 ***** *)

{*********************************************************}
{*                  _STREGINI.PAS 3.00                   *}
{*********************************************************}

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

interface

uses
  Windows, ComObj, ActiveX, SysTools_TLB, StRegIni, Classes, StdVcl;

type
  IEnumVariant = interface(IUnknown)
    ['{00020404-0000-0000-C000-000000000046}']
    function Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
  end;

  TStRegINIQueryKeyInfo = class(TAutoIntfObject, IStRegINIQueryKeyInfo)
   private
     FOwner : StRegIni.TQueryKeyInfo;
   public
    constructor Create(AOwner: StRegIni.TQueryKeyInfo);
   protected
    function Get_QIClassName: WideString; safecall;
    function Get_QIFileTime: TDateTime; safecall;
    function Get_QIKey: Integer; safecall;
    function Get_QIMaxCNLen: Integer; safecall;
    function Get_QIMaxDataLen: Integer; safecall;
    function Get_QIMaxSKNLen: Integer; safecall;
    function Get_QIMaxVNLen: Integer; safecall;
    function Get_QINumSubKeys: Integer; safecall;
    function Get_QINumValues: Integer; safecall;
    function Get_QISDescLen: Integer; safecall;
    { Protected declarations }
  end;

  TStRegINISubKey = class(TAutoIntfObject, IStRegINISubKey)
   private
     FOwner : WideString;
   public
    constructor Create(AOwner: WideString);
   protected
    function Get_Value: WideString; safecall;
    { Protected declarations }
  end;

  TStRegINISubKeys = class(TAutoIntfObject, IStRegINISubKeys, IEnumVariant)
   private
    FOwner   : TStrings;
    FEnumPos : Integer;
   public
    constructor Create(AOwner: TStrings);
    destructor Destroy; override;
   protected
    { IEnumVariant }
    function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
    function Skip(celt: LongInt): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;

    function Get__NewEnum: IUnknown; safecall;
    function Get_Count: Integer; safecall;
    function Get_Item(Index: Integer): IStRegINISubKey; safecall;
  end;

  TStRegIniValue = class(TAutoIntfObject, IStRegIniValue)
   private
     FOwner : WideString;
   public
    constructor Create(AOwner: WideString);
   protected
    function Get_Value: WideString; safecall;
  end;

  TStRegINIValues = class(TAutoIntfObject, IStRegINIValues, IEnumVariant)
   private
    FOwner   : TStrings;
    FEnumPos : Integer;
   public
    constructor Create(AOwner: TStrings);
    destructor Destroy; override;
   protected
    { IEnumVariant }
    function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
    function Skip(celt: LongInt): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;

    function Get__NewEnum: IUnknown; safecall;
    function Get_Count: Integer; safecall;
    function Get_Item(Index: Integer): IStRegINIValue; safecall;
  end;

  TStRegINI = class(TAutoObject, IStRegINI)
   private
    FOwner : StRegIni.TStRegIni;
    FIsLicensed : Boolean;
   public
    procedure Initialize; override;
    destructor Destroy; override;
   protected
    function Get_CurrentSubKey: WideString; safecall;
    function Get_IsIniFile: WordBool; safecall;
    function Get_Primary: WideString; safecall;
    function Get_SubKeys: IStRegINISubKeys; safecall;
    function Get_Values: IStRegINIValues; safecall;
    function KeyExists(const KeyName: WideString): WordBool; safecall;
    function QueryKey: IStRegINIQueryKeyInfo; safecall;
    function ReadBoolean(const ValueName: WideString;
      Default: WordBool): WordBool; safecall;
    function ReadDate(const ValueName: WideString;
      Default: TDateTime): TDateTime; safecall;
    function ReadDateTime(const ValueName: WideString;
      Default: TDateTime): TDateTime; safecall;
    function ReadInteger(const ValueName: WideString;
      Default: Integer): Integer; safecall;
    function ReadString(const ValueName, Default: WideString): WideString;
      safecall;
    function ReadTime(const ValueName: WideString;
      Default: TDateTime): TDateTime; safecall;
    procedure CreateKey(const KeyName: WideString); safecall;
    procedure DeleteKey(const KeyName: WideString; DeleteSubKeys: WordBool);
      safecall;
    procedure DeleteValue(const ValueName: WideString); safecall;
    procedure Open(const RootName: WideString; IsIniFile: WordBool); safecall;
    procedure Set_CurrentSubKey(const Value: WideString); safecall;
    procedure Set_Primary(const Value: WideString); safecall;
    procedure WriteBoolean(const ValueName: WideString; Value: WordBool);
      safecall;
    procedure WriteDate(const ValueName: WideString; Value: TDateTime);
      safecall;
    procedure WriteDateTime(const ValueName: WideString; Value: TDateTime);
      safecall;
    procedure WriteInteger(const ValueName: WideString; Value: Integer);
      safecall;
    procedure WriteString(const ValueName, Value: WideString); safecall;
    procedure WriteTime(const ValueName: WideString; Value: TDateTime);
      safecall;
    function License(const Key: WideString): WordBool; safecall;
    { Protected declarations }
  end;

implementation

uses ComServ, StBase, StConst, StDate {$IFDEF LICENSE}, StComLic {$ENDIF};

procedure RaiseRegIniError(Code : LongInt);
var
  E : ESTRegIniError;
begin
  E := ESTRegIniError.CreateResTP(Code, 0);
  E.ErrorCode := Code;
  raise E;
end;

{ ******** IRegIniQueryKeyInfo *** }
constructor TStRegINIQueryKeyInfo.Create(AOwner: StRegIni.TQueryKeyInfo);
begin
  inherited  Create(ComServer.TypeLib, IStRegIniQueryKeyInfo);
  FOwner := AOwner;
end;

function TStRegINIQueryKeyInfo.Get_QIClassName: WideString;
begin
  Result := FOwner.QIClassName;
end;

function TStRegINIQueryKeyInfo.Get_QIFileTime: TDateTime;
begin
//  Result := FOwner.QIFileTime;
end;

function TStRegINIQueryKeyInfo.Get_QIKey: Integer;
begin
  Result := FOwner.QIKey;
end;

function TStRegINIQueryKeyInfo.Get_QIMaxCNLen: Integer;
begin
  Result := FOwner.QIMaxCNLen;
end;

function TStRegINIQueryKeyInfo.Get_QIMaxDataLen: Integer;
begin
  Result := FOwner.QIMaxDataLen;
end;

function TStRegINIQueryKeyInfo.Get_QIMaxSKNLen: Integer;
begin
  Result := FOwner.QIMaxSKNLen;
end;

function TStRegINIQueryKeyInfo.Get_QIMaxVNLen: Integer;
begin
  Result := FOwner.QIMaxVNLen;
end;

function TStRegINIQueryKeyInfo.Get_QINumSubKeys: Integer;
begin
  Result := FOwner.QINumSubKeys;
end;

function TStRegINIQueryKeyInfo.Get_QINumValues: Integer;
begin
  Result := FOwner.QINumValues;
end;

function TStRegINIQueryKeyInfo.Get_QISDescLen: Integer;
begin
  Result := FOwner.QISDescLen;
end;
{ ******************************** }

{ ******** IRegIniSubKey ********* }
constructor TStRegIniSubKey.Create(AOwner: WideString);
begin
  inherited  Create(ComServer.TypeLib, IStRegIniSubKey);
  FOwner := AOwner;
end;

function TStRegINISubKey.Get_Value: WideString;
begin
  Result := FOwner;
end;
{ ******************************** }

{ ******** IRegIniSubKeys ******** }
constructor TStRegIniSubKeys.Create(AOwner: TStrings);
begin
  inherited Create(ComServer.TypeLib, IStRegIniSubKeys);
  FOwner := AOwner;
  FEnumPos := 0;
end;

destructor TStRegIniSubKeys.Destroy;
begin
  FOwner.Free;
  inherited Destroy;
end;

function TStRegIniSubKeys.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HRESULT;
var
  V : OleVariant;
  I : Integer;
begin
  Result := S_FALSE;
  try
    if pceltFetched <> nil then
      pceltFetched^ := 0;
    for I := 0 to celt - 1 do begin
      if FEnumPos >= FOwner.Count then begin
        FEnumPos := 0;
        Exit;
      end;
      V := Get_Item(FEnumPos);
      TVariantArgList(elt)[I] := TVariantArg(V);

      // Prevent COM garbage collection
      TVarData(V).VType := varEmpty;
      TVarData(V).VInteger := 0;

      Inc(FEnumPos);
      if pceltFetched <> nil then
        Inc(pceltFetched^);
    end;
  except
  end;
  if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
   Result := S_OK;
end;

function TStRegIniSubKeys.Skip(celt: LongInt): HResult;
begin
  Inc(FEnumPos, celt);
  Result := S_OK;
end;

function TStRegIniSubKeys.Reset: HResult;
begin
  FEnumPos := 0;
  Result := S_OK;
end;

function TStRegIniSubKeys.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := nil;
  Result := S_OK;
  try
    Enum := Self.Create(FOwner);
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TStRegINISubKeys.Get__NewEnum: IUnknown;
begin
  Result := Self;
end;

function TStRegINISubKeys.Get_Count: Integer;
begin
  FOwner.Count;
end;

function TStRegINISubKeys.Get_Item(Index: Integer): IStRegINISubKey;
begin
  Result := TStRegIniSubKey.Create(FOwner.Strings[Index]);
end;
{ ******************************** }

{ ******** IRegIniValue ********** }
constructor TStRegIniValue.Create(AOwner: WideString);
begin
  inherited  Create(ComServer.TypeLib, IStRegIniValue);
  FOwner := AOwner;
end;

function TStRegIniValue.Get_Value: WideString;
begin
  Result := FOwner;
end;
{ ******************************** }

{ ******** IRegIniValues ********* }
constructor TStRegIniValues.Create(AOwner: TStrings);
begin
  inherited Create(ComServer.TypeLib, IStRegIniValues);
  FOwner := AOwner;
  FEnumPos := 0;
end;

destructor TStRegIniValues.Destroy;
begin
  FOwner.Free;
  inherited Destroy;
end;

function TStRegIniValues.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult;
var
  V : OleVariant;
  I : Integer;
begin
  Result := S_FALSE;
  try
    if pceltFetched <> nil then
      pceltFetched^ := 0;
    for I := 0 to celt - 1 do begin
      if FEnumPos >= FOwner.Count then begin
        FEnumPos := 0;
        Exit;
      end;
      V := Get_Item(FEnumPos);
      TVariantArgList(elt)[I] := TVariantArg(V);

      // Prevent COM garbage collection
      TVarData(V).VType := varEmpty;
      TVarData(V).VInteger := 0;

      Inc(FEnumPos);
      if pceltFetched <> nil then
        Inc(pceltFetched^);
    end;
  except
  end;
  if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
   Result := S_OK;
end;

function TStRegIniValues.Skip(celt: LongInt): HResult;
begin
  Inc(FEnumPos, celt);
  Result := S_OK;
end;

function TStRegIniValues.Reset: HResult;
begin
  FEnumPos := 0;
  Result := S_OK;
end;

function TStRegIniValues.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := nil;
  Result := S_OK;
  try
    Enum := Self.Create(FOwner);
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TStRegINIValues.Get__NewEnum: IUnknown;
begin
  Result := Self;
end;

function TStRegINIValues.Get_Count: Integer;
begin
  FOwner.Count;
end;

function TStRegINIValues.Get_Item(Index: Integer): IStRegINIValue;
begin
  Result := TStRegIniValue.Create(FOwner.Strings[Index]);
end;
{ ******************************** }

{ ******** IStRegIni ************* }
procedure TStRegINI.Initialize;
begin
  inherited Initialize;
  {$IFDEF LICENSE}
  FIsLicensed := False;
  {$ELSE}
  FIsLicensed := True;
  {$ENDIF}
end;

destructor TStRegINI.Destroy;
begin
  inherited Destroy;
end;

procedure TStRegINI.Open(const RootName: WideString; IsIniFile: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  if Assigned(FOwner) then
    RaiseRegIniError(stscOpenKeyFail)
  else
    FOwner := StRegIni.TStRegIni.Create(RootName, IsIniFile);
end;

function TStRegINI.Get_CurrentSubKey: WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.CurSubKey;
end;

procedure TStRegINI.Set_CurrentSubKey(const Value: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.CurSubKey := Value;
end;

function TStRegINI.Get_IsIniFile: WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.IsIniFile;
end;

procedure TStRegINI.CreateKey(const KeyName: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.CreateKey(KeyName);
end;

procedure TStRegINI.DeleteKey(const KeyName: WideString;
  DeleteSubKeys: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.DeleteKey(KeyName, DeleteSubKeys);
end;

procedure TStRegINI.DeleteValue(const ValueName: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.DeleteValue(ValueName);
end;

function TStRegINI.Get_Primary: WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.GetPrimary;
end;

procedure TStRegINI.Set_Primary(const Value: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.SetPrimary(Value);
end;

function TStRegINI.KeyExists(const KeyName: WideString): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.KeyExists(KeyName);
end;

function TStRegINI.Get_SubKeys: IStRegIniSubKeys;
var
  Keys : TStringList;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Keys := nil;
  try
    Keys := TStringList.Create;
    FOwner.GetSubKeys(Keys);
    Result := TStRegIniSubKeys.Create(Keys);
  except
    Result := nil;
    Keys.Free;
  end;
end;

function TStRegINI.Get_Values: IStRegIniValues;
var
  Keys : TStringList;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Keys := nil;
  try
    Keys := TStringList.Create;
    FOwner.GetValues(Keys);
    Result := TStRegIniValues.Create(Keys);
  except
    Result := nil;
    Keys.Free;
  end;
end;

function TStRegINI.QueryKey: IStRegIniQueryKeyInfo;
var
  QKI : StRegIni.TQueryKeyInfo;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.QueryKey(QKI);
  Result := TStRegIniQueryKeyInfo.Create(QKI);
end;

function TStRegINI.ReadBoolean(const ValueName: WideString;
  Default: WordBool): WordBool;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadBoolean(ValueName, Default);
end;

function TStRegINI.ReadDate(const ValueName: WideString;
  Default: TDateTime): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadDate(ValueName, StDate.DateTimeToStDate(Default));
end;

function TStRegINI.ReadDateTime(const ValueName: WideString;
  Default: TDateTime): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadDateTime(ValueName, Default);
end;

function TStRegINI.ReadInteger(const ValueName: WideString;
  Default: Integer): Integer;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadInteger(ValueName, Default);
end;

function TStRegINI.ReadString(const ValueName,
  Default: WideString): WideString;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadString(ValueName, Default);
end;

function TStRegINI.ReadTime(const ValueName: WideString;
  Default: TDateTime): TDateTime;
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  Result := FOwner.ReadTime(ValueName, StDate.DateTimeToStTime(Default));
end;

procedure TStRegINI.WriteBoolean(const ValueName: WideString;
  Value: WordBool);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteBoolean(ValueName, Value);
end;

procedure TStRegINI.WriteDate(const ValueName: WideString;
  Value: TDateTime);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteDate(ValueName, StDate.DateTimeToStDate(Value));
end;

procedure TStRegINI.WriteDateTime(const ValueName: WideString;
  Value: TDateTime);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteDateTime(ValueName, Value);
end;

procedure TStRegINI.WriteInteger(const ValueName: WideString;
  Value: Integer);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteInteger(ValueName, Value);
end;

procedure TStRegINI.WriteString(const ValueName, Value: WideString);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteString(ValueName, Value);
end;

procedure TStRegINI.WriteTime(const ValueName: WideString;
  Value: TDateTime);
begin
  {$IFDEF LICENSE}
   if (not FIsLicensed) or (not COMHasBeenLicensed) then
     OleError(CLASS_E_NOTLICENSED);
  {$ENDIF}
  FOwner.WriteTime(ValueName, StDate.DateTimeToStTime(Value));
end;
{ ******************************** }


function TStRegINI.License(const Key: WideString): WordBool;
begin
  {$IFDEF LICENSE}
  Result := COMIsValidKey(Key);
  {$ELSE}
  Result := True;
  {$ENDIF}
  FIsLicensed := Result;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TStRegINI, Class_StRegINI, 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	{* _STREGINI.PAS 3.00 *}
28	{*********************************************************}
29
30	{$I STDEFINE.INC}
31	{$I STCOMDEF.INC}
32	unit _StRegINI;
33
34	interface
35
36	uses
37	Windows, ComObj, ActiveX, SysTools_TLB, StRegIni, Classes, StdVcl;
38
39	type
40	IEnumVariant = interface(IUnknown)
41	['{00020404-0000-0000-C000-000000000046}']
42	function Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
43	function Skip(celt: Longint): HResult; stdcall;
44	function Reset: HResult; stdcall;
45	function Clone(out Enum: IEnumVariant): HResult; stdcall;
46	end;
47
48	TStRegINIQueryKeyInfo = class(TAutoIntfObject, IStRegINIQueryKeyInfo)
49	private
50	FOwner : StRegIni.TQueryKeyInfo;
51	public
52	constructor Create(AOwner: StRegIni.TQueryKeyInfo);
53	protected
54	function Get_QIClassName: WideString; safecall;
55	function Get_QIFileTime: TDateTime; safecall;
56	function Get_QIKey: Integer; safecall;
57	function Get_QIMaxCNLen: Integer; safecall;
58	function Get_QIMaxDataLen: Integer; safecall;
59	function Get_QIMaxSKNLen: Integer; safecall;
60	function Get_QIMaxVNLen: Integer; safecall;
61	function Get_QINumSubKeys: Integer; safecall;
62	function Get_QINumValues: Integer; safecall;
63	function Get_QISDescLen: Integer; safecall;
64	{ Protected declarations }
65	end;
66
67	TStRegINISubKey = class(TAutoIntfObject, IStRegINISubKey)
68	private
69	FOwner : WideString;
70	public
71	constructor Create(AOwner: WideString);
72	protected
73	function Get_Value: WideString; safecall;
74	{ Protected declarations }
75	end;
76
77	TStRegINISubKeys = class(TAutoIntfObject, IStRegINISubKeys, IEnumVariant)
78	private
79	FOwner : TStrings;
80	FEnumPos : Integer;
81	public
82	constructor Create(AOwner: TStrings);
83	destructor Destroy; override;
84	protected
85	{ IEnumVariant }
86	function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
87	function Skip(celt: LongInt): HResult; stdcall;
88	function Reset: HResult; stdcall;
89	function Clone(out Enum: IEnumVariant): HResult; stdcall;
90
91	function Get__NewEnum: IUnknown; safecall;
92	function Get_Count: Integer; safecall;
93	function Get_Item(Index: Integer): IStRegINISubKey; safecall;
94	end;
95
96	TStRegIniValue = class(TAutoIntfObject, IStRegIniValue)
97	private
98	FOwner : WideString;
99	public
100	constructor Create(AOwner: WideString);
101	protected
102	function Get_Value: WideString; safecall;
103	end;
104
105	TStRegINIValues = class(TAutoIntfObject, IStRegINIValues, IEnumVariant)
106	private
107	FOwner : TStrings;
108	FEnumPos : Integer;
109	public
110	constructor Create(AOwner: TStrings);
111	destructor Destroy; override;
112	protected
113	{ IEnumVariant }
114	function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
115	function Skip(celt: LongInt): HResult; stdcall;
116	function Reset: HResult; stdcall;
117	function Clone(out Enum: IEnumVariant): HResult; stdcall;
118
119	function Get__NewEnum: IUnknown; safecall;
120	function Get_Count: Integer; safecall;
121	function Get_Item(Index: Integer): IStRegINIValue; safecall;
122	end;
123
124	TStRegINI = class(TAutoObject, IStRegINI)
125	private
126	FOwner : StRegIni.TStRegIni;
127	FIsLicensed : Boolean;
128	public
129	procedure Initialize; override;
130	destructor Destroy; override;
131	protected
132	function Get_CurrentSubKey: WideString; safecall;
133	function Get_IsIniFile: WordBool; safecall;
134	function Get_Primary: WideString; safecall;
135	function Get_SubKeys: IStRegINISubKeys; safecall;
136	function Get_Values: IStRegINIValues; safecall;
137	function KeyExists(const KeyName: WideString): WordBool; safecall;
138	function QueryKey: IStRegINIQueryKeyInfo; safecall;
139	function ReadBoolean(const ValueName: WideString;
140	Default: WordBool): WordBool; safecall;
141	function ReadDate(const ValueName: WideString;
142	Default: TDateTime): TDateTime; safecall;
143	function ReadDateTime(const ValueName: WideString;
144	Default: TDateTime): TDateTime; safecall;
145	function ReadInteger(const ValueName: WideString;
146	Default: Integer): Integer; safecall;
147	function ReadString(const ValueName, Default: WideString): WideString;
148	safecall;
149	function ReadTime(const ValueName: WideString;
150	Default: TDateTime): TDateTime; safecall;
151	procedure CreateKey(const KeyName: WideString); safecall;
152	procedure DeleteKey(const KeyName: WideString; DeleteSubKeys: WordBool);
153	safecall;
154	procedure DeleteValue(const ValueName: WideString); safecall;
155	procedure Open(const RootName: WideString; IsIniFile: WordBool); safecall;
156	procedure Set_CurrentSubKey(const Value: WideString); safecall;
157	procedure Set_Primary(const Value: WideString); safecall;
158	procedure WriteBoolean(const ValueName: WideString; Value: WordBool);
159	safecall;
160	procedure WriteDate(const ValueName: WideString; Value: TDateTime);
161	safecall;
162	procedure WriteDateTime(const ValueName: WideString; Value: TDateTime);
163	safecall;
164	procedure WriteInteger(const ValueName: WideString; Value: Integer);
165	safecall;
166	procedure WriteString(const ValueName, Value: WideString); safecall;
167	procedure WriteTime(const ValueName: WideString; Value: TDateTime);
168	safecall;
169	function License(const Key: WideString): WordBool; safecall;
170	{ Protected declarations }
171	end;
172
173	implementation
174
175	uses ComServ, StBase, StConst, StDate {$IFDEF LICENSE}, StComLic {$ENDIF};
176
177	procedure RaiseRegIniError(Code : LongInt);
178	var
179	E : ESTRegIniError;
180	begin
181	E := ESTRegIniError.CreateResTP(Code, 0);
182	E.ErrorCode := Code;
183	raise E;
184	end;
185
186	{ ****** IRegIniQueryKeyInfo * }
187	constructor TStRegINIQueryKeyInfo.Create(AOwner: StRegIni.TQueryKeyInfo);
188	begin
189	inherited Create(ComServer.TypeLib, IStRegIniQueryKeyInfo);
190	FOwner := AOwner;
191	end;
192
193	function TStRegINIQueryKeyInfo.Get_QIClassName: WideString;
194	begin
195	Result := FOwner.QIClassName;
196	end;
197
198	function TStRegINIQueryKeyInfo.Get_QIFileTime: TDateTime;
199	begin
200	// Result := FOwner.QIFileTime;
201	end;
202
203	function TStRegINIQueryKeyInfo.Get_QIKey: Integer;
204	begin
205	Result := FOwner.QIKey;
206	end;
207
208	function TStRegINIQueryKeyInfo.Get_QIMaxCNLen: Integer;
209	begin
210	Result := FOwner.QIMaxCNLen;
211	end;
212
213	function TStRegINIQueryKeyInfo.Get_QIMaxDataLen: Integer;
214	begin
215	Result := FOwner.QIMaxDataLen;
216	end;
217
218	function TStRegINIQueryKeyInfo.Get_QIMaxSKNLen: Integer;
219	begin
220	Result := FOwner.QIMaxSKNLen;
221	end;
222
223	function TStRegINIQueryKeyInfo.Get_QIMaxVNLen: Integer;
224	begin
225	Result := FOwner.QIMaxVNLen;
226	end;
227
228	function TStRegINIQueryKeyInfo.Get_QINumSubKeys: Integer;
229	begin
230	Result := FOwner.QINumSubKeys;
231	end;
232
233	function TStRegINIQueryKeyInfo.Get_QINumValues: Integer;
234	begin
235	Result := FOwner.QINumValues;
236	end;
237
238	function TStRegINIQueryKeyInfo.Get_QISDescLen: Integer;
239	begin
240	Result := FOwner.QISDescLen;
241	end;
242	{ ******************************** }
243
244	{ ****** IRegIniSubKey ******* }
245	constructor TStRegIniSubKey.Create(AOwner: WideString);
246	begin
247	inherited Create(ComServer.TypeLib, IStRegIniSubKey);
248	FOwner := AOwner;
249	end;
250
251	function TStRegINISubKey.Get_Value: WideString;
252	begin
253	Result := FOwner;
254	end;
255	{ ******************************** }
256
257	{ ****** IRegIniSubKeys ****** }
258	constructor TStRegIniSubKeys.Create(AOwner: TStrings);
259	begin
260	inherited Create(ComServer.TypeLib, IStRegIniSubKeys);
261	FOwner := AOwner;
262	FEnumPos := 0;
263	end;
264
265	destructor TStRegIniSubKeys.Destroy;
266	begin
267	FOwner.Free;
268	inherited Destroy;
269	end;
270
271	function TStRegIniSubKeys.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HRESULT;
272	var
273	V : OleVariant;
274	I : Integer;
275	begin
276	Result := S_FALSE;
277	try
278	if pceltFetched <> nil then
279	pceltFetched^ := 0;
280	for I := 0 to celt - 1 do begin
281	if FEnumPos >= FOwner.Count then begin
282	FEnumPos := 0;
283	Exit;
284	end;
285	V := Get_Item(FEnumPos);
286	TVariantArgList(elt)[I] := TVariantArg(V);
287
288	// Prevent COM garbage collection
289	TVarData(V).VType := varEmpty;
290	TVarData(V).VInteger := 0;
291
292	Inc(FEnumPos);
293	if pceltFetched <> nil then
294	Inc(pceltFetched^);
295	end;
296	except
297	end;
298	if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
299	Result := S_OK;
300	end;
301
302	function TStRegIniSubKeys.Skip(celt: LongInt): HResult;
303	begin
304	Inc(FEnumPos, celt);
305	Result := S_OK;
306	end;
307
308	function TStRegIniSubKeys.Reset: HResult;
309	begin
310	FEnumPos := 0;
311	Result := S_OK;
312	end;
313
314	function TStRegIniSubKeys.Clone(out Enum: IEnumVariant): HResult;
315	begin
316	Enum := nil;
317	Result := S_OK;
318	try
319	Enum := Self.Create(FOwner);
320	except
321	Result := E_OUTOFMEMORY;
322	end;
323	end;
324
325	function TStRegINISubKeys.Get__NewEnum: IUnknown;
326	begin
327	Result := Self;
328	end;
329
330	function TStRegINISubKeys.Get_Count: Integer;
331	begin
332	FOwner.Count;
333	end;
334
335	function TStRegINISubKeys.Get_Item(Index: Integer): IStRegINISubKey;
336	begin
337	Result := TStRegIniSubKey.Create(FOwner.Strings[Index]);
338	end;
339	{ ******************************** }
340
341	{ ****** IRegIniValue ******** }
342	constructor TStRegIniValue.Create(AOwner: WideString);
343	begin
344	inherited Create(ComServer.TypeLib, IStRegIniValue);
345	FOwner := AOwner;
346	end;
347
348	function TStRegIniValue.Get_Value: WideString;
349	begin
350	Result := FOwner;
351	end;
352	{ ******************************** }
353
354	{ ****** IRegIniValues ******* }
355	constructor TStRegIniValues.Create(AOwner: TStrings);
356	begin
357	inherited Create(ComServer.TypeLib, IStRegIniValues);
358	FOwner := AOwner;
359	FEnumPos := 0;
360	end;
361
362	destructor TStRegIniValues.Destroy;
363	begin
364	FOwner.Free;
365	inherited Destroy;
366	end;
367
368	function TStRegIniValues.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult;
369	var
370	V : OleVariant;
371	I : Integer;
372	begin
373	Result := S_FALSE;
374	try
375	if pceltFetched <> nil then
376	pceltFetched^ := 0;
377	for I := 0 to celt - 1 do begin
378	if FEnumPos >= FOwner.Count then begin
379	FEnumPos := 0;
380	Exit;
381	end;
382	V := Get_Item(FEnumPos);
383	TVariantArgList(elt)[I] := TVariantArg(V);
384
385	// Prevent COM garbage collection
386	TVarData(V).VType := varEmpty;
387	TVarData(V).VInteger := 0;
388
389	Inc(FEnumPos);
390	if pceltFetched <> nil then
391	Inc(pceltFetched^);
392	end;
393	except
394	end;
395	if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
396	Result := S_OK;
397	end;
398
399	function TStRegIniValues.Skip(celt: LongInt): HResult;
400	begin
401	Inc(FEnumPos, celt);
402	Result := S_OK;
403	end;
404
405	function TStRegIniValues.Reset: HResult;
406	begin
407	FEnumPos := 0;
408	Result := S_OK;
409	end;
410
411	function TStRegIniValues.Clone(out Enum: IEnumVariant): HResult;
412	begin
413	Enum := nil;
414	Result := S_OK;
415	try
416	Enum := Self.Create(FOwner);
417	except
418	Result := E_OUTOFMEMORY;
419	end;
420	end;
421
422	function TStRegINIValues.Get__NewEnum: IUnknown;
423	begin
424	Result := Self;
425	end;
426
427	function TStRegINIValues.Get_Count: Integer;
428	begin
429	FOwner.Count;
430	end;
431
432	function TStRegINIValues.Get_Item(Index: Integer): IStRegINIValue;
433	begin
434	Result := TStRegIniValue.Create(FOwner.Strings[Index]);
435	end;
436	{ ******************************** }
437
438	{ ****** IStRegIni *********** }
439	procedure TStRegINI.Initialize;
440	begin
441	inherited Initialize;
442	{$IFDEF LICENSE}
443	FIsLicensed := False;
444	{$ELSE}
445	FIsLicensed := True;
446	{$ENDIF}
447	end;
448
449	destructor TStRegINI.Destroy;
450	begin
451	inherited Destroy;
452	end;
453
454	procedure TStRegINI.Open(const RootName: WideString; IsIniFile: WordBool);
455	begin
456	{$IFDEF LICENSE}
457	if (not FIsLicensed) or (not COMHasBeenLicensed) then
458	OleError(CLASS_E_NOTLICENSED);
459	{$ENDIF}
460	if Assigned(FOwner) then
461	RaiseRegIniError(stscOpenKeyFail)
462	else
463	FOwner := StRegIni.TStRegIni.Create(RootName, IsIniFile);
464	end;
465
466	function TStRegINI.Get_CurrentSubKey: WideString;
467	begin
468	{$IFDEF LICENSE}
469	if (not FIsLicensed) or (not COMHasBeenLicensed) then
470	OleError(CLASS_E_NOTLICENSED);
471	{$ENDIF}
472	Result := FOwner.CurSubKey;
473	end;
474
475	procedure TStRegINI.Set_CurrentSubKey(const Value: WideString);
476	begin
477	{$IFDEF LICENSE}
478	if (not FIsLicensed) or (not COMHasBeenLicensed) then
479	OleError(CLASS_E_NOTLICENSED);
480	{$ENDIF}
481	FOwner.CurSubKey := Value;
482	end;
483
484	function TStRegINI.Get_IsIniFile: WordBool;
485	begin
486	{$IFDEF LICENSE}
487	if (not FIsLicensed) or (not COMHasBeenLicensed) then
488	OleError(CLASS_E_NOTLICENSED);
489	{$ENDIF}
490	Result := FOwner.IsIniFile;
491	end;
492
493	procedure TStRegINI.CreateKey(const KeyName: WideString);
494	begin
495	{$IFDEF LICENSE}
496	if (not FIsLicensed) or (not COMHasBeenLicensed) then
497	OleError(CLASS_E_NOTLICENSED);
498	{$ENDIF}
499	FOwner.CreateKey(KeyName);
500	end;
501
502	procedure TStRegINI.DeleteKey(const KeyName: WideString;
503	DeleteSubKeys: WordBool);
504	begin
505	{$IFDEF LICENSE}
506	if (not FIsLicensed) or (not COMHasBeenLicensed) then
507	OleError(CLASS_E_NOTLICENSED);
508	{$ENDIF}
509	FOwner.DeleteKey(KeyName, DeleteSubKeys);
510	end;
511
512	procedure TStRegINI.DeleteValue(const ValueName: WideString);
513	begin
514	{$IFDEF LICENSE}
515	if (not FIsLicensed) or (not COMHasBeenLicensed) then
516	OleError(CLASS_E_NOTLICENSED);
517	{$ENDIF}
518	FOwner.DeleteValue(ValueName);
519	end;
520
521	function TStRegINI.Get_Primary: WideString;
522	begin
523	{$IFDEF LICENSE}
524	if (not FIsLicensed) or (not COMHasBeenLicensed) then
525	OleError(CLASS_E_NOTLICENSED);
526	{$ENDIF}
527	Result := FOwner.GetPrimary;
528	end;
529
530	procedure TStRegINI.Set_Primary(const Value: WideString);
531	begin
532	{$IFDEF LICENSE}
533	if (not FIsLicensed) or (not COMHasBeenLicensed) then
534	OleError(CLASS_E_NOTLICENSED);
535	{$ENDIF}
536	FOwner.SetPrimary(Value);
537	end;
538
539	function TStRegINI.KeyExists(const KeyName: WideString): WordBool;
540	begin
541	{$IFDEF LICENSE}
542	if (not FIsLicensed) or (not COMHasBeenLicensed) then
543	OleError(CLASS_E_NOTLICENSED);
544	{$ENDIF}
545	Result := FOwner.KeyExists(KeyName);
546	end;
547
548	function TStRegINI.Get_SubKeys: IStRegIniSubKeys;
549	var
550	Keys : TStringList;
551	begin
552	{$IFDEF LICENSE}
553	if (not FIsLicensed) or (not COMHasBeenLicensed) then
554	OleError(CLASS_E_NOTLICENSED);
555	{$ENDIF}
556	Keys := nil;
557	try
558	Keys := TStringList.Create;
559	FOwner.GetSubKeys(Keys);
560	Result := TStRegIniSubKeys.Create(Keys);
561	except
562	Result := nil;
563	Keys.Free;
564	end;
565	end;
566
567	function TStRegINI.Get_Values: IStRegIniValues;
568	var
569	Keys : TStringList;
570	begin
571	{$IFDEF LICENSE}
572	if (not FIsLicensed) or (not COMHasBeenLicensed) then
573	OleError(CLASS_E_NOTLICENSED);
574	{$ENDIF}
575	Keys := nil;
576	try
577	Keys := TStringList.Create;
578	FOwner.GetValues(Keys);
579	Result := TStRegIniValues.Create(Keys);
580	except
581	Result := nil;
582	Keys.Free;
583	end;
584	end;
585
586	function TStRegINI.QueryKey: IStRegIniQueryKeyInfo;
587	var
588	QKI : StRegIni.TQueryKeyInfo;
589	begin
590	{$IFDEF LICENSE}
591	if (not FIsLicensed) or (not COMHasBeenLicensed) then
592	OleError(CLASS_E_NOTLICENSED);
593	{$ENDIF}
594	FOwner.QueryKey(QKI);
595	Result := TStRegIniQueryKeyInfo.Create(QKI);
596	end;
597
598	function TStRegINI.ReadBoolean(const ValueName: WideString;
599	Default: WordBool): WordBool;
600	begin
601	{$IFDEF LICENSE}
602	if (not FIsLicensed) or (not COMHasBeenLicensed) then
603	OleError(CLASS_E_NOTLICENSED);
604	{$ENDIF}
605	Result := FOwner.ReadBoolean(ValueName, Default);
606	end;
607
608	function TStRegINI.ReadDate(const ValueName: WideString;
609	Default: TDateTime): TDateTime;
610	begin
611	{$IFDEF LICENSE}
612	if (not FIsLicensed) or (not COMHasBeenLicensed) then
613	OleError(CLASS_E_NOTLICENSED);
614	{$ENDIF}
615	Result := FOwner.ReadDate(ValueName, StDate.DateTimeToStDate(Default));
616	end;
617
618	function TStRegINI.ReadDateTime(const ValueName: WideString;
619	Default: TDateTime): TDateTime;
620	begin
621	{$IFDEF LICENSE}
622	if (not FIsLicensed) or (not COMHasBeenLicensed) then
623	OleError(CLASS_E_NOTLICENSED);
624	{$ENDIF}
625	Result := FOwner.ReadDateTime(ValueName, Default);
626	end;
627
628	function TStRegINI.ReadInteger(const ValueName: WideString;
629	Default: Integer): Integer;
630	begin
631	{$IFDEF LICENSE}
632	if (not FIsLicensed) or (not COMHasBeenLicensed) then
633	OleError(CLASS_E_NOTLICENSED);
634	{$ENDIF}
635	Result := FOwner.ReadInteger(ValueName, Default);
636	end;
637
638	function TStRegINI.ReadString(const ValueName,
639	Default: WideString): WideString;
640	begin
641	{$IFDEF LICENSE}
642	if (not FIsLicensed) or (not COMHasBeenLicensed) then
643	OleError(CLASS_E_NOTLICENSED);
644	{$ENDIF}
645	Result := FOwner.ReadString(ValueName, Default);
646	end;
647
648	function TStRegINI.ReadTime(const ValueName: WideString;
649	Default: TDateTime): TDateTime;
650	begin
651	{$IFDEF LICENSE}
652	if (not FIsLicensed) or (not COMHasBeenLicensed) then
653	OleError(CLASS_E_NOTLICENSED);
654	{$ENDIF}
655	Result := FOwner.ReadTime(ValueName, StDate.DateTimeToStTime(Default));
656	end;
657
658	procedure TStRegINI.WriteBoolean(const ValueName: WideString;
659	Value: WordBool);
660	begin
661	{$IFDEF LICENSE}
662	if (not FIsLicensed) or (not COMHasBeenLicensed) then
663	OleError(CLASS_E_NOTLICENSED);
664	{$ENDIF}
665	FOwner.WriteBoolean(ValueName, Value);
666	end;
667
668	procedure TStRegINI.WriteDate(const ValueName: WideString;
669	Value: TDateTime);
670	begin
671	{$IFDEF LICENSE}
672	if (not FIsLicensed) or (not COMHasBeenLicensed) then
673	OleError(CLASS_E_NOTLICENSED);
674	{$ENDIF}
675	FOwner.WriteDate(ValueName, StDate.DateTimeToStDate(Value));
676	end;
677
678	procedure TStRegINI.WriteDateTime(const ValueName: WideString;
679	Value: TDateTime);
680	begin
681	{$IFDEF LICENSE}
682	if (not FIsLicensed) or (not COMHasBeenLicensed) then
683	OleError(CLASS_E_NOTLICENSED);
684	{$ENDIF}
685	FOwner.WriteDateTime(ValueName, Value);
686	end;
687
688	procedure TStRegINI.WriteInteger(const ValueName: WideString;
689	Value: Integer);
690	begin
691	{$IFDEF LICENSE}
692	if (not FIsLicensed) or (not COMHasBeenLicensed) then
693	OleError(CLASS_E_NOTLICENSED);
694	{$ENDIF}
695	FOwner.WriteInteger(ValueName, Value);
696	end;
697
698	procedure TStRegINI.WriteString(const ValueName, Value: WideString);
699	begin
700	{$IFDEF LICENSE}
701	if (not FIsLicensed) or (not COMHasBeenLicensed) then
702	OleError(CLASS_E_NOTLICENSED);
703	{$ENDIF}
704	FOwner.WriteString(ValueName, Value);
705	end;
706
707	procedure TStRegINI.WriteTime(const ValueName: WideString;
708	Value: TDateTime);
709	begin
710	{$IFDEF LICENSE}
711	if (not FIsLicensed) or (not COMHasBeenLicensed) then
712	OleError(CLASS_E_NOTLICENSED);
713	{$ENDIF}
714	FOwner.WriteTime(ValueName, StDate.DateTimeToStTime(Value));
715	end;
716	{ ******************************** }
717
718
719	function TStRegINI.License(const Key: WideString): WordBool;
720	begin
721	{$IFDEF LICENSE}
722	Result := COMIsValidKey(Key);
723	{$ELSE}
724	Result := True;
725	{$ENDIF}
726	FIsLicensed := Result;
727	end;
728
729	initialization
730	TAutoObjectFactory.Create(ComServer, TStRegINI, Class_StRegINI, ciMultiInstance, tmBoth);
731	end.
732