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




