MOD2000: How to Make Custom Registry Entries by Using API Upon Startup (241999)

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact a Microsoft Certified Partner or the Microsoft fee-based consulting line at (800) 936-5200. For more information about Microsoft Certified Partners, please visit the following Microsoft Web site:

http://www.microsoft.com/partner/referral/

For more information about the support options that are available and about how to contact Microsoft, visit the following Microsoft Web site:

http://support.microsoft.com/default.aspx?scid=fh;EN-US;CNTACTMS

Static registry files (.reg) can be applied during the Setup of a package; however, custom registry files (those whose settings or placement or both depend upon factors such as the user's environment or choices during Setup) cannot be added in this manner.

Custom registry files can be added, instead, during the first execution of an Access database. In the example in this article, when the sample database is first opened, its startup form runs the function setRegRunOnce(), which checks for the existence of the specified registry key, and, if it is not there, adds the key. The next time that the database is opened, it does not check.

An alternative function, checkRegEachTime(), is provided that queries the registry each time that the database is opened to see if the key is still there. If it is, the key is not added, but the value is updated. In either case, the sample subkey that is added is the following:

HKEY_CURRENT_USER\TestKey1\SubKey1

A value named Value1 is also added to SubKey1. For demonstration purposes, Value1 contains the date and the time that the key is added. To see how this works, follow these steps:

WARNING: If you use Registry Editor incorrectly, you may cause serious problems that may require you to reinstall your operating system. Microsoft cannot guarantee that you can solve problems that result from using Registry Editor incorrectly. Use Registry Editor at your own risk.

In Access, create a new database and name it TestFile.mdb.
In that database, create a form and name it frmStart.
In Design view of the frmStart form, open the form properties, and then set the OnOpen event to =setRegRunOnce().
Save the form, and then close it.
On the Tools menu, click Startup.
In the Startup dialog box, under Display Form/Page, select the frmStart form.
On the Insert menu, click Module.

Type or paste the following code into the new module:

Option Compare Database

Dim vValue As Variant
Dim valRegKey As Long

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
        As Long
Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias _
        "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, _
        ByVal lpName As String, ByRef lpcbName As Long, _
        ByVal lpReserved As Long, ByVal lpClass As String, _
        ByRef lpcbClass As Long) As Long
Declare Function RegEnumValue Lib "advapi32.dll" Alias _
        "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
        ByVal lpValueName As String, lpcbValueName As Long, _
        ByVal lpReserved As Long, lpType As Long, lpData As Any, _
        lpcbData As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
        "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
        As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
        As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
        "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal ulOptions As Long, ByVal samDesired As Long, _
        phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
        As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, lpData As _
        Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
        As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
        "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal Reserved As Long, ByVal dwType As Long, ByVal _
        lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
        "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal Reserved As Long, ByVal dwType As Long, lpValue _
        As Long, ByVal cbData As Long) As Long

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
       lType As Long, vValue As Variant) As Long
    Dim lValue As Long
    Dim sValue As String

    Select Case lType
        Case REG_SZ
            sValue = vValue & Chr$(0)
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                         lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
                         lType, lValue, 4)
    End Select
End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
         String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    'Determine the size and type of data to be read.
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

    MsgBox lrc

    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        'For strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
                  sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If
        'For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
                  lValue, cch)
            If lrc = ERROR_NONE Then
                vValue = lValue
            End If
        Case Else
            'All other data types not supported.
            lrc = -1
    End Select

QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit
End Function

Sub QueryValueAPI(sKeyName As String, sValueName As String)
    Dim lRetVal As Long       'Result of the API functions.
    Dim hKey As Long          'Handle of opened key.
    Dim vValue As Variant     'Setting of queried value.

    vValue = Empty
    lRetVal = RegOpenKeyEx(valRegKey, sKeyName, 0, KEY_QUERY_VALUE, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)

    RegCloseKey (hKey)
End Sub

Function CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
    Dim hNewKey As Long    'Handle to the new key.
    Dim lRetVal As Long    'Result of the RegCreateKeyEx function.

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
              vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
              0&, hNewKey, lRetVal)

    RegCloseKey (hNewKey)
End Function

Function SetKeyValue(lTopKey As Long, sKeyName As String, _
         sValueName As String, vValueSetting As Variant, _
         lValueType As Long)
                     
    Dim lRetVal As Long    'Result of the SetValueEx function.
    Dim hKey As Long       'Handle of open key.
       
    'Open the specified key.
    lRetVal = RegOpenKeyEx(lTopKey, sKeyName, 0, KEY_SET_VALUE, hKey)
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)
End Function

