jvqappregistrystorage.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvAppRegistryStorage.pas, released on --.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2002 - 2003 Marcel
Bestebroer
All Rights Reserved.

Contributor(s):
  Jens Fudickar
  Hofi

Last Modified: 2004-10-11

Changes:
2004-10-11:      by Hofi
  * Changed
      in class
        TJvAppRegistryStorage
          Root can be set to 'Software\%COMPANY_NAME%\%APPL_NAME%' by default
            via UseOldDefaultRoot property, just like earlier in the original
            RX TFormStorage version. (see below what %APPL_NAME% and %COMPANY_NAME% is)
            You can use
              - '%NONE%' to sign an empty Root
                (design time empty value or spaces automatically converted)
              - '%APPL_NAME%' to sign in Root a new path element equal to Application name
              - '%COMPANY_NAME%' to sign in Root a new path element equal to DefCompanyName
          Create(AOwner: TComponent);
  * Added
      to class
        TJvAppRegistryStorage
          property UseOldDefaultRoot:
          procedure Loaded; override;
          procedure SetRoot(const Value: string);
          procedure SetUseOldDefaultRoot(Value: Boolean);

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQAppRegistryStorage.pas,v 1.20 2005/03/08 08:38:33 marquardt Exp $

unit JvQAppRegistryStorage;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  Windows, Classes, QForms,
  JvQAppStorage, JvQTypes, JvQJVCLUtils;

