jclregistry.pas

East make Tray Icon in delphi

function InternalGetString(const RootKey: DelphiHKEY; const Key, Name: string; MultiFlag: Boolean): string;
var
  RegKey: HKEY;
  DataType, DataSize: DWORD;
  RegKinds: TRegKinds;
begin
  DataType := REG_NONE;
  DataSize := 0;
  Result := '';
  if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
    try
      if RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then
      begin
        RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ];
        if MultiFlag then
          RegKinds := RegKinds + [REG_MULTI_SZ];
        if not (DataType in RegKinds) then
          DataError(Key, Name);
        SetLength(Result, DataSize div SizeOf(Char) + 1);
        if RegQueryValueEx(RegKey, PChar(Name), nil, nil, Pointer(Result), @DataSize) <> ERROR_SUCCESS then
        begin
          Result := '';
          ValueError(Key, Name);
        end;
        SetLength(Result, (DataSize - 1) div SizeOf(Char));
      end
      else
        ValueError(Key, Name);
    finally
      RegCloseKey(RegKey);
    end
  else
    ReadError(Key);
end;

function InternalGetWideString(const RootKey: DelphiHKEY; const Key, Name: string; MultiFlag: Boolean): WideString;
var
  RegKey: HKEY;
  DataType, DataSize: DWORD;
  RegKinds: TRegKinds;
begin
  DataType := REG_NONE;
  DataSize := 0;
  Result := '';
  if InternalRegOpenKeyEx(RootKey, PChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
    try
      if InternalRegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then
      begin
        if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
          RegKinds := [REG_BINARY]
        else
        if MultiFlag then
          RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ]
        else
          RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ];
        if not (DataType in RegKinds) then
          DataError(Key, Name);
        SetLength(Result, DataSize div SizeOf(WideChar) + 1);
        if InternalRegQueryValueEx(RegKey, PChar(Name), nil, nil, Pointer(Result), @DataSize) <> ERROR_SUCCESS then
        begin
          Result := '';
          ValueError(Key, Name);
        end;
        SetLength(Result, (DataSize - 1) div SizeOf(WideChar));
      end
      else
        ValueError(Key, Name);
    finally
      RegCloseKey(RegKey);
    end
  else
    ReadError(Key);
end;

procedure InternalSetData(const RootKey: DelphiHKEY; const Key, Name: string;
  RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal);
var
  RegKey: HKEY;
begin
  if not RegKeyExists(RootKey, Key) then
    RegCreateKey(RootKey, Key);
  if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then
    try
      if RegSetValueEx(RegKey, PChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then
      WriteError(Key);
    finally
      RegCloseKey(RegKey);
    end
  else
    WriteError(Key);
end;

procedure InternalSetWideData(const RootKey: DelphiHKEY; const Key, Name: string;
  RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal);
var
  RegKey: HKEY;
begin
  if not RegKeyExists(RootKey, Key) then
    RegCreateKey(RootKey, Key);
  if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then
    try
      if InternalRegSetValueEx(RegKey, PChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then
        WriteError(Key);
    finally
      RegCloseKey(RegKey);
    end
  else
    WriteError(Key);
end;

//=== Registry ===============================================================

function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint;
var
  RegKey: HKEY;
begin
  Result := Windows.RegCreateKey(RootKey, RelativeKey(RootKey, PChar(Key)), RegKey);
  if Result = ERROR_SUCCESS then
    RegCloseKey(RegKey);
end;

function RegCreateKey(const RootKey: DelphiHKEY; const Key, Value: string): Longint;
begin
  Result := RegSetValue(RootKey, RelativeKey(RootKey, PChar(Key)), REG_SZ, PChar(Value), Length(Value));
end;

function RegDeleteEntry(const RootKey: DelphiHKEY; const Key, Name: string): Boolean;
var
  RegKey: HKEY;
begin
  Result := False;
  if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_SET_VALUE, RegKey) = ERROR_SUCCESS then
  begin
    Result := RegDeleteValue(RegKey, PChar(Name)) = ERROR_SUCCESS;
    RegCloseKey(RegKey);
    if not Result then
      ValueError(Key, Name);
  end
  else
    WriteError(Key);
end;

function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean;
var
  RegKey: HKEY;
  I: DWORD;
  Size: DWORD;
  NumSubKeys: DWORD;
  MaxSubKeyLen: DWORD;
  KeyName: string;
begin
  Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS;
  if Result then
  begin
    RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil);
    if NumSubKeys <> 0 then
      for I := NumSubKeys - 1 downto 0 do
      begin
        Size := MaxSubKeyLen+1;
        SetLength(KeyName, Size);
        RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil);
        SetLength(KeyName, StrLen(PChar(KeyName)));
        Result := RegDeleteKeyTree(RootKey, Key + '\' + KeyName);
        if not Result then
          Break;
      end;
    RegCloseKey(RegKey);
    if Result then
      Result := Windows.RegDeleteKey(RootKey, RelativeKey(RootKey, PChar(Key))) = ERROR_SUCCESS;
    end
    else
      WriteError(Key);
end;

function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string;
  out DataSize: Cardinal): Boolean;
var
  RegKey: HKEY;
begin
  DataSize := 0;
  Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
  if Result then
  begin
    Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, @DataSize) = ERROR_SUCCESS;
    RegCloseKey(RegKey);
  end;
end;

function RegGetDataType(const RootKey: DelphiHKEY; const Key, Name: string;
  out DataType: DWORD): Boolean;
