Untitled

Option Explicit

' --------------------------------------------------------------
' Update the Windows registry.
' Written by Kenneth Ives                        kenaso@home.com
' NT tested by Brett Gerhardi       Brett.Gerhardi@trinite.co.uk
'
' Perform the four basic functions on the Windows registry.
'           Add
'           Change
'           Delete
'           Query
'
' Important:   If you treat all key data strings as being
'              case sensitive, you should never have a problem.
'              Always backup your registry files (System.dat
'              and User.dat) before performing any type of
'              modifications
'
' Software developers vary on where they want to update the
' registry with their particular information.  The most common
' are in HKEY_lOCAL_MACHINE or HKEY_CURRENT_USER.
'
' This BAS module handles all of my needs for string and
' basic numeric updates in the Windows registry.
'
' Brett found that NT users must delete each major key
' separately.  See bottom of TEST routine for an example.
' --------------------------------------------------------------

' --------------------------------------------------------------
' Private variables
' --------------------------------------------------------------
  Private m_lngRetVal As Long

' --------------------------------------------------------------
' Constants required for values in the keys
' --------------------------------------------------------------
  Private Const REG_NONE As Long = 0                  ' No value type
  Private Const REG_SZ As Long = 1                    ' nul terminated string
  Private Const REG_EXPAND_SZ As Long = 2             ' nul terminated string w/enviornment var
  Private Const REG_BINARY As Long = 3                ' Free form binary
  Private Const REG_DWORD As Long = 4                 ' 32-bit number
  Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4   ' 32-bit number (same as REG_DWORD)
  Private Const REG_DWORD_BIG_ENDIAN As Long = 5      ' 32-bit number
  Private Const REG_LINK As Long = 6                  ' Symbolic Link (unicode)
  Private Const REG_MULTI_SZ As Long = 7              ' Multiple Unicode strings
  Private Const REG_RESOURCE_LIST As Long = 8         ' Resource list in the resource map
  Private Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 ' Resource list in the hardware description
  Private Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10

' --------------------------------------------------------------
' Registry Specific Access Rights
' --------------------------------------------------------------
  Private Const KEY_QUERY_VALUE As Long = &H1
  Private Const KEY_SET_VALUE As Long = &H2
  Private Const KEY_CREATE_SUB_KEY As Long = &H4
  Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
  Private Const KEY_NOTIFY As Long = &H10
  Private Const KEY_CREATE_LINK As Long = &H20
  Private Const KEY_ALL_ACCESS As Long = &H3F

' --------------------------------------------------------------
' Constants required for key locations in the registry
' --------------------------------------------------------------
  Public Const HKEY_CLASSES_ROOT As Long = &H80000000
  Public Const HKEY_CURRENT_USER As Long = &H80000001
  Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
  Public Const HKEY_USERS As Long = &H80000003
  Public Const HKEY_PERFORMANCE_DATA As Long = &H80000004
  Public Const HKEY_CURRENT_CONFIG As Long = &H80000005
  Public Const HKEY_DYN_DATA As Long = &H80000006

' --------------------------------------------------------------
' Constants required for return values (Error code checking)
' --------------------------------------------------------------
  Private Const ERROR_SUCCESS As Long = 0
  Private Const ERROR_ACCESS_DENIED As Long = 5
  Private Const ERROR_NO_MORE_ITEMS As Long = 259

' --------------------------------------------------------------
' Open/Create constants
' --------------------------------------------------------------
  Private Const REG_OPTION_NON_VOLATILE As Long = 0
  Private Const REG_OPTION_VOLATILE As Long = &H1

