borderAndreaVB free resources for Visual Basic developersborder
AndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2017 Andrea Tincani
:: Read remote registry

AndreaVB Monthly Tip Award

Author  

De Schagt Dirk

Language  

VB5, VB6

Operating Systems  

Windows 95, 98 and NT
API Declarations
'This tip is based on existing tip (but with some bugfixes and explanation)
'The code should be treated as an example 
'e.g. more treating needed of other kinds of values

'Module :
Option Explicit

Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

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

Public Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" _
	(ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long

Public 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

Public 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

Public 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

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

Public 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 SECURITY_ATTRIBUTES, phkResult As Long, _
	lpdwDisposition As Long) As Long

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

'Defined Keys
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_CURRENT_CONFIG = &H80000005

'Constants Definition
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_EVENT = &H1
Public Const KEY_NOTIFY = &H10
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
	KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
	KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
	KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _
	KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const REG_BINARY = 3
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_OPTION_BACKUP_RESTORE = 4
Public Const REG_OPTION_CREATE_LINK = 2
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_OPTION_RESERVED = 0
Public Const REG_OPTION_VOLATILE = 1
Public Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or _
	REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or _
	REG_NOTIFY_CHANGE_SECURITY)
Public Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or _
	REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or _
	REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
Module
Function :
Function ReadRemoteReg(ByVal sRemoteServer, ByVal KeyRoot As Long, _
	ByVal sRegPath As String, ByVal sValueName) As String
    Dim hKey As Long
    Dim KeyValType As Long
    Dim KeyValSize As Long
    Dim KeyVal As String
    Dim tmpVal As String
    Dim res As Long
    Dim i As Integer
    Dim iChar As Integer
    Dim sChar, sWorkStr As String
    Dim bUseZero As Boolean
    Dim lReturnCode, lHive, lhRemoteRegistry As Long
    
    lReturnCode = RegConnectRegistry(sRemoteServer, KeyRoot, lhRemoteRegistry)
    res = RegOpenKeyEx(lhRemoteRegistry, sRegPath, 0, KEY_ALL_ACCESS, hKey)
    If res <> 0 Then GoTo Errore
    tmpVal = String(1024, 0)
    KeyValSize = 1024
    res = RegQueryValueEx(hKey, sValueName, 0, KeyValType, ByVal tmpVal, KeyValSize)
    If res <> 0 Then GoTo Errore
    Select Case KeyValType
    Case REG_SZ
        'remove trailing chr(0)
        tmpVal = Left(tmpVal, InStr(1, tmpVal, Chr(0), vbTextCompare) - 1)
        KeyVal = tmpVal
    Case REG_DWORD
        bUseZero = False
        ' format of keys in tmpVal :
        ' e.g. in registry : (hex) : 40001  ==> reads : 4 0 1 (meaning : 04 00 01)
        ' e.g. in registry : (hex) : 4000f  ==> reads : 4 0 15 (meaning : 04 00 f)
        ' e.g. in registry : (hex) : 121326 ==> reads : 18 19 38 (meaning : 12 13 26)
        sWorkStr = ""
        For i = Len(tmpVal) To 1 Step -1
            'check each code, get asci an convert to hex. You should have 2 digits
            iChar = Asc(Mid(tmpVal, i, 1))
            If iChar <> 0 Then
                bUseZero = True
            End If
            If bUseZero = True Then
                'make sure you have 2 digits (add extra 0 if necessary)
                If Len(Hex(iChar)) = 2 Then
                    ' no need to add an extra 0
                    sWorkStr = sWorkStr & Hex(iChar)
                Else
                    sWorkStr = sWorkStr & "0" & Hex(iChar)
                End If
                'MsgBox iChar & " - " & i & vbCrLf & sWorkStr, , "test prog"
            End If
        Next
        ' remove the leading 0: and add &h so you know it is hex
        If Left(sWorkStr, 1) = "0" Then
            sWorkStr = Right(sWorkStr, Len(sWorkStr) - 1)
        End If
        KeyVal = "&h" & sWorkStr
    Case REG_MULTI_SZ
        tmpVal = Left(tmpVal, InStr(1, tmpVal, Chr(0), vbTextCompare) - 1)
        KeyVal = tmpVal
    End Select
    ReadRemoteReg = KeyVal
    RegCloseKey hKey
    Exit Function
Errore:
    ReadRemoteReg = ""
    RegCloseKey hKey
End Function
Usage
'example to call function :
Dim CompName, sSMS_Site, sSMS_Travel As String

CompName = "\\MyComputerName"

sSMS_Site = ReadRemoteReg(CompName, HKEY_LOCAL_MACHINE, _
    "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "SystemRoot")
:: Navigation

Home

Using the Registry

Previous Tip

Next Tip

:: Search this site
Google
:: Related Topics
icon 05-08-2005 Registry by farhha1
icon 21-07-2005 Re: WMI - General question by Goran
icon 09-12-2003 Re: VB Database by BRMC
:: Sponsored Links



borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2017 Andrea Tincaniborder