var
  RegKey: HKEY;
begin
  DataType := REG_NONE;
  Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
  if Result then
  begin
    Result := RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, nil) = ERROR_SUCCESS;
    RegCloseKey(RegKey);
  end;
end;

function RegReadBool(const RootKey: DelphiHKEY; const Key, Name: string): Boolean;
begin
  Result := RegReadInteger(RootKey, Key, Name) <> 0;
end;

function RegReadBoolDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Boolean): Boolean;
begin
  Result := RegReadIntegerDef(RootKey, Key, Name, Ord(Def)) <> 0;
end;

function RegReadInteger(const RootKey: DelphiHKEY; const Key, Name: string): Integer;
var
  DataType, DataSize: DWORD;
  Ret: Int64;
begin
  Ret := 0;
  RegGetDataType(RootKey, Key, Name, DataType);
  if DataType in [REG_SZ, REG_EXPAND_SZ] then
    Ret := StrToInt64(RegReadString(RootKey, Key, Name))
  else
    InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD],
      SizeOf(Ret), DataType, @Ret, DataSize);
  Result := Ret and $FFFFFFFF;
end;

function RegReadIntegerDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Integer): Integer;
begin
  try
    Result := RegReadInteger(RootKey, Key, Name);
  except
    Result := Def;
  end;
end;

function RegReadCardinal(const RootKey: DelphiHKEY; const Key, Name: string): Cardinal;
var
  DataType, DataSize: DWORD;
  Ret: Int64;
begin
  Ret := 0;
  RegGetDataType(RootKey, Key, Name, DataType);
  if DataType in [REG_SZ, REG_EXPAND_SZ] then
    Ret := StrToInt64(RegReadString(RootKey, Key, Name))
  else
    InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD],
      SizeOf(Ret), DataType, @Ret, DataSize);
  Result := Ret and $FFFFFFFF;
end;

function RegReadCardinalDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Cardinal): Cardinal;
begin
  try
    Result := RegReadCardinal(RootKey, Key, Name);
  except
    Result := Def;
  end;
end;

function RegReadDWORD(const RootKey: DelphiHKEY; const Key, Name: string): DWORD;
begin
  Result := RegReadCardinal(RootKey, Key, Name);
end;

function RegReadDWORDDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: DWORD): DWORD;
begin
  Result := RegReadCardinalDef(RootKey, Key, Name, Def);
end;

function RegReadInt64(const RootKey: DelphiHKEY; const Key, Name: string): Int64;
var
  DataType, DataSize: DWORD;
  Data: array [0..1] of Integer;
  Ret: Int64;
begin
  RegGetDataType(RootKey, Key, Name, DataType);
  if DataType in [REG_SZ, REG_EXPAND_SZ] then
  begin
    // (rom) circumvents internal compiler error for D6
    Ret := StrToInt64(RegReadString(RootKey, Key, Name));
    Result := Ret;
  end
  else
  begin
    FillChar(Data[0], SizeOf(Data), 0);
    InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD],
       SizeOf(Data), DataType, @Data, DataSize);
    // REG_BINARY is implicitly unsigned if DataSize < 8
    if DataType = REG_DWORD then
      // DWORDs get sign extended
      Result := Data[0]
    else
      Move(Data[0], Result, SizeOf(Data));
  end;
end;

function RegReadInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: Int64): Int64;
begin
  try
    Result := RegReadInt64(RootKey, Key, Name);
  except
    Result := Def;
  end;
end;

function RegReadUInt64(const RootKey: DelphiHKEY; const Key, Name: string): UInt64;
var
  DataType, DataSize: DWORD;
  Ret: Int64;
begin
  RegGetDataType(RootKey, Key, Name, DataType);
  if DataType in [REG_SZ, REG_EXPAND_SZ] then
  begin
    // (rom) circumvents internal compiler error for D6
    Ret := StrToInt64(RegReadString(RootKey, Key, Name));
    Result := UInt64(Ret);
  end
  else
  begin
    // type cast required to circumvent internal error in D7
    Result := UInt64(0);
    InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD],
      SizeOf(Result), DataType, @Result, DataSize);
  end;
end;

function RegReadUInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: UInt64): UInt64;
begin
  try
    Result := RegReadUInt64(RootKey, Key, Name);
  except
    Result := Def;
  end;
end;

function RegReadSingle(const RootKey: DelphiHKEY; const Key, Name: string): Single;
var
  DataType, DataSize: DWORD;
  OldSep: Char;
begin
  RegGetDataType(RootKey, Key, Name, DataType);
  OldSep := DecimalSeparator;
  if DataType in [REG_SZ, REG_EXPAND_SZ] then
    try
      DecimalSeparator := '.';
      Result := StrToFloat(RegReadString(RootKey, Key, Name));
    finally
      DecimalSeparator := OldSep;
    end
  else
    InternalGetData(RootKey, Key, Name, [REG_BINARY],
      SizeOf(Result), DataType, @Result, DataSize);
end;

function RegReadSingleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Single): Single;
begin
  try
    Result := RegReadSingle(RootKey, Key, Name);
  except
    Result := Def;
  end;
end;

function RegReadDouble(const RootKey: DelphiHKEY; const Key, Name: string): Double;
var
  DataType, DataSize: DWORD;
  OldSep: Char;
begin
  RegGetDataType(RootKey, Key, Name, DataType);
  OldSep := DecimalSeparator;