' --------------------------------------------------------------
' Declarations required to access the Windows registry
' --------------------------------------------------------------
  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngRootkey As Long) As Long

  Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
            (ByVal lngRootkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

  Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
            (ByVal lngRootkey As Long, ByVal lpSubKey As String) As Long

  Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
            (ByVal lngRootkey As Long, ByVal lpValueName As String) As Long

  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
            (ByVal lngRootkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

  Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
            (ByVal lngRootkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
             lpType As Long, lpData As Any, lpcbData As Long) As Long

  Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
            (ByVal lngRootkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
             ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Function regDelete_Sub_Key(ByVal lngRootkey As Long, _
                                  ByVal strRegKeyPath As String, _
                                  ByVal strRegSubKey As String)

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for removing a sub key.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be removed.
'
' Syntax:
'    regDelete_Sub_Key HKEY_CURRENT_USER, _
                  "Software\AAA-Registry Test\Products", "StringTestData"
'
' Removes the sub key "StringTestData"
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long

' --------------------------------------------------------------
' Make sure the key exist before trying to delete it
' --------------------------------------------------------------
  If regDoes_Key_Exist(lngRootkey, strRegKeyPath) Then

      ' Get the key handle
      m_lngRetVal = RegOpenKey(lngRootkey, strRegKeyPath, lngKeyHandle)

      ' Delete the sub key.  If it does not exist, then ignore it.
      m_lngRetVal = RegDeleteValue(lngKeyHandle, strRegSubKey)

      ' Always close the handle in the registry.  We do not want to
      ' corrupt the registry.
      m_lngRetVal = RegCloseKey(lngKeyHandle)
  End If

End Function

Public Function regDoes_Key_Exist(ByVal lngRootkey As Long, _
                                  ByVal strRegKeyPath As String) As Boolean

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function to see if a key does exist
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you want to test
'
' Syntax:
'    strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
'                       "Software\AAA-Registry Test\Products")
'
' Returns the value of TRUE or FALSE
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long

' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
  lngKeyHandle = 0

' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegOpenKey(lngRootkey, strRegKeyPath, lngKeyHandle)

' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave here.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regDoes_Key_Exist = False
  Else
      regDoes_Key_Exist = True
  End If

' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)

End Function

Public Function regQuery_A_Key(ByVal lngRootkey As Long, _
                               ByVal strRegKeyPath As String, _
                               ByVal strRegSubKey As String) As Variant

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for querying a sub key value.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be queryed.
'
' Syntax:
'    strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
'                       "Software\AAA-Registry Test\Products", _
                        "StringTestData")
'
' Returns the key value of "StringTestData"
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim intPosition As Integer
  Dim lngKeyHandle As Long
  Dim lngDataType As Long
  Dim lngBufferSize As Long
  Dim lngBuffer As Long
  Dim strBuffer As String

' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
  lngKeyHandle = 0
  lngBufferSize = 0

' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegOpenKey(lngRootkey, strRegKeyPath, lngKeyHandle)

' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave here.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regQuery_A_Key = ""
      m_lngRetVal = RegCloseKey(lngKeyHandle)   ' always close the handle
      Exit Function
  End If

' --------------------------------------------------------------
' Query the registry and determine the data type.
' --------------------------------------------------------------
  m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, _
                         lngDataType, ByVal 0&, lngBufferSize)

' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regQuery_A_Key = ""
      m_lngRetVal = RegCloseKey(lngKeyHandle)   ' always close the handle
      Exit Function
  End If

' --------------------------------------------------------------
' Make the API call to query the registry based on the type
' of data.
' --------------------------------------------------------------
  Select Case lngDataType
         Case REG_SZ:       ' String data (most common)
              ' Preload the receiving buffer area
              strBuffer = Space(lngBufferSize)

              m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, 0&, _
                                     ByVal strBuffer, lngBufferSize)

              ' If NOT a successful call then leave
              If m_lngRetVal <> ERROR_SUCCESS Then
                  regQuery_A_Key = ""
              Else
                  ' Strip out the string data
                  intPosition = InStr(1, strBuffer, Chr(0))  ' look for the first null char
                  If intPosition > 0 Then
                      ' if we found one, then save everything up to that point
                      regQuery_A_Key = Left(strBuffer, intPosition - 1)
                  Else
                      ' did not find one.  Save everything.
                      regQuery_A_Key = strBuffer
                  End If
              End If

         Case REG_DWORD:    ' Numeric data (Integer)
              m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                     lngBuffer, 4&)  ' 4& = 4-byte word (long integer)

              ' If NOT a successful call then leave
              If m_lngRetVal <> ERROR_SUCCESS Then
                  regQuery_A_Key = ""
              Else
                  ' Save the captured data
                  regQuery_A_Key = lngBuffer
              End If

         Case Else:    ' unknown
              regQuery_A_Key = ""
  End Select

' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)

