Results 1 to 5 of 5

Thread: How do i get a string from the registry?

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 2000
    Location
    Sydney
    Posts
    9

    Unhappy

    Hi all,

    I'm still very new to VB and was wondering how i go about getting a string from the registry?

    Specifically, I need to get the InstallPath for acrobat reader so that I can open a PDF file when a command button is pressed.

    I know the location in the registry:
    HKEY_LOCAL_MACHINE\SOFTWARE\Adobe\Acrobat Reader\4.0\InstallPath\(Default)
    but I do not now how to get this string via VB.

  2. #2
    Lively Member
    Join Date
    Nov 2000
    Posts
    73
    hi,
    paste this code in a module and call the functions as directed with comments . This may useful for u in future and hope this will solve ur problem.

    Private Type FILETIME
    lLowDateTime As Long
    lHighDateTime As Long
    End Type

    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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Private 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, lpSecurityAttributes As Any, phkResult As Long, lplDisposition As Long) As Long
    Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
    Private Declare Function RegQueryValueEx 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 RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long
    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
    Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
    Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long


    Private Const ERROR_SUCCESS = 0&
    Private Const ERROR_BADDB = 1009&
    Private Const ERROR_BADKEY = 1010&
    Private Const ERROR_CANTOPEN = 1011&
    Private Const ERROR_CANTREAD = 1012&
    Private Const ERROR_CANTWRITE = 1013&
    Private Const ERROR_OUTOFMEMORY = 14&
    Private Const ERROR_INVALID_PARAMETER = 87&
    Private Const ERROR_ACCESS_DENIED = 5&
    Private Const ERROR_NO_MORE_ITEMS = 259&
    Private Const ERROR_MORE_DATA = 234&

    Private Const REG_NONE = 0&
    Private Const REG_SZ = 1&
    Private Const REG_EXPAND_SZ = 2&
    Private Const REG_BINARY = 3&
    Private Const REG_DWORD = 4&
    Private Const REG_DWORD_LITTLE_ENDIAN = 4&
    Private Const REG_DWORD_BIG_ENDIAN = 5&
    Private Const REG_LINK = 6&
    Private Const REG_MULTI_SZ = 7&
    Private Const REG_RESOURCE_LIST = 8&
    Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9&
    Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10&

    Private Const KEY_QUERY_VALUE = &H1&
    Private Const KEY_SET_VALUE = &H2&
    Private Const KEY_CREATE_SUB_KEY = &H4&
    Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
    Private Const KEY_NOTIFY = &H10&
    Private Const KEY_CREATE_LINK = &H20&
    Private Const READ_CONTROL = &H20000
    Private Const WRITE_DAC = &H40000
    Private Const WRITE_OWNER = &H80000
    Private Const SYNCHRONIZE = &H100000
    Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
    Private Const STANDARD_RIGHTS_READ = READ_CONTROL
    Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
    Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
    Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
    Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
    Private Const KEY_EXECUTE = KEY_READ

    Private hKey As Long, MainKeyHandle As Long
    Private rtn As Long, lBuffer As Long, sBuffer As String
    Private lBufferSize As Long
    Private lDataSize As Long
    Private ByteArray() As Byte

    'This variable determins wether or not to display error messages to the
    'user. I have set the default value to False as an error message can and
    'does become irritating after a while. Turn this value to true if you want
    'to debug your programming code when reading and writing to your system
    'registry, as any errors will be displayed in a message box.

    Private DisplayErrorMsg As Boolean

    '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' Public Registry Functions
    '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

    'Function Info:
    ' sKey = Key path - ex. "HKEY_LOCAL_MACHINE\SOFTWARE\..."
    ' sKeyName = is the key value name - ex. "Company Name"
    ' KeyValue = is the item to save in the registry - ex. "XYZ Company."
    '

    '-- The Get function will return the value
    'Function GetBinaryValue(sKey As String, sKeyName As String)
    'Function GetDWORDValue(sKey As String, sKeyName As String)
    'Function GetStringValue(sKey As String, sKeyName As String)

    '-- Set the value in the registry
    'Function SetBinaryValue(sKey As String, sKeyName As String, KeyValue As String)
    'Function SetDWORDValue(sKey As String, sKeyName As String, KeyValue As Long)
    'Function SetStringValue(sKey As String, sKeyName As String, KeyValue As String)

    '-- delete registry key or key value
    'Function DeleteKey(sKey As String)
    'Function DeleteKeyValue(sKey As String, sKeyName As String)
    'Function DeleteAllKeySubItems() ""NOT COMPLETED""

    '-- create registry keys
    'Function CreateKey(sKey As String)

    '-- check for existing registry key or key value name
    'Function KeyExist(sKey As String)
    'Function KeyValueExist(sKey As String, sKeyName As String)

    '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' Other supporting functions
    '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    'Function GetMainKeyHandle(MainKeyName As String) As Long
    'Function GetErrorMsg(lErrorCode As Long) As String
    'Private Sub ParseKey(Keyname As String, Keyhandle As Long)
    '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

    Private Sub Class_Initialize()

    DisplayErrorMsg = False

    End Sub


    Public Property Let SetDisplayErrorMsg(vNewValue As Variant)

    DisplayErrorMsg = vNewValue

    End Property


    Public Function SetDWordValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As Long)

    SetDWordValue = False
    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
    rtn = RegSetValueExA(hKey, sKeyName, 0, REG_DWORD, KeyValue, 4) 'write the value
    If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
    If DisplayErrorMsg = True Then 'if the user want errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    Else
    SetDWordValue = True
    End If
    rtn = RegCloseKey(hKey) 'close the key
    Else 'if there was an error opening the key
    If DisplayErrorMsg = True Then 'if the user want errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    End If
    End If

    End Function


    Public Function GetDWordValue(ByVal sKey As String, ByVal sKeyName As String)

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key could be opened then
    rtn = RegQueryValueExA(hKey, sKeyName, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry
    If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
    rtn = RegCloseKey(hKey) 'close the key
    GetDWordValue = lBuffer 'return the value
    Else 'otherwise, if the value couldnt be retreived
    GetDWordValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants errors displayed
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    End If
    Else 'otherwise, if the key couldnt be opened
    GetDWordValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants errors displayed
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    End If
    End If

    End Function


    Public Function SetBinaryValue(ByVal sKey As String, ByVal sKeyName As String, KeyValue As String)

    SetBinaryValue = False
    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
    lDataSize = Len(KeyValue)
    ReDim ByteArray(lDataSize)
    For i = 1 To lDataSize
    ByteArray(i) = Asc(Mid$(KeyValue, i, 1))
    Next
    rtn = RegSetValueExB(hKey, sKeyName, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
    If Not rtn = ERROR_SUCCESS Then 'if the was an error writting the value
    If DisplayErrorMsg = True Then 'if the user want errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    Else
    SetBinaryValue = True
    End If
    rtn = RegCloseKey(hKey) 'close the key
    Else 'if there was an error opening the key
    If DisplayErrorMsg = True Then 'if the user wants errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    End If
    End If

    End Function


    Public Function GetBinaryValue(ByVal sKey As String, ByVal sKeyName As String)

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key could be opened
    lBufferSize = 1
    rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry
    sBuffer = Space(lBufferSize)
    rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry
    If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
    rtn = RegCloseKey(hKey) 'close the key
    GetBinaryValue = sBuffer 'return the value to the user
    Else 'otherwise, if the value couldnt be retreived
    GetBinaryValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants to errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error to the user
    End If
    End If
    Else 'otherwise, if the key couldnt be opened
    GetBinaryValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants to errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error to the user
    End If
    End If
    End If

    End Function


    Public Function SetStringValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As String)

    SetStringValue = False
    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
    rtn = RegSetValueEx(hKey, sKeyName, 0, REG_SZ, ByVal KeyValue, Len(KeyValue)) 'write the value
    If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
    If DisplayErrorMsg = True Then 'if the user wants errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    Else
    SetStringValue = True
    End If
    rtn = RegCloseKey(hKey) 'close the key
    Else 'if there was an error opening the key
    If DisplayErrorMsg = True Then 'if the user wants errors displayed
    MsgBox GetErrorMsg(rtn) 'display the error
    End If
    End If
    End If

    End Function


    Public Function GetStringValue(ByVal sKey As String, ByVal sKeyName As String)

    lBufferSize = 0
    sBuffer = ""

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key could be opened then
    sBuffer = Space(255) 'make a buffer
    lBufferSize = Len(sBuffer)
    rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
    If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
    rtn = RegCloseKey(hKey) 'close the key
    sBuffer = Trim(sBuffer)
    GetStringValue = Left(sBuffer, lBufferSize - 1) 'return the value to the user
    Else 'otherwise, if the value couldnt be retreived
    GetStringValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants errors displayed then
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    End If
    Else 'otherwise, if the key couldnt be opened
    GetStringValue = "Error" 'return Error to the user
    If DisplayErrorMsg = True Then 'if the user wants errors displayed then
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    End If
    End If

    End Function


    Public Function CreateKey(ByVal sKey As String)

    CreateKey = False
    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegCreateKey(MainKeyHandle, sKey, hKey) 'create the key
    If rtn = ERROR_SUCCESS Then 'if the key was created then
    rtn = RegCloseKey(hKey) 'close the key
    CreateKey = True
    End If
    End If

    End Function


    Public Function DeleteKey(ByVal Keyname As String)

    DeleteKey = False
    Call ParseKey(Keyname, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegDeleteKey(MainKeyHandle, Keyname)
    If (rtn <> ERROR_SUCCESS) Then
    If DisplayErrorMsg = True Then 'if the user wants errors displayed then
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    Else
    DeleteKey = True
    End If
    End If

    End Function


    Public Function DeleteKeyValue(ByVal sKeyName As String, ByVal sValueName As String)

    DeleteKeyValue = False
    Dim hKey As Long 'handle of open key

    Call ParseKey(sKeyName, MainKeyHandle)

    If MainKeyHandle Then

    rtn = RegOpenKeyEx(MainKeyHandle, sKeyName, 0, KEY_WRITE, hKey) 'open the specified key
    If (rtn = ERROR_SUCCESS) Then
    rtn = RegDeleteValue(hKey, sValueName)
    If (rtn <> ERROR_SUCCESS) Then
    If DisplayErrorMsg = True Then 'if the user wants errors displayed then
    MsgBox GetErrorMsg(rtn) 'tell the user what was wrong
    End If
    Else
    DeleteKeyValue = True
    End If
    rtn = RegCloseKey(hKey)

    End If

    End If

    End Function


    Public Function DeleteAllKeySubItems()

    DeleteAllKeySubItems = False

    End Function


    Public Function KeyExist(ByVal sKey As String)
    Dim hKey As Long

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
    If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
    KeyExist = True
    Else
    KeyExits = False
    End If
    End If

    End Function


    Public Function KeyValueExist(ByVal sKey As String, ByVal sKeyName As String)
    Dim hKey As Long
    Dim lActualType As Long
    Dim lSize As Long

    Dim sTmp As String

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then

    rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
    If (rtn = ERROR_SUCCESS) Then

    rtn = RegQueryValueEx(hKey, ByVal sKeyName, 0&, lActualType, sTmp, lSize) 'ByVal 0&, lSize)
    If (rtn = ERROR_SUCCESS) Then
    KeyValueExist = True
    Else
    KeyValueExist = False
    End If

    End If

    End If

    End Function


    Private Sub ParseKey(Keyname As String, Keyhandle As Long)

    rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname

    If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
    MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user
    Exit Sub 'exit the procedure
    ElseIf rtn = 0 Then 'if the Keyname contains no "\"
    Keyhandle = GetMainKeyHandle(Keyname)
    Keyname = "" 'leave Keyname blank
    Else 'otherwise, Keyname contains "\"
    Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname
    Keyname = Right(Keyname, Len(Keyname) - rtn)
    End If

    End Sub


    Private Function GetMainKeyHandle(MainKeyName As String) As Long

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

    Select Case MainKeyName
    Case "HKEY_CLASSES_ROOT"
    GetMainKeyHandle = HKEY_CLASSES_ROOT
    Case "HKEY_CURRENT_USER"
    GetMainKeyHandle = HKEY_CURRENT_USER
    Case "HKEY_LOCAL_MACHINE"
    GetMainKeyHandle = HKEY_LOCAL_MACHINE
    Case "HKEY_USERS"
    GetMainKeyHandle = HKEY_USERS
    Case "HKEY_PERFORMANCE_DATA"
    GetMainKeyHandle = HKEY_PERFORMANCE_DATA
    Case "HKEY_CURRENT_CONFIG"
    GetMainKeyHandle = HKEY_CURRENT_CONFIG
    Case "HKEY_DYN_DATA"
    GetMainKeyHandle = HKEY_DYN_DATA
    End Select

    End Function

    Private Function GetErrorMsg(lErrorCode As Long) As String

    'If an error does accurr, and the user wants error messages displayed, then
    'display one of the following error messages

    Select Case lErrorCode
    Case 1009, 1015
    GetErrorMsg = "The Registry Database is corrupt!"
    Case 2, 1010
    GetErrorMsg = "Bad Key Name"
    Case 1011
    GetErrorMsg = "Can't Open Key"
    Case 4, 1012
    GetErrorMsg = "Can't Read Key"
    Case 5
    GetErrorMsg = "Access to this key is denied"
    Case 1013
    GetErrorMsg = "Can't Write Key"
    Case 8, 14
    GetErrorMsg = "Out of memory"
    Case 87
    GetErrorMsg = "Invalid Parameter"
    Case 234
    GetErrorMsg = "There is more data than the buffer has been allocated to hold."
    Case Else
    GetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)
    End Select

    End Function




  3. #3

    Thread Starter
    New Member
    Join Date
    Nov 2000
    Location
    Sydney
    Posts
    9

    Smile Thanks

    Thanks for your help

  4. #4
    Guest
    Code for a Module
    Code:
    Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKEY As Long) As Long
    Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal HKEY As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal HKEY As Long, ByVal lpSubKey As String) As Long
    Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal HKEY As Long, ByVal lpValueName As String) As Long
    Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal HKEY As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
    Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal HKEY As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
    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 HKEY_PERFORMANCE_DATA = &H80000004
    Public Const REG_SZ = 1
    
    Function RegQueryStringValue(ByVal HKEY As Long, ByVal strValueName As String)
        Dim lResult As Long
        Dim lValueType As Long
        Dim strBuf As String
        Dim lDataBufSize As Long
        
        On Error GoTo 0
        lResult = RegQueryValueEx(HKEY, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
        If lResult = ERROR_SUCCESS Then
            If lValueType = REG_SZ Then
                strBuf = String(lDataBufSize, " ")
                lResult = RegQueryValueEx(HKEY, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
                If lResult = ERROR_SUCCESS Then
                    RegQueryStringValue = StripTerminator(strBuf)
                End If
            End If
        End If
    End Function
    
    Public Function GetSettingEx(HKEY As Long, sPath As String, sValue As String)
        Dim KeyHand&
        Dim datatype&
        Call RegOpenKey(HKEY, sPath, KeyHand&)
        GetSettingEx = RegQueryStringValue(KeyHand&, sValue)
        Call RegCloseKey(KeyHand&)
    End Function
    
    Function StripTerminator(ByVal strString As String) As String
        Dim intZeroPos As Integer
    
        intZeroPos = InStr(strString, Chr$(0))
        If intZeroPos > 0 Then
            StripTerminator = Left$(strString, intZeroPos - 1)
        Else
            StripTerminator = strString
        End If
    End Function
    
    Public Sub SaveSettingEx(HKEY As Long, sPath As String, sValue As String, sData As String)
        Dim KeyHand As Long
        Call RegCreateKey(HKEY, sPath, KeyHand)
        Call RegSetValueEx(KeyHand&, sValue, 0, REG_SZ, ByVal sData, Len(sData))
        Call RegCloseKey(KeyHand&)
    End Sub
    Usage
    Code:
    'Save a Value to the Registry
    SaveSettingEx HKEY_CURRENT_USER, "Software\Myapp", "Testing", "Hello"
    
    
    'Get a value from the Registry
    Retval = GetSettingEx(HKEY_CURRENT_USER, "Software\Myapp", "Testing")
    Print Retval

  5. #5
    Hyperactive Member Wak's Avatar
    Join Date
    Nov 2000
    Location
    Brisbane, Queensland
    Posts
    298

    Cool Easier Response

    I'm starting to get brain sore. All this thinking.

    If you are just getting a string use the Reg

    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 Byte, _
    lpcbData As Long _
    ) As Long

    'You know the drill.
    Private Const REG_SZ = 1
    dim phkResult as long
    'Returns handle for desired directory

    Public Constant HKEY_PATH _ = "HKEY_LOCAL_MACHINE\SOFTWARE\Adobe\Acrobat Reader\4.0 _ \InstallPath\(Default)
    'Default install path
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    'Local machine section

    Private Sub Command1_Click()
    Dim nTest As Integer
    Dim strValue As String
    Dim lngValueLen As Long
    Dim lngData As Long
    Dim lngDataLen As Long
    Dim strData As Byte
    'Above are just varible to either determine or store values.

    strValue = Space(255)
    lngValueLen = 255
    lngDataLen = 255

    'String value can be no greater that 255 characters.

    'If you already have the handle to the current key skip this, but you'll need the add the RegOpenKey API code to top declarations

    RegOpenKey HKEY_LOCAL_MACHINE, HKEY_PATH, phkResult

    Do While nTest = 0
    'nTest <> 0 is no error or no more values left
    'Handle to use instead of HKEY_LOCAL_MACHINE
    'SubItem to Return "1" means first subitem
    'ByVal strValue value to return
    'Length of strValue
    'Leave to 0 if you want the info to be available after you reset.
    'REG_SZ
    type of C++ string with a vbNullChar at the end of it.
    'StrData Data to return (not important)
    'lngDataLen Length of strData


    nTest = RegEnumValue(phkResult, 1, ByVal strValue, lngValueLen, 0, REG_SZ, strData, lngDataLen)
    'Use desired string where ever
    Loop
    end sub
    'Thats all there is to it.
    'Any more questions email me.
    Visual Basic 6.0 Enterprise
    Visual C++ 6.0 Professional

    Wak

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width