type
  TJvAppRegistryStorage = class(TJvCustomAppStorage)
  private
    FRegHKEY: HKEY;
    FUseOldDefaultRoot: Boolean;
    FAppNameErrorHandled: Boolean;
    FCompanyNameErrorHandled: Boolean;
  protected
    procedure Loaded; override;

    function GetRegRoot: TJvRegKey;
    procedure SetRegRoot(Value: TJvRegKey);
    procedure SetRoot(const Value: string);
    procedure SetUseOldDefaultRoot(Value: Boolean);

    { Create the registry key path if it doesn't exist yet. Any key in the path that doesn't exist
      is created. }
    procedure CreateKey(Key: string);

    procedure EnumFolders(const Path: string; const Strings: TStrings;
      const ReportListAsValue: Boolean = True); override;
    procedure EnumValues(const Path: string; const Strings: TStrings;
      const ReportListAsValue: Boolean = True); override;

    function IsFolderInt(const Path: string; ListIsValue: Boolean = True): Boolean; override;
    function PathExistsInt(const Path: string): Boolean; override;
    function ValueStoredInt(const Path: string): Boolean; override;
    procedure DeleteValueInt(const Path: string); override;
    procedure DeleteSubTreeInt(const Path: string); override;

    function DoReadBoolean(const Path: string; Default: Boolean): Boolean; override;
    procedure DoWriteBoolean(const Path: string; Value: Boolean); override;
    function DoReadInteger(const Path: string; Default: Integer): Integer; override;
    procedure DoWriteInteger(const Path: string; Value: Integer); override;
    function DoReadFloat(const Path: string; Default: Extended): Extended; override;
    procedure DoWriteFloat(const Path: string; Value: Extended); override;
    function DoReadString(const Path: string; const Default: string): string; override;
    procedure DoWriteString(const Path: string; const Value: string); override;
    function DoReadBinary(const Path: string; Buf: Pointer; BufSize: Integer): Integer; override;
    procedure DoWriteBinary(const Path: string; Buf: Pointer; BufSize: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property RegRoot: TJvRegKey read GetRegRoot write SetRegRoot default hkCurrentUser;
    property Root read GetRoot write SetRoot;
    property SubStorages;
    property UseOldDefaultRoot: Boolean read FUseOldDefaultRoot write SetUseOldDefaultRoot stored True default False ;

    property ReadOnly;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, QDialogs,
  JclRegistry, JclResources, JclStrings, JclFileUtils,
  JvQConsts, JvQResources;

const
  cCount = 'Count';
  cSoftwareKey = 'Software';
  cNoRootMask = '%NONE%';
  cAppNameMask = '%APPL_NAME%';
  cCompanyNameMask = '%COMPANY_NAME%';
  cOldDefaultRootMask =  cSoftwareKey + '\' + cCompanyNameMask + '\' + cAppNameMask;
  cDefaultAppName = 'MyJVCLApplication';
  cDefaultCompanyName = 'MyCompany';

{ (rom) disabled unused
const
  HKEY_Names: array [HKEY_CLASSES_ROOT..HKEY_DYN_DATA, 0..1] of PChar =
   (
    ('HKEY_CLASSES_ROOT', 'HKCR'),
    ('HKEY_CURRENT_USER', 'HKCU'),
    ('HKEY_LOCAL_MACHINE', 'HKLM'),
    ('HKEY_USERS', 'HKU'),
    ('HKEY_PERFORMANCE_DATA', 'HKPD'),
    ('HKEY_CURRENT_CONFIG', 'HKCC'),
    ('HKEY_DYN_DATA', 'HKDD')
   );
}

//=== { TJvAppRegistryStorage } ==============================================

constructor TJvAppRegistryStorage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRegHKEY := HKEY_CURRENT_USER;
  FUseOldDefaultRoot := False;
  FAppNameErrorHandled := False;
  FCompanyNameErrorHandled := False;
end;

procedure TJvAppRegistryStorage.SetRoot(const Value: string);
var
  S: string;
  HelpName: string;

  function GetVersionInfoAppName: string;
  var
    VersionInfo: TJclFileVersionInfo;
  begin
    try
      VersionInfo := TJclFileVersionInfo.Create(Application.ExeName);
      try
        Result := VersionInfo.ProductName;
      finally
        VersionInfo.Free;
      end;
    except
      on EJclFileVersionInfoError do
        begin
          if not FAppNameErrorHandled then
          begin
            MessageDlg(Format(RsRootValueReplaceFmt, [cAppNameMask, cDefaultAppName]), mtInformation, [mbOK], 0);
            FAppNameErrorHandled := True;
          end;
          Result := cDefaultAppName;
        end
      else
        raise;
    end;
  end;

  function GetVersionInfoCompanyName: string;
  var
    VersionInfo: TJclFileVersionInfo;
  begin
    try
      VersionInfo := TJclFileVersionInfo.Create(Application.ExeName);
      try
        Result := VersionInfo.CompanyName;
      finally
        VersionInfo.Free;
      end;
    except
      on EJclFileVersionInfoError do
        begin
          if not FCompanyNameErrorHandled then
          begin
            MessageDlg(Format(RsRootValueReplaceFmt, [cCompanyNameMask, cDefaultCompanyName]), mtInformation, [mbOK], 0);
            FCompanyNameErrorHandled := True;
          end;
          Result := cDefaultCompanyName;
        end
      else
        raise;
    end;
  end;

begin
  inherited SetRoot(Value);
  if csDesigning in ComponentState then
  begin
    if Value <> cOldDefaultRootMask then
      FUseOldDefaultRoot := False;
    if GetRoot = '' then
      SetRoot(cNoRootMask);
  end
  else
  begin
    { this makes GetDefaultIniRegKey unnecessary ?!?! }
    if GetRoot = cNoRootMask then
      SetRoot('')
    else
    if StrFind(cAppNameMask, GetRoot) <> 0 then
    begin
      HelpName := GetVersionInfoAppName;
      if HelpName = '' then
        HelpName := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
      S := GetRoot;
      StrReplace(S, cAppNameMask, HelpName, [rfIgnoreCase]);
      SetRoot(S);
    end
    else
      if StrFind(cCompanyNameMask, GetRoot) <> 0 then
      begin
        HelpName := GetVersionInfoCompanyName;
        if HelpName = '' then
          HelpName := DefCompanyName;
        S := GetRoot;
        StrReplace(S, cCompanyNameMask, HelpName, [rfIgnoreCase]);
        SetRoot(S);
      end;
  end;
end;

procedure TJvAppRegistryStorage.Loaded;
begin
  inherited Loaded;
  SetUseOldDefaultRoot(UseOldDefaultRoot);
  SetRoot(GetRoot);
end;

procedure TJvAppRegistryStorage.SetUseOldDefaultRoot(Value: Boolean);
begin
  FUseOldDefaultRoot := Value;
  if FUseOldDefaultRoot then
    SetRoot(cOldDefaultRootMask);
end;

function TJvAppRegistryStorage.GetRegRoot: TJvRegKey;
begin
  Result := TJvRegKey(FRegHKEY - HKEY_CLASSES_ROOT);
end;

procedure TJvAppRegistryStorage.SetRegRoot(Value: TJvRegKey);
begin
  if Value <> RegRoot then
    FRegHKEY := HKEY_CLASSES_ROOT + Longword(Ord(Value));
end;

procedure TJvAppRegistryStorage.CreateKey(Key: string);
var
  ResKey: HKEY;
begin
  if not RegKeyExists(FRegHKEY, Key) then
    if Windows.RegCreateKey(FRegHKEY, PChar(Key), ResKey) = ERROR_SUCCESS then
      RegCloseKey(ResKey)
    else
      raise EJVCLException.CreateResFmt(@RsEUnableToCreateKey, [Key]);
end;

procedure TJvAppRegistryStorage.EnumFolders(const Path: string; const Strings: TStrings;
  const ReportListAsValue: Boolean);
var
  Key: string;