Function checkForKey(lTopKey As Long, strKey As String) As Boolean
    Dim iRet As Long

    valRegKey = HKEY_CURRENT_USER
    iRet = RegOpenKeyEx(lTopKey, strKey, 0, KEY_QUERY_VALUE, hKey)

    If iRet = 0 Then
        checkForKey = True
        RegCloseKey (hKey)
    Else
        checkForKey = False
    End If
End Function

Sub regChange(lTopKey As Long, strKey As String, strValueName As String, _
              varValueSet As Variant)
    'Specify the root key.
    Dim keyExists As Boolean

    'CheckForKey returns true if the path is there.
    keyExists = checkForKey(lTopKey, strKey)

   If keyExists = False Then
       'Create the key.
       CreateNewKey strKey, lTopKey
   End If
   
   'Create a value in the key and set it.
   SetKeyValue lTopKey, strKey, strValueName, varValueSet, REG_SZ
End Sub

Function setRegRunOnce()
    'This function, which is called in the OnOpen event of the startup
    'form, sets a database property indicating that it ran. Once the
    'property is set, the regChange function is never called again.
    '
    'If you do not mind querying the registry each time you open the
    'database, instead, you can set the OnOpen event of the startup form to
    'the setRegEveryTime() function, seen at the end of this module.
    Dim lTopKey As Long
    Dim strRegKey As String
    Dim strValName As String
    Dim varData As Variant

    lTopKey = HKEY_CURRENT_USER
    strRegKey = "TestKey1\SubKey1"
    strValName = "Value1"
    varData = Format(Now(), "dd/mm/yy hh:mm:ss am/pm")

    'If an error occurs, go to the error handler.
    On Error GoTo MissingProp_Err

    If CurrentDb().Properties("regFixed") = False Then
        On Error GoTo 0
        regChange lTopKey, strRegKey, strValName, varData
        CurrentDb().Properties("regFixed") = "true"
    End If

MissingProp_Err:
    'If the error indicates that the property was not found, then add it
    'and resume.
    Const conPropertyNotFound = 3270

    If Err = conPropertyNotFound Then
        Dim db As DAO.Database
        Dim prop As DAO.Property
        
        Set db = CurrentDb()
        Set prop = db.CreateProperty("regFixed", dbBoolean, "False")

        db.Properties.Append prop
        Resume Next
    End If
End Function

Function checkRegEachTime()
    'If you set this function to the OnOpen event of your startup form, the
    'registry is checked each time the database is loaded.
    Dim lTopKey As Long
    Dim strRegKey As String
    Dim strValName As String
    Dim varData As Variant

    lTopKey = HKEY_CURRENT_USER
    strRegKey = "TestKey1\SubKey1"
    strValName = "Value1"
    varData = Format(Now(), "dd/mm/yy hh:mm:ss am/pm")

    regChange lTopKey, strRegKey, strValName, varData
End Function

On the Add-ins menu, click Package and Deployment Wizard.

If the Package and Deployment Wizard is not available, please see the following article in the Microsoft Knowledge Base to load the wizard.
236143 MOD2000: How to Start the Package and Deployment Wizard
In the Package and Deployment Wizard, click Package.
Click Next on each page and accept the defaults until you see the page named Package and Deployment Wizard - Included Files.
Click to select the Include Access Runtime check box, and then click Next.

NOTE: If you are asked for the location of the Access Runtime, insert the Microsoft Office 2000 developer CD, and browse to the following file:
<cd drive>\ODETools\v9\AccessRT\Data1.msi
Continue clicking Next in the wizard, accepting the defaults, and then click Finish.
Install the Access run-time package on another computer.
On the computer on which you installed the package, open the TestFile.mdb database once, and then close it.
Click Start, and then click Run.
Type regedit, and then click OK. Registry Editor starts.
In Registry Editor, expand the tree to the following key:
HKEY_CURRENT_USER
You should see the following subkey there:
TestKey1
Open TestKey1, and then open SubKey1. Note the custom value named Value1.
Open Value1. In the Value Data field, note the date and time that the registry key was added.
Quit Registry Editor.
Repeat steps 15 through 21. Note that the Value Data field still contains the time for when the database was first opened.
Quit Registry Editor.

MOD2000: How to Make Custom Registry Entries by Using API Upon Startup (241999)

SUMMARY

MORE INFORMATION