untRegistry by ErazerZ

{

  Unit Registry by ErazerZ

  19. Februar 2006

  Requires: untUtils (by ErazerZ)

}

unit untRegistry;

interface

uses Windows, untUtils;

function HKEYToStr(hkKey: HKEY): String;

function StrToHKEY(sKey: String): HKEY;

function _regCreateKey(hkKey: HKEY; lpSubKey: PChar): Boolean;

function _regDeleteKey(hkKey: HKEY; lpSubKey: PChar): Boolean;

function _regCreateValue(hkKey: HKEY; lpSubKey, lpValueName: PChar; lpType: DWORD): Boolean;

function _regValueExists(hkKey: HKEY; lpSubKey, lpValueName: PChar): Boolean;

function _regRenameValue(hkKey: HKEY; lpSubKey, lpValueName, lpNewValueName: PChar): Boolean;

function _regDeleteValue(hkKey: HKEY; lpSubKey, lpValueName: PChar): Boolean;

function _regSetValue(hkKey: HKEY; lpSubKey, lpValueName: PChar; NewValue: Pointer; cbLength: DWORD; lpType: DWORD = DWORD(-1)): Boolean;

function _regMultiString(hkKey: HKEY; lpSubKey, lpValueName: PChar): String;

function _regQueryValue(var phkResult: HKEY; lpValueName: PChar; lpType: DWORD = REG_NONE): String;

function _regQueryValueType(var phkResult: HKEY; lpValueName: PChar): String;

function _regEnumKeys(hkKey: HKEY; lpSubKey: PChar): String;

function _regEnumValues(hkKey: HKEY; lpSubKey: PChar): String;

implementation

type

  PByteArray = ^TByteArray;

  TByteArray = array[0..32767] of Byte;

function HKEYToStr(hkKey: HKEY): String;

begin

  case hkKey of

    HKEY_CLASSES_ROOT: Result := 'HKEY_CLASSES_ROOT';

    HKEY_CURRENT_USER: Result := 'HKEY_CURRENT_USER';

    HKEY_LOCAL_MACHINE: Result := 'HKEY_LOCAL_MACHINE';

    HKEY_USERS: Result := 'HKEY_USERS';

    HKEY_CURRENT_CONFIG: Result := 'HKEY_CURRENT_CONFIG';

  end;

end;

function StrToHKEY(sKey: String): HKEY;

begin

  Result := DWORD(-1);

  if sKey = '' then Exit;

  sKey := CharUpper(PChar(sKey));

  if sKey = 'HKEY_CLASSES_ROOT' then

    Result := HKEY_CLASSES_ROOT

  else if sKey = 'HKEY_CURRENT_USER' then

    Result := HKEY_CURRENT_USER

  else if sKey = 'HKEY_LOCAL_MACHINE' then

    Result := HKEY_LOCAL_MACHINE

  else if sKey = 'HKEY_USERS' then

    Result := HKEY_USERS

  else if sKey = 'HKEY_CURRENT_CONFIG' then

    Result := HKEY_CURRENT_CONFIG

end;

function _regCreateKey(hkKey: HKEY; lpSubKey: PChar): Boolean;

var

  phkResult: HKEY;

begin

  Result := RegCreateKey(hkKey, lpSubKey, phkResult) = ERROR_SUCCESS;

  RegCloseKey(phkResult);

end;

function _regDeleteKey(hkKey: HKEY; lpSubKey: PChar): Boolean;

begin

  Result := RegDeleteKey(hkKey, lpSubKey) = ERROR_SUCCESS;

end;

function _regCreateValue(hkKey: HKEY; lpSubKey, lpValueName: PChar; lpType: DWORD): Boolean;

var

  phkResult: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ or KEY_SET_VALUE, phkResult) = ERROR_SUCCESS then

  begin

    Result := RegSetValueEx(phkResult, lpValueName, 0, lpType, nil, 0) = ERROR_SUCCESS;

    RegCloseKey(phkResult);

  end;

end;

function _regValueExists(hkKey: HKEY; lpSubKey, lpValueName: PChar): Boolean;

var

  phkResult: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ, phkResult) = ERROR_SUCCESS then

  begin

    Result := RegQueryValueEx(phkResult, lpValueName, nil, nil, nil, nil) = ERROR_SUCCESS;

    RegCloseKey(phkResult);

  end;

