reg.pas

Delphi的另一款钢琴软件

unit Reg;

interface

uses SysUtils, Classes, Windows;

type
TReg = class
private
  fKey : HKey;
  root : HKey;

public
  constructor Create (rt : HKey; path : string; allowCreate : boolean);
  destructor Destroy; override;
  procedure WriteString (name : string; value : string);
  function ReadStringDef (name : string; default : string) : string;

  procedure WriteInteger (name : string; value : Integer);
  function ReadIntegerDef (name : string; default : Integer) : Integer;

  procedure WriteBoolean (name : string; value : Boolean);
  function ReadBooleanDef (name : string; default : Boolean ) : Boolean;

  procedure DeleteValue (name: string);

  property Key : HKey read fKey;
end;

implementation

constructor TReg.Create (rt : HKey; path : string; allowCreate : boolean);
var
  res, disposition : Integer;
begin
  root := rt;
  if allowCreate then
    res := RegCreateKeyEx (root, PChar (path), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, Nil, Fkey, @disposition)
  else
    res := RegOpenKeyEx (root, PChar (path), 0, KEY_READ or KEY_WRITE, fKey);

  if res <> ERROR_SUCCESS then
    raise Exception.CreateFmt ('Error %d opening registry key %s', [res, path]);
end;

destructor TReg.Destroy;
begin
  RegCloseKey (fKey);
end;

procedure TReg.WriteString (name : string; value : string);
var res : Integer;
begin
  res := RegSetValueEx (fKey, PChar (name), 0, REG_SZ, @value [1], Length (value) + 1);
  if res <> ERROR_SUCCESS then
    raise Exception.CreateFmt ('Error %d writing registry value %s', [res, name]);
end;

function TReg.ReadStringDef (name : string; default : string) : string;
var
  valueType, len, res : Integer;
  value : string;

begin
  len := 256;
  SetLength (value, len - 1);

  res := RegQueryValueEx (fKey, PChar (name), Nil, @valueType, @value [1], @len);
  if res = ERROR_MORE_DATA then
  begin
    SetLength (value, len - 1);
    res := RegQueryValueEx (fKey, PChar (name), Nil, @valueType, @value [1], @len)
  end
  else SetLength (value, len - 1);

  if res <> ERROR_SUCCESS then
    result := default
  else
    result := value
end;

procedure TReg.WriteInteger (name : string; value : Integer);
var res : Integer;
begin
  res := RegSetValueEx (fKey, PChar (name), 0, REG_DWORD, @value, sizeof (value));
  if res <> ERROR_SUCCESS then
    raise Exception.CreateFmt ('Error %d writing registry value %s', [res, name]);
end;

function TReg.ReadIntegerDef (name : string; default : Integer) : Integer;
var value, valueType, len : Integer;
begin
  len := sizeof (value);
  if RegQueryValueEx (fKey, PChar (name), Nil, @valueType, @value, @len) = ERROR_SUCCESS then
    result := value
  else
    result := default
end;

procedure TReg.WriteBoolean (name : string; value : Boolean);
var
 val : Integer;
begin
  val := Ord (value);
  WriteInteger (name, val);
end;

function TReg.ReadBooleanDef (name : string; default : Boolean) : boolean;
var value, len, valueType : Integer;
begin
  len := sizeof (value);
  if RegQueryValueEx (fKey, PChar (name), Nil, @valueType, @value, @len) = ERROR_SUCCESS then
    result := value <> 0
  else
    result := default
end;

procedure TReg.DeleteValue (name: string);
var res : Integer;
begin
  res := RegDeleteValue (fKey, PChar (name));
  if res <> ERROR_SUCCESS then
    raise Exception.CreateFmt ('Error %d deleting registry value %s', [res, name]);
end;

end.