the following is based upon mk-soft's fine work (http://www.purebasic.fr/german/viewtopi ... 460#177460) but has been tailored to my own needs and preferences.
A simple bunch of functions for working with the registry (which is something I usually avoid like the plague, but have little choice at the moment!)
I always like a nice tidy set of routines containing nothing more than I need - hence the rehashing of mk-soft's code!

Thought I'd share this as it may be useful. The main include file has a detailed description of each function at the top of the source. The demo has been tested on Vista 32 only.
As with all registry code - use at your own risk!

"Registry.pbi"
Code: Select all
CompilerIf Defined(INCLUDE_REGISTRY, #PB_Constant)=0
#INCLUDE_REGISTRY=1
;/////////////////////////////////////////////////////////////////////////////////
;*Simple registry functions - Stephen Rodriguez 2009.
;*
;*Purebasic 4.3.
;*
;*Based upon code found at : http://www.purebasic.fr/german/viewtopic.php?p=177460#177460
;*With thanks to mk-soft.
;*
;*The error reporting parts of this code are NOT threadsafe.
;*
;*
;*List of registry functions :
;*============================
;*
;* Registry_CreateSubKey(hKey, subKey$)
;* - Returns either #REG_CREATED_NEW_KEY or REG_OPENED_EXISTING_KEY.
;*
;* Registry_DeleteSubKey(hKey, subKey$, blnDeleteAllDescendantKeys = #False)
;* - If blnDeleteAllDescendantKeys is non-zero, all descendants of the given key are deleted.
;* Otherwise, on Win NT systems, this function will fail if the specified key has subkeys.
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;* Registry_DeleteSubKeyValue(hKey, subKey$, valueName$)
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;* Registry_DoesSubKeyExist(hKey, subKey$)
;* - Returns #True or #False.
;*
;* Registry_GetIntegerValue(hKey, subKey$, valueName$, *type.INTEGER = 0)
;* - '*type' can hold the address of a variable to receive the type of data held with the registry key/value.
;* - Returns zero if the value is not of #REG_DWORD or #REG_QWORD format otherwise returns a QUAD value.
;*
;* Registry_GetValueAsString(hKey, subKey$, valueName$, *type.INTEGER = 0)
;* - Any value retrieved from the registry is converted to a string.
;* Supports value types : #REG_DWORD, #REG_QWORD, #REG_SZ and #REG_EXPAND_SZ.
;* In the case of #REG_EXPAND_SZ, the user can use the ExpandEnvironmentStrings_() api function to expand the
;* embedded environment variables.
;*
;* Registry_SetLongValue(hKey, subKey$, valueName$, value.l)
;* - Sets the DWORD value for the specified key/value
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;* Registry_SetNullValue(hKey, subKey$, valueName$)
;* - Sets the value type for the specified key/value to #REG_NONE.
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;* Registry_SetQuadValue(hKey, subKey$, valueName$, value.q)
;* - Sets the QWORD value for the specified key/value
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;* Registry_SetStringValue(hKey, subKey$, valueName$, value$)
;* - Sets the string (#REG_SZ) value for the specified key/value
;* - Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
;*
;*List of error reporting functions (not threadsafe) :
;*====================================================
;*
;* Registry_GetLastErrorCode()
;*
;* Registry_GetLastErrorDescription()
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;-GLOBALS.
Global gRegistry_LastErrorCode, gRegistry_LastErrorDescription$
;/////////////////////////////////////////////////////////////////////////////////
;-INTERNAL FUNCTIONS.
;-====================
;/////////////////////////////////////////////////////////////////////////////////
Procedure Registry_INTERNAL_SetError(errorCode)
Protected *Buffer, len
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM, 0, errorCode, 0, @*Buffer, 0, 0)
If len
gRegistry_LastErrorDescription$ = PeekS(*Buffer, len)
LocalFree_(*Buffer)
Else
gRegistry_LastErrorDescription$ = "Errorcode: " + Hex(errorCode)
EndIf
gRegistry_LastErrorCode = errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;-'PUBLIC' FUNCTIONS.
;-===================
;-Error functions.
;-------------------------
;/////////////////////////////////////////////////////////////////////////////////
Procedure.i Registry_GetLastErrorCode()
ProcedureReturn gRegistry_LastErrorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
Procedure.s Registry_GetLastErrorDescription()
ProcedureReturn gRegistry_LastErrorDescription$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;-Registry functions.
;------------------------------
;/////////////////////////////////////////////////////////////////////////////////
;The following function creates a new registry key and sets the error code as appropriate.
;If successful, returns either #REG_CREATED_NEW_KEY or REG_OPENED_EXISTING_KEY to indicate that the key already existed.
Procedure.i Registry_CreateSubKey(hKey, subKey$)
Protected errorCode, lpSecurityAttributes.SECURITY_ATTRIBUTES, hKey1, createKey
errorCode = RegCreateKeyEx_(hKey, subKey$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey1, @createKey)
If errorCode = #ERROR_SUCCESS
RegCloseKey_(hKey1)
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn createKey
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function deletes the specified key and all values and sets the error code as appropriate.
;If blnDeleteAllDescendantKeys is non-zero, all descendants of the given key are deleted.
;Otherwise, on Win NT systems, this function will fail if the specified key has subkeys.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_DeleteSubKey(hKey, subKey$, blnDeleteAllDescendantKeys = #False)
Protected errorCode, hKey1, newSubkey$, bufferSize
If blnDeleteAllDescendantKeys = #False
errorCode = RegDeleteKey_(hKey, subKey$)
Else
;We must enumerate all subkeys of the given key and delete! We do this recursively.
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ENUMERATE_SUB_KEYS, @hKey1)
If errorCode = #ERROR_SUCCESS
Repeat
newSubkey$ = Space(256) : bufferSize = 256
errorCode = RegEnumKeyEx_(hKey1, 0, @newSubkey$, @bufferSize, 0, 0, 0, 0)
If errorCode = #ERROR_SUCCESS
errorCode = Registry_DeleteSubKey(hKey, subKey$+"\"+newSubkey$, #True)
EndIf
Until errorCode <> #ERROR_SUCCESS
RegCloseKey_(hKey1)
If errorCode = #ERROR_NO_MORE_ITEMS
errorCode = RegDeleteKey_(hKey, subKey$)
EndIf
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function deletes the specified key/value entry and sets the error code as appropriate.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_DeleteSubKeyValue(hKey, subKey$, valueName$)
Protected errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ALL_ACCESS, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorCode = RegDeleteValue_(hKey1, @valueName$)
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function returns #True or #False as appropriate.
Procedure.i Registry_DoesSubKeyExist(hKey, subKey$)
Protected result, errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_READ, @hKey1)
If hKey1
result = #True
RegCloseKey_(hKey1)
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function attempts to retrieve the specified value and sets the error code as appropriate.
;*type can hold the address of a variable to receive the type of data held with the registry key/value.
;Returns zero if the value is not of #REG_DWORD or #REG_QWORD format.
Procedure.q Registry_GetIntegerValue(hKey, subKey$, valueName$, *type.INTEGER = 0)
Protected errorCode = #ERROR_SUCCESS, hKey1, bufferSize, type, value.q
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_READ, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
bufferSize = SizeOf(QUAD)
errorCode = RegQueryValueEx_(hKey1, valueName$, 0, @type, @value, @bufferSize)
If errorCode = #ERROR_SUCCESS
If *type
*type\i = type
EndIf
If type <> #REG_DWORD And type <> #REG_QWORD
value = 0 ;Just in case!
errorCode = #ERROR_INVALID_DATATYPE
EndIf
ElseIf errorCode = #ERROR_MORE_DATA
If *type
*type\i = type
EndIf
value = 0
errorCode = #ERROR_INVALID_DATATYPE
EndIf
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn value
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function attempts to retrieve the specified value and sets the error code as appropriate.
;Any value retrieved from the registry is converted to a string.
;*type can hold the address of a variable to receive the type of data held with the registry key/value.
;In the case that a #REG_EXPAND_SZ string is returned, the user can use the ExpandEnvironmentStrings_() api function to expand the
;embedded environment variables.
Procedure.s Registry_GetValueAsString(hKey, subKey$, valueName$, *type.INTEGER = 0)
Protected errorCode = #ERROR_SUCCESS, result$, hKey1, bufferSize, type, value.q
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_READ, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorCode = RegQueryValueEx_(hKey1, valueName$, 0, @type, 0, @bufferSize)
If errorCode = #ERROR_SUCCESS
If *type
*type\i = type
EndIf
Select type
Case #REG_DWORD, #REG_QWORD
errorCode = RegQueryValueEx_(hKey1, valueName$, 0, 0, @value, @bufferSize)
If errorCode = #ERROR_SUCCESS
result$ = Str(value)
EndIf
Case #REG_SZ, #REG_EXPAND_SZ
If bufferSize
value = AllocateMemory(buffersize)
If value
errorCode = RegQueryValueEx_(hKey1, valueName$, 0, 0, value, @bufferSize)
If errorCode = #ERROR_SUCCESS
result$ = PeekS(value)
EndIf
FreeMemory(value)
Else
errorCode = #ERROR_NOT_ENOUGH_MEMORY
EndIf
EndIf
EndSelect
EndIf
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn result$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function sets the DWORD value for the specified key/value and sets the error code as appropriate.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_SetLongValue(hKey, subKey$, valueName$, value.l)
Protected errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ALL_ACCESS, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorcode = RegSetValueEx_(hKey1, @valueName$, 0, #REG_DWORD, @value, SizeOf(LONG))
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function sets the name for the specified key/value and sets the error code as appropriate.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_SetNullValue(hKey, subKey$, valueName$)
Protected errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ALL_ACCESS, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorcode = RegSetValueEx_(hKey1, @valueName$, 0, #REG_NONE, 0, 0)
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function sets the QWORD value for the specified key/value and sets the error code as appropriate.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_SetQuadValue(hKey, subKey$, valueName$, value.q)
Protected errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ALL_ACCESS, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorcode = RegSetValueEx_(hKey1, @valueName$, 0, #REG_QWORD, @value, SizeOf(QUAD))
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function sets the string value for the specified key/value and sets the error code as appropriate.
;Returns #ERROR_SUCCESS or some Win error code which can be queried through the error functions.
Procedure.i Registry_SetStringValue(hKey, subKey$, valueName$, value$)
Protected errorCode, hKey1
errorCode = RegOpenKeyEx_(hKey, subKey$, 0, #KEY_ALL_ACCESS, @hKey1)
If errorCode = #ERROR_SUCCESS
If hKey1
errorcode = RegSetValueEx_(hKey1, @valueName$, 0, #REG_SZ, @value$, Len(value$)<<(SizeOf(Character)-1)+SizeOf(CHARACTER))
RegCloseKey_(hKey1)
EndIf
EndIf
Registry_INTERNAL_SetError(errorCode)
ProcedureReturn errorCode
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
CompilerEndIf
Code: Select all
;/////////////////////////////////////////////////////////////////////////////////
;*Demo of the simple registry functions include file.
;*
;*Writing to the registry key within this demo requires administrator privileges (at least on Win Vista it does!)
;*
;*Tested on Vista.
;*================
;*
;* All writes to the registry within this demo are harmless and are removed by this program!
;*
;* We write to the #HKEY_CLASSES_ROOT key, creating a new subkey ".aSrod" and a subkey of this!
;* Use RegEdit to examine the new keys added before the program removes them.
;/////////////////////////////////////////////////////////////////////////////////
XIncludeFile "Registry.pbi"
mainSubKey$ = ".aSrod"
subKey$ = mainSubKey$ + "\subkey1\subkey2"
;Let us check if our key already exists?
If Registry_DoesSubKeyExist(#HKEY_CLASSES_ROOT, mainSubKey$)
MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + mainSubKey$ + Chr(34) + " already exists!" + #CRLF$ + #CRLF$ + "Terminating program!")
End
Else
If MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + mainSubKey$ + Chr(34) + " does not exist!" + #CRLF$ + #CRLF$ + "Do you wish to create this key?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
End
EndIf
EndIf
;Create the new key.
error = Registry_CreateSubKey(#HKEY_CLASSES_ROOT, mainSubKey$)
If error = #REG_CREATED_NEW_KEY
MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + mainSubKey$ + Chr(34) + " successfully created!" + #CRLF$ + #CRLF$ + "Click OK to proceed and add a nested subkey to this new key.")
Else
MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + mainSubKey$ + Chr(34) + " could not be created!" + #CRLF$ + #CRLF$ + "(Error message : " + Registry_GetLastErrorDescription() + ")")
End
EndIf
;Add a nested subkey to the newly added key.
error = Registry_CreateSubKey(#HKEY_CLASSES_ROOT, subKey$)
If error = #REG_CREATED_NEW_KEY
MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + subKey$ + Chr(34) + " successfully created!" + #CRLF$ + #CRLF$ + "Click OK to proceed and set a value for this new key.")
;Set a string value with name "test" and value "Heyho!"
error = Registry_SetStringValue(#HKEY_CLASSES_ROOT, subKey$, "test", "Heyho!")
If error = #ERROR_SUCCESS
MessageRequester("Registry", "Value 'test' successfully added to " + Chr(34) + "#HKEY_CLASSES_ROOT\" + subKey$ + Chr(34))
Else
MessageRequester("Registry", "Value 'test' could not be added to " + Chr(34) + "#HKEY_CLASSES_ROOT\" + subKey$ + Chr(34) + #CRLF$ + #CRLF$ + "(Error message : " + Registry_GetLastErrorDescription() + ")")
EndIf
Else
MessageRequester("Registry", Chr(34) + "#HKEY_CLASSES_ROOT\" + subKey$ + Chr(34) + " could not be created!" + #CRLF$ + #CRLF$ + "(Error message : " + Registry_GetLastErrorDescription() + ")")
EndIf
;Tidy up and remove the newly added keys.
MessageRequester("Registry", "Click OK to remove all keys added.")
error = Registry_DeleteSubKey(#HKEY_CLASSES_ROOT, mainSubKey$, #True) ;#True means that all subkeys will be removed.
If error = #ERROR_SUCCESS
MessageRequester("Registry", "All newly added keys successfully removed.")
Else
MessageRequester("Registry", "The newly added keys were not all successfully removed!" + #CRLF$ + #CRLF$ + "(Error message : " + Registry_GetLastErrorDescription() + ")")
EndIf