jclregistry.pas

East make Tray Icon in delphi

begin
  RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value);
end;

procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: PMultiSz);
begin
  if DataType in [REG_BINARY, REG_MULTI_SZ] then
    InternalSetData(RootKey, Key, Name, DataType, Value,
      MultiSzLength(Value) * SizeOf(Char))
  else
    DataError(Key, Name);
end;

procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TStrings);
begin
  RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value);
end;

procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; const Value: TStrings);
var
  Dest: PMultiSz;
begin
  if DataType in [REG_BINARY, REG_MULTI_SZ] then
  begin
    StringsToMultiSz(Dest, Value);
    try
      RegWriteMultiSz(RootKey, Key, Name, DataType, Dest);
    finally
      FreeMultiSz(Dest);
    end;
  end
  else
    DataError(Key, Name);
end;

procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PWideMultiSz);
begin
  RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value);
end;

procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: PWideMultiSz);
begin
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    DataType := REG_BINARY;
  if DataType in [REG_BINARY, REG_MULTI_SZ] then
    InternalSetWideData(RootKey, Key, Name, DataType, Value,
      WideMultiSzLength(Value) * SizeOf(WideChar))
  else
    DataError(Key, Name);
end;

procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TWideStrings);
begin
  RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value);
end;

procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; const Value: TWideStrings);
var
  Dest: PWideMultiSz;
begin
  if DataType in [REG_BINARY, REG_MULTI_SZ] then
  begin
    WideStringsToWideMultiSz(Dest, Value);
    try
      RegWriteWideMultiSz(RootKey, Key, Name, DataType, Dest);
    finally
      FreeWideMultiSz(Dest);
    end;
  end
  else
    DataError(Key, Name);
end;

procedure RegWriteBinary(const RootKey: DelphiHKEY; const Key, Name: string; const Value; const ValueSize: Cardinal);
begin
  InternalSetData(RootKey, Key, Name, REG_BINARY, @Value, ValueSize);
end;

function UnregisterAutoExec(ExecKind: TExecKind; const Name: string): Boolean;
var
  Key: HKEY;
  RegPath: string;
begin
  Result := GetKeyAndPath(ExecKind, Key, RegPath);
  if Result then
    Result := RegDeleteEntry(Key, RegPath, Name);
end;

function RegisterAutoExec(ExecKind: TExecKind; const Name, Cmdline: string): Boolean;
var
  Key: HKEY;
  RegPath: string;
begin
  Result := GetKeyAndPath(ExecKind, Key, RegPath);
  if Result then
    RegWriteString(Key, RegPath, Name, Cmdline);
end;

function RegGetValueNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean;
var
  RegKey: HKEY;
  I: DWORD;
  Size: DWORD;
  NumSubKeys: DWORD;
  NumSubValues: DWORD;
  MaxSubValueLen: DWORD;
  ValueName: string;
begin
  Result := False;
  List.BeginUpdate;
  try
    List.Clear;
    if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
    begin
      if RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, @NumSubValues, @MaxSubValueLen, nil, nil, nil) = ERROR_SUCCESS then
      begin
        SetLength(ValueName, MaxSubValueLen + 1);
        if NumSubValues <> 0 then
          for I := 0 to NumSubValues - 1 do
          begin
            Size := MaxSubValueLen + 1;
            RegEnumValue(RegKey, I, PChar(ValueName), Size, nil, nil, nil, nil);
            List.Add(PChar(ValueName));
          end;
        Result := True;
      end;
      RegCloseKey(RegKey);
    end
    else
      ReadError(Key);
  finally
    List.EndUpdate;
  end;
end;

function RegGetKeyNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean;
var
  RegKey: HKEY;
  I: DWORD;
  Size: DWORD;
  NumSubKeys: DWORD;
  MaxSubKeyLen: DWORD;
  KeyName: string;
begin
  Result := False;
  List.BeginUpdate;
  try
    List.Clear;
    if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
    begin
      if RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil) = ERROR_SUCCESS then
      begin
        SetLength(KeyName, MaxSubKeyLen+1);
        if NumSubKeys <> 0 then
          for I := 0 to NumSubKeys-1 do
          begin
            Size := MaxSubKeyLen+1;
            RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil);
            List.Add(PChar(KeyName));
          end;
        Result := True;
      end;
      RegCloseKey(RegKey);
    end
    else
      ReadError(Key);
  finally
    List.EndUpdate;
  end;
end;

function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean;
var
  RegKey: HKEY;
  NumSubKeys: Integer;
begin
  Result := False;
  if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
  begin
    RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, nil, nil, nil, nil, nil);
    Result := NumSubKeys <> 0;
    RegCloseKey(RegKey);
  end
  else
    ReadError(Key);
end;

function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean;
var
  RegKey: HKEY;
begin
  Result := (RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS);
  if Result then
    RegCloseKey(RegKey);
end;

function RegSaveList(const RootKey: DelphiHKEY; const Key: string;
  const ListName: string; const Items: TStrings): Boolean;
var
  I: Integer;
  SubKey: string;
begin
  Result := False;
  SubKey := Key + '\' + ListName;
  if RegCreateKey(RootKey, SubKey) = ERROR_SUCCESS then
  begin
    // Save Number of strings
    RegWriteInteger(RootKey, SubKey, cItems, Items.Count);
    for I := 1 to Items.Count do
      RegWriteString(RootKey, SubKey, IntToStr(I), Items[I-1]);
    Result := True;
  end;