End Function
Public Sub regCreate_Key_Value(ByVal lngRootkey As Long, ByVal strRegKeyPath As String, _
                               ByVal strRegSubKey As String, varRegData As Variant)

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for saving string data.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be updated.
'       varRegData - Update data.
'
' Syntax:
'    regCreate_Key_Value HKEY_CURRENT_USER, _
'                      "Software\AAA-Registry Test\Products", _
'                      "StringTestData", "22 Jun 1999"
'
' Saves the key value of "22 Jun 1999" to sub key "StringTestData"
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
  Dim lngDataType As Long
  Dim lngKeyValue As Long
  Dim strKeyValue As String

' --------------------------------------------------------------
' Determine the type of data to be updated
' --------------------------------------------------------------
  If IsNumeric(varRegData) Then
      lngDataType = REG_DWORD
  Else
      lngDataType = REG_SZ
  End If

' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegCreateKey(lngRootkey, strRegKeyPath, lngKeyHandle)

' --------------------------------------------------------------
' Update the sub key based on the data type
' --------------------------------------------------------------
  Select Case lngDataType
         Case REG_SZ:       ' String data
              strKeyValue = Trim(varRegData) & Chr(0)     ' null terminated
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          ByVal strKeyValue, Len(strKeyValue))

         Case REG_DWORD:    ' numeric data
              lngKeyValue = CLng(varRegData)
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          lngKeyValue, 4&)  ' 4& = 4-byte word (long integer)

  End Select

' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)

End Sub
Public Function regCreate_A_Key(ByVal lngRootkey As Long, ByVal strRegKeyPath As String)

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   This function will create a new key
'
' Parameters:
'          lngRootKey  - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'   strRegKeyPath  - is name of the key you wish to create.
'                  to make sub keys, continue to make this
'                  call with each new level.  MS says you
'                  can do this in one call; however, the
'                  best laid plans of mice and men ...
'
' Syntax:
'   regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test"
'   regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test\Products"
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long

' --------------------------------------------------------------
' Create the key.  If it already exist, ignore it.
' --------------------------------------------------------------
  m_lngRetVal = RegCreateKey(lngRootkey, strRegKeyPath, lngKeyHandle)

' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)

End Function
Public Function regDelete_A_Key(ByVal lngRootkey As Long, _
                                ByVal strRegKeyPath As String, _
                                ByVal strRegKeyName As String) As Boolean

' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for removing a complete key.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                        HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'   strRegKeyValue - is the name of the key which will be removed.
'
' Returns a True or False on completion.
'
' Syntax:
'    regDelete_A_Key HKEY_CURRENT_USER, "Software", "AAA-Registry Test"
'
' Removes the key "AAA-Registry Test" and all of its sub keys.
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long

' --------------------------------------------------------------
' Preset to a failed delete
' --------------------------------------------------------------
  regDelete_A_Key = False

' --------------------------------------------------------------
' Make sure the key exist before trying to delete it
' --------------------------------------------------------------
  If regDoes_Key_Exist(lngRootkey, strRegKeyPath) Then

      ' Get the key handle
      m_lngRetVal = RegOpenKey(lngRootkey, strRegKeyPath, lngKeyHandle)

      ' Delete the key
      m_lngRetVal = RegDeleteKey(lngKeyHandle, strRegKeyName)

      ' If the value returned is equal zero then we have succeeded
      If m_lngRetVal = 0 Then regDelete_A_Key = True

      ' Always close the handle in the registry.  We do not want to
      ' corrupt the registry.
      m_lngRetVal = RegCloseKey(lngKeyHandle)
  End If

End Function

Sub Test()

