Détection connection périphérique USB

Patrick JONIEC a écrit :

Bonjour

Je cherche à détecter la connexion d'un nouveau périphérique USB avec
sysinfo :

Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal
DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)

LblDevice.Caption = "Nouveau périphérique détecté" & vbCrLf & "ID = "
& DeviceID & vbCrLf & "Nom : " & DeviceName
LblDevice.Refresh

End Sub

mais rien ne se passe...

merci de votre aide

Le code suivant, basé sur le même événement (DeviceArrival), fonctionne
correctement chez moi : clé de stockage USB, APN, par contre une clé USB
pour souris sans fil ne provoque rien (testé sous Vista) :
Option Explicit

Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)
DisplayDeviceInfos True, DeviceType, DeviceID, DeviceName, DeviceData
End Sub


Private Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)
DisplayDeviceInfos False, DeviceType, DeviceID, DeviceName, DeviceData
End Sub


Private Sub DisplayDeviceInfos(ByVal bArrival As Boolean, _
ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)

Dim sDeviceType As String
Dim sDeviceID As String
Dim sDeviceName As String
Dim Tmp As String, Msg As String
Dim i As Integer

Select Case DeviceType
Case 0: sDeviceType = "OEM"
sDeviceID = "GUID : " & Hex(DeviceID)

Case 1: sDeviceType = "Concentrateur"
sDeviceID = "Numéro : " & DeviceID

Case 2: sDeviceType = "Volume logique"
Tmp = Long2Bin(DeviceID)
sDeviceID = ""
For i = 1 To 16
If (Mid(Tmp, i, 1)) = "1" Then
sDeviceID = sDeviceID & IIf(Len(sDeviceID) > 0, "," & Chr$(81
- i), Chr$(81 - i)) & ":"
End If
Next i
sDeviceID = "Identifieur de volume : " & sDeviceID

Case 3: sDeviceType = "Port série ou parallèle"
sDeviceName = "Nom du port : " & DeviceName

Case 4: sDeviceType = "Non supporté"
sDeviceID = ""
End Select

If bArrival Then
Msg = "Connexion de périphérique"
Else
Msg = "Déconnexion de périphérique"
End If
Msg = Msg & vbCrLf & "Type de périphérique : " & sDeviceType
Msg = Msg & vbCrLf & sDeviceID
If DeviceType = 3 Then Msg = Msg & vbCrLf & sDeviceName
Msg = Msg & vbCrLf & "Données du périphérique : " & DeviceData
lblDevice.Caption = Msg
MsgBox Msg, vbOKOnly Or vbInformation
End Sub


Private Function Long2Bin(ByVal lValue As Long) As String
Dim l As Long, Tmp As Long
Dim sBinary As String

l = lValue
Do
Tmp = l Mod 2
sBinary = CStr(Tmp) + sBinary
l = l 2
Loop Until l = 0
While Len(sBinary) < 16
sBinary = "0" & sBinary
Wend
Long2Bin = sBinary
End Function


--

Cordialement,

Jacques.

Bizarre ...
Aujourd'hui, ça fonctionne !!!???
Merci de votre aide, mais ceci reste un mystère ...

"Jacques93" <jacques@Nospam> a écrit dans le message de
news:eYqQh6$vIHA.3380@TK2MSFTNGP03.phx.gbl...

Patrick JONIEC a écrit :

Bonjour

Je cherche à détecter la connexion d'un nouveau périphérique USB avec
sysinfo :

Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal
DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)

LblDevice.Caption = "Nouveau périphérique détecté" & vbCrLf & "ID = "
& DeviceID & vbCrLf & "Nom : " & DeviceName
LblDevice.Refresh

End Sub

mais rien ne se passe...

merci de votre aide

Le code suivant, basé sur le même événement (DeviceArrival), fonctionne
correctement chez moi : clé de stockage USB, APN, par contre une clé USB
pour souris sans fil ne provoque rien (testé sous Vista) :
Option Explicit

Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)
DisplayDeviceInfos True, DeviceType, DeviceID, DeviceName, DeviceData
End Sub


Private Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)
DisplayDeviceInfos False, DeviceType, DeviceID, DeviceName, DeviceData
End Sub


Private Sub DisplayDeviceInfos(ByVal bArrival As Boolean, _
ByVal DeviceType As Long, _
ByVal DeviceID As Long, _
ByVal DeviceName As String, _
ByVal DeviceData As Long)

Dim sDeviceType As String
Dim sDeviceID As String
Dim sDeviceName As String
Dim Tmp As String, Msg As String
Dim i As Integer

Select Case DeviceType
Case 0: sDeviceType = "OEM"
sDeviceID = "GUID : " & Hex(DeviceID)

Case 1: sDeviceType = "Concentrateur"
sDeviceID = "Numéro : " & DeviceID

Case 2: sDeviceType = "Volume logique"
Tmp = Long2Bin(DeviceID)
sDeviceID = ""
For i = 1 To 16
If (Mid(Tmp, i, 1)) = "1" Then
sDeviceID = sDeviceID & IIf(Len(sDeviceID) > 0, "," & Chr$(81 -
i), Chr$(81 - i)) & ":"
End If
Next i
sDeviceID = "Identifieur de volume : " & sDeviceID

Case 3: sDeviceType = "Port série ou parallèle"
sDeviceName = "Nom du port : " & DeviceName

Case 4: sDeviceType = "Non supporté"
sDeviceID = ""
End Select

If bArrival Then
Msg = "Connexion de périphérique"
Else
Msg = "Déconnexion de périphérique"
End If
Msg = Msg & vbCrLf & "Type de périphérique : " & sDeviceType
Msg = Msg & vbCrLf & sDeviceID
If DeviceType = 3 Then Msg = Msg & vbCrLf & sDeviceName
Msg = Msg & vbCrLf & "Données du périphérique : " & DeviceData
lblDevice.Caption = Msg
MsgBox Msg, vbOKOnly Or vbInformation
End Sub


Private Function Long2Bin(ByVal lValue As Long) As String
Dim l As Long, Tmp As Long
Dim sBinary As String

l = lValue
Do
Tmp = l Mod 2
sBinary = CStr(Tmp) + sBinary
l = l 2
Loop Until l = 0
While Len(sBinary) < 16
sBinary = "0" & sBinary
Wend
Long2Bin = sBinary
End Function


--

Cordialement,

Jacques.