end;

function _regRenameValue(hkKey: HKEY; lpSubKey, lpValueName, lpNewValueName: PChar): Boolean;

var

  phkResult: HKEY;

  lpData: Pointer;

  lpcbData, lpType: DWORD;

begin

  Result := False;

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ or KEY_SET_VALUE, phkResult) = ERROR_SUCCESS then

  begin

    if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, nil, @lpcbData) = ERROR_SUCCESS then

    begin

      GetMem(lpData, lpcbData);

      if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, lpData, @lpcbData) = ERROR_SUCCESS then

        if RegSetValueEx(phkResult, lpNewValueName, 0, lpType, lpData, lpcbData) = ERROR_SUCCESS then

          Result := RegDeleteValue(phkResult, lpValueName) = ERROR_SUCCESS;

      FreeMem(lpData, lpcbData);

    end;

    RegCloseKey(phkResult);

  end;

end;

function _regDeleteValue(hkKey: HKEY; lpSubKey, lpValueName: PChar): Boolean;

var

  phkResult: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_SET_VALUE, phkResult) = ERROR_SUCCESS then

  begin

    Result := RegDeleteValue(phkResult, lpValueName) = ERROR_SUCCESS;

    RegCloseKey(phkResult);

  end;

end;

function _regSetValue(hkKey: HKEY; lpSubKey, lpValueName: PChar; NewValue: Pointer; cbLength: DWORD; lpType: DWORD = DWORD(-1)): Boolean;

  function __regSetValue(hhkKey: HKEY; llpType: DWORD): Boolean;

  begin

    Result := False;

    if llpType = REG_DWORD then

      Result := RegSetValueEx(hhkKey, lpValueName, 0, llpType, NewValue, sizeof(DWORD)) = ERROR_SUCCESS

    else

    if (llpType = REG_SZ) or (llpType = REG_EXPAND_SZ) or (llpType = REG_MULTI_SZ) or (llpType = REG_BINARY) then

      Result := RegSetValueEx(hhkKey, lpValueName, 0, llpType, NewValue, cbLength) = ERROR_SUCCESS

  end;

var

  phkResult: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ or KEY_SET_VALUE, phkResult) = ERROR_SUCCESS then

  begin

    if lpType = DWORD(-1) then

    begin

      if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, nil, nil) = ERROR_SUCCESS then

        Result := __regSetValue(phkResult, lpType)

      else

        Result := __regSetValue(phkResult, REG_SZ);

    end else

      Result := __regSetValue(phkResult, lpType);

    RegCloseKey(phkResult);

  end;

end;

function _regMultiString(hkKey: HKEY; lpSubKey, lpValueName: PChar): String;

var

  phkResult: HKEY;

  lpData: Pointer;

  lpcbData, lpType: DWORD;

