Hi,
I have found some code on the web to get a registry key remotely with special credential
Public Enum RegHive As UInteger
HKEY_CLASSES_ROOT = &H80000000UI
HKEY_CURRENT_USER = &H80000001UI
HKEY_LOCAL_MACHINE = &H80000002UI
HKEY_USERS = &H80000003UI
HKEY_CURRENT_CONFIG = &H80000005UI
End Enum
Public Enum RegType
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_MULTI_SZ = 7
REG_QWORD = 11
End Enum
Public Function LireCleDistantWMI2(Poste As String, strCle As String, VarReg As String) As String
Dim options As ConnectionOptions
options = New ConnectionOptions
options.Impersonation = ImpersonationLevel.Impersonate
options.EnablePrivileges = True
options.Username = "user admin"
options.Password = "**********"
Dim myScope As New ManagementScope((Convert.ToString("\\") & Poste) + "\root\default", options)
Dim mypath As New ManagementPath("StdRegProv")
Dim mc As New ManagementClass(myScope, mypath, Nothing)
Dim oValue As Object = GetValue(mc, RegHive.HKEY_LOCAL_MACHINE, strCle, VarReg)
If oValue = Nothing Then Return "NO"
Debug.Print(oValue.ToString())
If oValue = "" Then
LireCleDistantWMI2 = "NO"
Else
LireCleDistantWMI2 = oValue
End If
End Function
Private Function GetValue(mc As ManagementClass, hDefKey As RegHive, sSubKeyName As String, sValueName As String) As Object
Dim rType As RegType = GetValueType(mc, hDefKey, sSubKeyName, sValueName)
If rType = 0 Then Return Nothing
Dim inParams As ManagementBaseObject = mc.GetMethodParameters("GetStringValue")
inParams("hDefKey") = hDefKey
inParams("sSubKeyName") = sSubKeyName
inParams("sValueName") = sValueName
Dim oValue As Object = Nothing
Dim outParams As ManagementBaseObject
Select Case rType
Case RegType.REG_SZ
outParams = mc.InvokeMethod("GetStringValue", inParams, Nothing)
Debug.Print(outParams("ReturnValue"))
If Convert.ToUInt32(outParams("ReturnValue")) = 0 Then
oValue = outParams("sValue")
Else
End If
Exit Select
Case RegType.REG_EXPAND_SZ
outParams = mc.InvokeMethod("GetExpandedStringValue", inParams, Nothing)
If Convert.ToUInt32(outParams("ReturnValue")) = 0 Then
oValue = outParams("sValue")
Else
End If
Exit Select
Case RegType.REG_MULTI_SZ
outParams = mc.InvokeMethod("GetMultiStringValue", inParams, Nothing)
If Convert.ToUInt32(outParams("ReturnValue")) = 0 Then
oValue = outParams("sValue")
Else
End If
Exit Select
Case RegType.REG_DWORD
outParams = mc.InvokeMethod("GetDWORDValue", inParams, Nothing)
If Convert.ToUInt32(outParams("ReturnValue")) = 0 Then
oValue = outParams("uValue")
Else
End If
Exit Select
Case RegType.REG_BINARY
outParams = mc.InvokeMethod("GetBinaryValue", inParams, Nothing)
If Convert.ToUInt32(outParams("ReturnValue")) = 0 Then
oValue = TryCast(outParams("uValue"), Byte())
Else
End If
Exit Select
End Select
Return oValue
End Function
Private Function GetValueType(mc As ManagementClass, hDefKey As RegHive, sSubKeyName As String, sValueName As String) As RegType
Dim inParams As ManagementBaseObject = mc.GetMethodParameters("EnumValues")
inParams("hDefKey") = hDefKey
inParams("sSubKeyName") = sSubKeyName
GetValueType = Nothing
Dim outParams As ManagementBaseObject = mc.InvokeMethod("EnumValues", inParams, Nothing)
Try
Debug.Print("Valeur retour mc.InvokeMethod('EnumValues') : " & outParams("ReturnValue"))
Select Case Convert.ToUInt32(outParams("ReturnValue"))
Case 0
Dim sNames As String() = TryCast(outParams("sNames"), [String]())
Dim iTypes As Integer() = TryCast(outParams("Types"), Integer())
For i As Integer = 0 To sNames.Length - 1
If sNames(i) = sValueName Then
Debug.Print("ReturnValueTYpe : " & CType(iTypes(i), RegType))
Return CType(iTypes(i), RegType)
End If
Next
Case 1
MsgBox("ERROR_INVALID_FUNCTION" & vbCrLf & vbCrLf & "sur la clé" & vbCrLf & sSubKeyName, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "GetValueType WMI")
Case 2
MsgBox("ERROR_FILE_NOT_FOUND" & vbCrLf & vbCrLf & "sur la clé" & vbCrLf & sSubKeyName, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "GetValueType WMI")
Case 161
MsgBox("ERROR_BAD_PATHNAME" & vbCrLf & vbCrLf & "sur la clé" & vbCrLf & sSubKeyName, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "GetValueType WMI")
Case Else
MsgBox("ERREUR INCONNUE" & vbCrLf & vbCrLf & "sur la clé" & vbCrLf & sSubKeyName & vbCrLf & vbCrLf & "code disponible sur " & vbCrLf & _
"https://msdn.microsoft.com/en-us/library/ms681382%28v=3Dvs.85%29.aspx", _
MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "GetValueType WMI")
End Select
Catch ex As Exception
MsgBox(ex.HResult.ToString & " : " & ex.Message, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "GetValueType")
End Try
End Function
This code run correctly with some keys but with some others key I have an issu with the GetValueType function. It return error code 2
Is anybody can help
regards
What I have tried:
strDEST_FOLDER = LireCleDistantWMI2(Poste, "SOFTWARE\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
return "C:\Program Files (x86)" instead of "C:\Program Files"
strDEST_FOLDER = LireCleDistantWMI2(Poste, "SOFTWARE\Dassault Systemes\" & BVersion & "\0", "DEST_FOLDER")
return error 2