Bonjour
J'ai récupérer un bout de code sur internet
Il fonctionne pour certaine clé mais pas pour toutes.
voici le code
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
'Const HKEY_LOCAL_MACHINE = &H80000002
Public Enum RegType
'https://msdn.microsoft.com/en-us/library/aa390388.aspx
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
''' <summary>
''' Récupère la valeur du registre
''' </summary>
''' <param name="mc"></param>
''' <param name="hDefKey"></param>
''' <param name="sSubKeyName"></param>
''' <param name="sValueName"></param>
''' <returns></returns>
''' <remarks></remarks>
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")
' GetStringValue call failed
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")
' GetExpandedStringValue call failed
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")
' GetMultiStringValue call failed
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")
' GetDWORDValue call failed
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())
' GetBinaryValue call failed
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 'permet de retourner une valeur dans tous les cas
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"))
'code erreurs : https://msdn.microsoft.com/en-us/library/ms681382%28v=3Dvs.85%29.aspx
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
' value not found
Next
' EnumValues call failed
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
lorsque je l'appelle avec
Poste = "Poste distant"
strDEST_FOLDER = LireCleDistantWMI2(Poste, "SOFTWARE\Dassault Systemes\" & BVersion & "\0", "DEST_FOLDER")
cela ne fonctionne pas
(je veux vérifier si l'installation d'un programme existe")
si j'appelle avec ce code cela fonctionne
Poste ="Poste Distant"
strDEST_FOLDER = LireCleDistantWMI2(Poste, "SOFTWARE\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
cela retourne la chaine "C:\Program Files (x86)" mais cela devrait retourner plutot la chaine "C:\Program Files"
Lorsque cela ne fonctionne pas j’obtiens le message d'erreur : (erreur 2)
ERROR_FILE_NOT_FOUND
est-ce quelqu'un aurait une idée ?
Merci d'avance
Cordialement
H.Sabatou