' --------------------------------------------------------------
' Test Windows registry basic functions.
' Written by Kenneth Ives                     kenaso@home.com
'
' Rename this to "Main".  Press F8 to step thru the code.   You
' will be able to stop at will and execute Regedit.exe to see
' the results.  Or, you can press F5 and this test procedure
' has its own stops built in.
'
' Perform the four basic functions on the Windows registry.
'           Add
'           Change
'           Delete
'           Query
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry (System.dat and
'                User.dat) before performing any type of updates.
'
' Rename this procedure back to TEST so as not to intefere if
' this BAS module is used in another application.
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngRootkey As Long
  Dim strKeyQuery As Variant    ' we are not sure what type of
                              ' data will be returned

' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
  strKeyQuery = vbNullString
  lngRootkey = HKEY_CURRENT_USER

' --------------------------------------------------------------
' See if the key already exist.  If the key does not exist, we
' will create one.  Some people want to automatically create a
' key if it does not exist.  This philosophy can be dangerous.
' Querying the registry is one function and updating is another.
' --------------------------------------------------------------
  If Not regDoes_Key_Exist(lngRootkey, "Software\AAA-Registry Test") Then
      ' create the main key and the first sub key
      regCreate_A_Key lngRootkey, "Software\AAA-Registry Test"
      regCreate_A_Key lngRootkey, "Software\AAA-Registry Test\Products"
  End If

' --------------------------------------------------------------
' see if the next sub key exist.
' --------------------------------------------------------------
  If Not regDoes_Key_Exist(lngRootkey, "Software\AAA-Registry Test\Products") Then
      ' create the first sub key
      regCreate_A_Key lngRootkey, "Software\AAA-Registry Test\Products"
  End If

' --------------------------------------------------------------
' Create a string type sub key
' --------------------------------------------------------------
  regCreate_Key_Value lngRootkey, "Software\AAA-Registry Test\Products", _
                      "StringTestData", "22 SEP 1999"

' --------------------------------------------------------------
' Create a numeric type sub key
' --------------------------------------------------------------
  regCreate_Key_Value lngRootkey, "Software\AAA-Registry Test\Products", _
                      "NumericTestData", 1234567890

' --------------------------------------------------------------
' See if we have successfully created the key.  The value of
' of the sub key will be returned.  strKeyQuery is a variant
' because we do not know if the data being returned is string
' or numeric.  Once it is returned then we can manipulate it.
' --------------------------------------------------------------
  strKeyQuery = regQuery_A_Key(lngRootkey, "Software\AAA-Registry Test\Products", "StringTestData")
  strKeyQuery = regQuery_A_Key(lngRootkey, "Software\AAA-Registry Test\Products", "NumericTestData")

' --------------------------------------------------------------
' Stop processing here.
' Execute Regedit.exe and verify that all the keys have
' been added to the registry.
' Press F5 or F8 to continue.
' --------------------------------------------------------------
  Stop

' --------------------------------------------------------------
' Change the value of the sub key, "StringTestData", from
' "22 SEP 1999" to "September 22, 1999"
' --------------------------------------------------------------
  regCreate_Key_Value lngRootkey, "Software\AAA-Registry Test\Products", _
                      "StringTestData", "September 22, 1999"

' --------------------------------------------------------------
' See if the sub key has been updated
' --------------------------------------------------------------
  strKeyQuery = regQuery_A_Key(lngRootkey, "Software\AAA-Registry Test\Products", "StringTestData")

' --------------------------------------------------------------
' Stop processing here.
' Execute Regedit.exe and verify that the sub key has
' been updated in the registry.
' Press F5 or F8 to continue.
' --------------------------------------------------------------
  Stop

' --------------------------------------------------------------
' Delete the sub key, "NumericTestData", only.
' --------------------------------------------------------------
  regDelete_Sub_Key lngRootkey, "Software\AAA-Registry Test\Products", "NumericTestData"

' --------------------------------------------------------------
' Stop processing here.
' Execute Regedit.exe and verify the sub key ("NumericTestData")
' has been removed from the registry.
' Press F5 or F8 to continue.
' --------------------------------------------------------------
  Stop

' --------------------------------------------------------------
' Remove the complete key from the registry.  You do not want
' to remove the "Software" key.  NT users must remove each
' major key component separately as shown below.  Windows 95/98
' users can do this in one step by using the second line only.
' --------------------------------------------------------------
  If Not regDelete_A_Key(lngRootkey, "Software\AAA-Registry Test", "Products") Then
      MsgBox "Failed to delete requested subkey!    ", vbOKOnly + vbExclamation, "Registry Key Delete"
      GoTo Normal_Exit:
  End If

  If Not regDelete_A_Key(lngRootkey, "Software", "AAA-Registry Test") Then
      MsgBox "Failed to delete requested main key!    ", vbOKOnly + vbExclamation, "Registry Key Delete"
      GoTo Normal_Exit:
  End If


Normal_Exit:
' --------------------------------------------------------------
' Terminate program.
' Execute Regedit.exe and verify that the key
' ("AAA-Registry Test") and all of its sub keys have been
' removed from the registry.
' --------------------------------------------------------------
  End

End Sub