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	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			{* _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