untRegistry by ErazerZ
Post date: Sep 28, 2010 4:44:49 PM
{ Unit Registry by ErazerZ 19. Februar 2006 Requires: untUtils (by ErazerZ)}unit untRegistry;interfaceuses 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;implementationtype 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_CONFIGend;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.