end;

function RegLoadList(const RootKey: DelphiHKEY; const Key: string;
  const ListName: string; const SaveTo: TStrings): Boolean;
var
  I, N: Integer;
  SubKey: string;
begin
  SaveTo.BeginUpdate;
  try
    SaveTo.Clear;
    SubKey := Key + '\' + ListName;
    N := RegReadInteger(RootKey, SubKey, cItems);
    for I := 1 to N do
      SaveTo.Add(RegReadString(RootKey, SubKey, IntToStr(I)));
    Result := N > 0;
  finally
    SaveTo.EndUpdate;
  end;
end;

function RegDelList(const RootKey: DelphiHKEY; const Key: string; const ListName: string): Boolean;
var
  I, N: Integer;
  SubKey: string;
begin
  Result := False;
  SubKey := Key + '\' + ListName;
  N := RegReadIntegerDef(RootKey, SubKey, cItems, -1);
  if (N > 0) and RegDeleteEntry(RootKey, SubKey, cItems) then
    for I := 1 to N do
    begin
      Result := RegDeleteEntry(RootKey, SubKey, IntToStr(I));
      if not Result then
        Break;
    end;
end;

function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: string): Boolean;
var
  WidePath: PWideChar;
  Len: Integer;
begin
  Result := Win32Platform <> VER_PLATFORM_WIN32_NT;
  if not Result then // Win 2000/XP
  begin
    case RootKey of
      HKLM:
        Path := 'HKEY_LOCAL_MACHINE\' + RelativeKey(RootKey, PChar(Path));
      HKCU:
        Path := 'HKEY_CURRENT_USER\' + RelativeKey(RootKey, PChar(Path));
      HKCR:
        Path := 'HKEY_CLASSES_ROOT\' + RelativeKey(RootKey, PChar(Path));
      HKUS:
        Path := 'HKEY_USERS\' + RelativeKey(RootKey, PChar(Path));
    end;
    Len := (Length(Path) + 1) * SizeOf(WideChar);
    GetMem(WidePath, Len);
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(Path), -1, WidePath, Len);
    Result := RtdlSetNamedSecurityInfoW(WidePath, SE_REGISTRY_KEY,
      DACL_SECURITY_INFORMATION, nil, nil, nil, nil) = ERROR_SUCCESS;
    FreeMem(WidePath);
  end;
end;

// History:

// $Log: JclRegistry.pas,v $
// Revision 1.36  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.35  2005/02/25 07:20:16  marquardt
// add section lines
//
// Revision 1.34  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.33  2005/02/22 07:36:46  marquardt
// minor cleanups
//
// Revision 1.32  2005/02/20 13:09:52  marquardt
// Win 9x bugfixes
//
// Revision 1.31  2004/11/06 02:13:31  mthoma
// history cleaning.
//
// Revision 1.30  2004/10/25 15:05:13  marquardt
// bugfix
//
// Revision 1.29  2004/10/25 08:51:22  marquardt
// PH cleaning
//
// Revision 1.28  2004/10/22 15:47:15  marquardt
// add functions for Single, Double, Extended
//
// Revision 1.27  2004/10/21 06:38:53  marquardt
// style clenaing, bugfixes, improvements
//
// Revision 1.26  2004/10/20 17:13:53  rrossmair
// - fixed RegReadUInt64 (DataType undefined)
//
// Revision 1.25  2004/10/20 16:57:32  rrossmair
// - RegReadUInt64: D7 internal error C1118 workaround
//
// Revision 1.24  2004/10/19 06:27:03  marquardt
// JclRegistry extended, JclNTFS made compiling, JclDateTime style cleaned
//
// Revision 1.23  2004/10/18 16:22:14  marquardt
// JclRegistry redesign to remove PH contributor
//
// Revision 1.22  2004/10/17 21:00:15  mthoma
// cleaning
//
// Revision 1.21  2004/10/11 08:13:04  marquardt
// PH cleaning of JclStrings
//
// Revision 1.20  2004/09/30 07:50:29  marquardt
// remove PH contributions
//
// Revision 1.19  2004/07/31 06:21:03  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved
//
// Revision 1.18  2004/07/28 18:00:53  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.17  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.16  2004/06/14 11:05:53  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.15  2004/05/31 22:45:07  rrossmair
// rollback to rev. 1.13 state
//
// Revision 1.13  2004/05/19 21:43:36  rrossmair
// processed help TODOs
//
// Revision 1.12  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.11  2004/04/12 22:02:53  
// Bugfix RegReadBinary for @Value = Nil or ValueSize = 0,
// add some WideString support, add RegGetDataSize, RegGetDataType, add alternative RegReadBinary function
//
// Revision 1.10  2004/04/08 13:46:38  ahuser
// BCB 6 compatible (no impact on Delphi)
//
// Revision 1.9  2004/04/08 10:34:58  rrossmair
// revert to 1.7 (temporarily?)
//
// Revision 1.7  2004/04/06 05:56:10  rrossmair
// fixed RegReadUInt64 & RegReadUInt64Def
//
// Revision 1.6  2004/04/06 04:45:57  
// Unite the single read functions and the single write functions, add Cardinal,
// Int64, UInt64 and Multistring support

end.