begin

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ, phkResult) = ERROR_SUCCESS then

  begin

    if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, nil, @lpcbData) = ERROR_SUCCESS then

    begin

      GetMem(lpData, lpcbData);

      if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, lpData, @lpcbData) = ERROR_SUCCESS then

      begin

        Dec(lpcbData);

        SetLength(Result, lpcbData);

        CopyMemory(@Result[1], lpData, lpcbData);

        ReplaceChar(Result, #0, #13);

      end

    end;

    RegCloseKey(phkResult);

  end;

end;

function _regQueryValue(var phkResult: HKEY; lpValueName: PChar; lpType: DWORD = REG_NONE): String;

var

  i: Integer;

  lpData: Pointer;

  lpcbData, dwResult: DWORD;

  sResult: String;

  lpResult: PByteArray;

begin

  Result := '';

  if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, nil, @lpcbData) = ERROR_SUCCESS then

  begin

    GetMem(lpData, lpcbData);

    if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, lpData, @lpcbData) = ERROR_SUCCESS then

    begin

      { strings }

      if (lpType = REG_SZ) or (lpType = REG_EXPAND_SZ) or (lpType = REG_MULTI_SZ) then

      begin

        Dec(lpcbData);

        SetLength(sResult, lpcbData);

        CopyMemory(@sResult[1], lpData, lpcbData);

        ReplaceChar(sResult, #0, ' '); { for MULTI SZ, Removes #0 }

        Result := sResult;

      end else

      { dword }

      if (lpType = REG_DWORD) then

      begin

        CopyMemory(@dwResult, lpData, lpcbData);

        Result := '0x' + IntToHex(dwResult, 8) + ' (' + IntToStr(dwResult) + ')';

      end else

      { binary }

      if (lpType = REG_BINARY) then

      begin

        if lpcbData <> 0 then

        begin

          GetMem(lpResult, lpcbData);

          CopyMemory(lpResult, lpData, lpcbData);

          for i := 0 to lpcbData do

            Result := Result + IntToHex(lpResult[i], 2) + ' ';

          // there are always some unused bytes at end, remove them ..

          Delete(Result, Length(Result) -3, 4);

          FreeMem(lpResult, lpcbData);

        end else

          Result := '(Zero Binary Value)';

      end else

      { none }

      if (lpType = REG_NONE) then

      begin

        Result := '(Value not set)';

      end;

    end;

    FreeMem(lpData, lpcbData);

  end;

end;

{ phkResult must be open with KEY_READ }

function _regQueryValueType(var phkResult: HKEY; lpValueName: PChar): String;

var

  lpType: DWORD;

begin

  if RegQueryValueEx(phkResult, lpValueName, nil, @lpType, nil, nil) <> ERROR_SUCCESS then

    lpType := REG_NONE;

  case lpType of

    REG_NONE: Result := 'REG_NONE';

    REG_SZ: Result := 'REG_SZ';

    REG_EXPAND_SZ: Result := 'REG_EXPAND_SZ';

    REG_BINARY: Result := 'REG_BINARY';

    REG_DWORD: Result := 'REG_DWORD';

    REG_DWORD_BIG_ENDIAN: Result := 'REG_DWORD_BIG_ENDIAN';

    REG_LINK: Result := 'REG_LINK';

    REG_MULTI_SZ: Result := 'REG_MULTI_SZ';

    REG_RESOURCE_LIST: Result := 'REG_RESOURCE_LIST';

    REG_FULL_RESOURCE_DESCRIPTOR: Result := 'REG_FULL_RESOURCE_DESCRIPTOR';

    REG_RESOURCE_REQUIREMENTS_LIST: Result := 'REG_RESOURCE_REQUIREMENTS_LIST';

  end;

end;

function _regEnumValues(hkKey: HKEY; lpSubKey: PChar): String;

var

  dwIndex, lpcbValueName: DWORD;

  phkResult: HKEY;

  lpValueName: Array[0..MAX_PATH] of Char;

  sResult, sType: String;

begin

  sResult := '';

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ, phkResult) = ERROR_SUCCESS then

  begin

    dwIndex := 0;

    lpcbValueName := sizeof(lpValueName);

    ZeroMemory(@lpValueName, sizeof(lpValueName));

    while RegEnumValue(phkResult, dwIndex, @lpValueName, lpcbValueName, nil, nil, nil, nil) <> ERROR_NO_MORE_ITEMS do

    begin

      sResult := sResult + lpValueName + '|' +  sType + #13#10;

      ZeroMemory(@lpValueName, sizeof(lpValueName));

      lpcbValueName := sizeof(lpValueName);

      inc(dwIndex);

    end;

    ReplaceChar(sResult, #0, ' ');

    RegCloseKey(phkResult);

    Result := sResult;

  end;

end;

function _regEnumKeys(hkKey: HKEY; lpSubKey: PChar): String;

var

  dwIndex, lpcbName: DWORD;

  phkResult: HKEY;

  lpName: Array[0..MAX_PATH] of Char;

  sResult: String;

begin

  sResult := '';

  if RegOpenKeyEx(hkKey, lpSubKey, 0, KEY_READ, phkResult) = ERROR_SUCCESS then

  begin

    dwIndex := 0;

    lpcbName := sizeof(lpName);

    ZeroMemory(@lpName, sizeof(lpName));

    while RegEnumKeyEx(phkResult, dwIndex, @lpName, lpcbName, nil, nil, nil, nil) <> ERROR_NO_MORE_ITEMS do

    begin

      sResult := sResult + lpName + #13#10;

      ZeroMemory(@lpName, sizeof(lpName));

      lpcbName := sizeof(lpName);

      inc(dwIndex);

    end;

    RegCloseKey(phkResult);

    Result := sResult;

  end;

end;

end.