Source code for Issue Number 85

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any class and change the name of the class to cRegistryUtils.

'----------------------------------------------------------------------
'
'   Module Name:    cRegistryUtils
'   Written By:     C&D Programming Corp.
'   Create Date:    2/21/98
'   Modifications:  3/99
'                   This class is an enhancement to issue #64.
'   Copyright:      Copyright 1998-99 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
Option Explicit

'
'   Various API declarations that need to be called to retrieve registry
'   information.
'

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005

Private Const KEY_ALL_ACCESS = &H3F

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private 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

Private 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

Private 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

Private Const REG_SZ = 1                         ' Unicode nul terminated string

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, _
                    ByVal Reserved As Long, ByVal dwType As Long, _
                        ByVal lpData As String, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Private Const RUN_KEY_NAME As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\"

'
'   this property will get the value currently assigned to a key found in the
'   registry key HKLM\Software\Microsoft\Windows\CurrentVersion\Run.  This key
'   is the one that tells Windows which applications to start up when Windows
'   starts.  It behaves much like the Startup group in the Start Menu, but it is
'   a bit more difficult to remove for the end user.
'
Public Property Get Run(sAppName As String) As String
    On Error GoTo ErrorHandler

    Dim lRetVal As Long, hKey As Long, vValue As Variant

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, RUN_KEY_NAME & "Run", 0, KEY_ALL_ACCESS, hKey)
    lRetVal = GetKeyValue(hKey, sAppName, vValue)
    RegCloseKey hKey
    Run = vValue
    Exit Property

ErrorHandler:
    Run = Empty
    Err.Raise Err.Number, "Run (Get)", Err.Description
End Property

Public Property Let Run(sAppName As String, sCommandLine As String)
    On Error GoTo ErrorHandler

    Dim lRetVal As Long, hKey As Long

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, RUN_KEY_NAME & "Run", 0, KEY_ALL_ACCESS, hKey)
    lRetVal = SetKeyValue(hKey, sAppName, sCommandLine & vbNullChar)
    RegCloseKey hKey
    Exit Property

ErrorHandler:
    Err.Raise Err.Number, "Run (Let)", Err.Description
End Property

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

    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc = 0 Then
        sValue = String(cch, 0)
        lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
        If lrc = 0 Then
            vValue = Left$(sValue, cch - 1)
        Else
            vValue = Empty
        End If
        GetKeyValue = lrc
    Else
        GetKeyValue = 0
    End If
End Function

'
'  This routine assigns a key value to the keyname passed in szValueName
'
Private Function SetKeyValue(ByVal lhKey As Long, ByVal szValueName As String, vValue As String) As Long
    SetKeyValue = RegSetValueEx(lhKey, szValueName, 0&, REG_SZ, vValue, Len(vValue))
End Function