(*****************************************************************************)
(* MODULE: BSERGTRY^                                                         *)
(* RIGHTS: Reggatta Systems, Inc. - COPYRIGHT 1995 - 1998                    *)
(* DESCR.: This module contains a slightly modified version of the Borland   *)
(*         TRegistry class.                                                  *)
(*                                                                           *)
(* NOTES :                                                                   *)
(*                                                                           *)
(* TRightsRegistry:    This class is exactly the same as the Borland         *)
(*                     TRegistry class except that some of the WIN API calls *)
(*                     that require Permission flags can be set through the  *)
(*                     Rights property.                                      *)
(*****************************************************************************)
Unit BseRgtry;
{$R-}

interface

uses
  Windows,
  Classes,
  SysUtils,
  Registry;

type
  TRightsRegistry =
  Class( TRegistry )
    Private
      FRights : LongInt;
    Public
      Constructor Create;
      function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
      function GetKey(const Key: string): HKEY;
      function KeyExists(const Key: string): Boolean;

      Property Rights : Longint
        Read  FRights
        Write FRights;
  end;

implementation

function IsRelative(const Value: string): Boolean;
begin
  Result := not ((Value <> '') and (Value[1] = '\'));
end;

constructor TRightsRegistry.Create;
begin
  Inherited Create;
  FRights := KEY_ALL_ACCESS; //Default like TRegistry
end;

function TRightsRegistry.GetKey(const Key: string): HKEY;
var
  S        : string;
  Relative : Boolean;
begin
  S := Key;
  Relative := IsRelative(S);
  if not Relative then
    Delete(S, 1, 1);
  Result := 0;
  RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0, FRights, Result);
end;

function TRightsRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
var
  TempKey     : HKey;
  S           : string;
  Disposition : Integer;
  Relative    : Boolean;
begin
  S := Key;
  Relative := IsRelative( S );
  if not Relative then
    Delete(S, 1, 1);
  TempKey := 0;
  if not CanCreate or (S = '') then
    Result := ( RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0, FRights, TempKey) = ERROR_SUCCESS )
  else
    Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
  if Result then
  begin
    if (CurrentKey <> 0) and Relative then
      S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
  end;
end;

function TRightsRegistry.KeyExists(const Key: string): Boolean;
var
  TempKey: HKEY;
begin
  TempKey := GetKey(Key);
  if TempKey <> 0 then
    RegCloseKey(TempKey);
  Result := TempKey <> 0;
end;

end.


