Delphi控件源码

开发平台：
C++ Builder

WINREG.PAS：源码内容
							unit WinReg;
// Title  : Access class for Windows registry
// Author : Dave White
// Date   : 24 April 1996
//
// Portions of this code are Copyright (c) Borland International, 1996
//
// This code is Freeware and may be used in any commercial or non-commercial applications
// at no charge.  Dave White shall not be liable in any way for any failure of this software,
// or any adverse effects it has on you application - you have the source :-)
interface
uses
  Windows, Classes, Messages, SysUtils, Registry;
type
  TWinRegistry = class(TRegistry)
  private
    FFileName: string;
  public
    // default constructor sets root key to HKEY_CURRENT_USER
    constructor Create(const FileName: string);
    // alternative constructor, allows user to specify the rootkey
    constructor CreateWithKey(key : HKEY; const FileName: string);
    function  ReadString(const Section, Ident, Default: string): string;
    function  ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    function  ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    function  ReadCurrency(const Section, Ident: string; Default: Currency): Currency;
    function  ReadBinaryData(const Section, Ident: string; var Buffer; BufSize: Integer): Integer;
    function  ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime;
    function  ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime;
    function  ReadFloat(const Section, Ident: string; Default: Double): Double;
    function  ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime;
    procedure WriteString(const Section, Ident, Value: String);
    procedure WriteInteger(const Section, Ident: string; Value: Longint);
    procedure WriteBool(const Section, Ident: string; Value: Boolean);
    procedure WriteCurrency(const Section, Ident: string; Value: Currency);
    procedure WriteBinaryData(const Section, Ident: string; var Buffer; BufSize: Integer);
    procedure WriteDate(const Section, Ident: string; Value: TDateTime);
    procedure WriteDateTime(const Section, Ident: string; Value: TDateTime);
    procedure WriteFloat(const Section, Ident: string; Value: Double);
    procedure WriteTime(const Section, Ident: string; Value: TDateTime);
    procedure ReadSection(const Section: string; Strings: TStrings);
    procedure ReadSections(Strings: TStrings);
    procedure ReadSectionValues(const Section: string; Strings: TStrings);
    procedure EraseSection(const Section: string);
    procedure DeleteKey(const Section, Ident: String);
    property  FileName: string read FFileName;
    function  SaveAppKey(key, filename : string): boolean;
  end;
implementation
constructor TWinRegistry.Create(const FileName: string);
begin
  inherited Create;
  FFileName := FileName;
  OpenKey(FileName, True);
end;
constructor TWinRegistry.CreateWithKey;
begin
  inherited Create;
  FFileName := FileName;
  RootKey := key;
  OpenKey(FileName, True);
end;
function TWinRegistry.ReadString(const Section, Ident, Default: string): string;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadString(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
procedure TWinRegistry.WriteString(const Section, Ident, Value: String);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteString(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
function TWinRegistry.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadInteger(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
procedure TWinRegistry.WriteInteger(const Section, Ident: string; Value: LongInt);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteInteger(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
function TWinRegistry.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadBool(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
procedure TWinRegistry.WriteBool(const Section, Ident: string; Value: Boolean);
const
  Values: array[Boolean] of string = ('0', '1');
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteBool(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
function TWinRegistry.ReadCurrency(const Section, Ident: string; Default: Currency): Currency;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadCurrency(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
function TWinRegistry.ReadBinaryData(const Section, Ident: string; var Buffer; BufSize: Integer): Integer;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadBinaryData(Ident, Buffer, BufSize) else
        Result := 0;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := 0;
end;
function TWinRegistry.ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadDate(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
function TWinRegistry.ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadDateTime(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
function TWinRegistry.ReadFloat(const Section, Ident: string; Default: Double): Double;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadFloat(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
function TWinRegistry.ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime;
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      if ValueExists(Ident) then
        Result := inherited ReadDateTime(Ident) else
        Result := Default;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end
  else Result := Default;
end;
procedure TWinRegistry.WriteCurrency(const Section, Ident: string; Value: Currency);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteCurrency(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.WriteBinaryData(const Section, Ident: string; var Buffer; BufSize: Integer);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteBinaryData(Ident, Buffer, BufSize);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.WriteDate(const Section, Ident: string; Value: TDateTime);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteDate(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.WriteDateTime(const Section, Ident: string; Value: TDateTime);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteDateTime(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.WriteFloat(const Section, Ident: string; Value: Double);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteFloat(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.WriteTime(const Section, Ident: string; Value: TDateTime);
var
  Key, OldKey: HKEY;
begin
  CreateKey(Section);
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited WriteTime(Ident, Value);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.ReadSection(const Section: string; Strings: TStrings);
var
  Key, OldKey: HKEY;
begin
  Key := GetKey(Section);
  if Key <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(Key);
    try
      inherited GetValueNames(Strings);
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(Key);
  end;
end;
procedure TWinRegistry.ReadSections(Strings: TStrings);
begin
  GetKeyNames(Strings);
end;
procedure TWinRegistry.ReadSectionValues(const Section: string; Strings: TStrings);
var
  KeyList: TStringList;
  I: Integer;
begin
  KeyList := TStringList.Create;
  try
    ReadSection(Section, KeyList);
    Strings.BeginUpdate;
    try
      for I := 0 to KeyList.Count - 1 do
        Strings.Values[KeyList[I]] := ReadString(Section, KeyList[I], '');
    finally
      Strings.EndUpdate;
    end;
  finally
    KeyList.Free;
  end;
end;
procedure TWinRegistry.EraseSection(const Section: string);
begin
  inherited DeleteKey(Section);
end;
procedure TWinRegistry.DeleteKey(const Section, Ident: String);
begin
  inherited DeleteValue(Ident);
end;
function TWinRegistry.SaveAppKey;
var
  OldKey: HKEY;
  sKey  : HKEY;
  temp  : integer;
begin
  result := false;
  sKey := GetKey(Key + '');
  if sKey <> 0 then
  try
    OldKey := CurrentKey;
    SetCurrentKey(sKey);
    try
      temp := RegSaveKey(sKey, PChar(fileName), nil);
      result := temp = ERROR_SUCCESS;
    finally
      SetCurrentKey(OldKey);
    end;
  finally
    RegCloseKey(skey);
  end;
end;
end.

						