aquire path of USB device 
Author Message
 aquire path of USB device

Dear NG,

I'd like to write a function which aquires the path to a USB device (a
String that can be used with CreateFile). I know the VID and the PID of
the device.

I wrote a procedure (attachment) to do so which works with HID devices
pretty well:
First it uses 'SetupDiGetClassDevs' to get a handle of a device list.
Second it loops throu 'SetupDiEnumDeviceInterfaces' until this returns
0. For both APIs it uses the GUID it aquires via 'HidD_GetHidGuid'. In
each loop it gets the path by calling 'SetupDiGetDeviceInterfaceDetail'.

But how does it work for Non-HIDs? 'SetupDiGetClassDevs' with
GUID_DEVINTERFACE_USB_DEVICE delivers a handle but the list seams to be
emty. DIGCF_ALLCLASSES as flag also delivers a propper handle but
calling 'SetupDiEnumDeviceInterfaces' returns 0. And there are some
Non-HID USB devices connected to my system.

Can somebody help please?

[ modUSB.bas 6K ]
Attribute VB_Name = "modUSB"
Option Explicit

Public Function USB_OpenDevice(ByVal VID As Integer, ByVal PID As Integer, ByVal SerNum As String) As Long
    Dim dp As String, sa As SECURITY_ATTRIBUTES
    dp = GetDevicePath(VID, PID, SerNum)
    Debug.Print "Pfad: "; dp
    If Len(dp) > 0 Then
        sa.bInheritHandle = -1: sa.lpSecurityDescriptor = 0: sa.nLength = Len(sa)
        USB_OpenDevice = CreateFile(dp, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, sa, OPEN_EXISTING, ByVal 0&, ByVal 0&)
    Else
        USB_OpenDevice = 0
    End If
End Function

Public Sub USB_CloseDevice(ByRef DeviceHandle As Long)
    If DeviceHandle <> 0 Then CloseHandle DeviceHandle
    DeviceHandle = 0
End Sub

Public Function USB_GetSerNums(ByVal VID As Integer, ByVal PID As Integer) As String()
    Dim SerNums() As String: ReDim SerNums(0 To 0)
    Dim sn
    Dim DetailDataBuffer() As Byte, DeviceInfoSet As Long, MemberIndex As Long, lRet As Long, hHID As Long, Needed As Long, DetailData As Long, DevicePath As String
    Dim Security As SECURITY_ATTRIBUTES, DeviceAttributes As HIDD_ATTRIBUTES, HidGuid As GUID
    Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA

    HidD_GetHidGuid HidGuid

    DeviceInfoSet = SetupDiGetClassDevs(HidGuid, vbNullString, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)

    If DeviceInfoSet = INVALID_HANDLE_VALUE Then USB_GetSerNums = SerNums: Exit Function

    Security.nLength = LenB(Security): Security.bInheritHandle = -1: Security.lpSecurityDescriptor = 0
    DeviceAttributes.Size = LenB(DeviceAttributes)
    MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)

    MemberIndex = 0
    Do Until SetupDiEnumDeviceInterfaces(DeviceInfoSet, 0, HidGuid, MemberIndex, MyDeviceInterfaceData) = 0
        lRet = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, 0, 0, Needed, 0)
        DetailData = Needed
        MyDeviceInterfaceDetailData.cbSize = Len(MyDeviceInterfaceDetailData)
        ReDim DetailDataBuffer(0 To Needed)
        Call RtlMoveMemory(DetailDataBuffer(0), MyDeviceInterfaceDetailData, 4)
        lRet = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, VarPtr(DetailDataBuffer(0)), DetailData, Needed, 0)
        DevicePath = CStr(DetailDataBuffer()): DevicePath = StrConv(DevicePath, vbUnicode): DevicePath = Right$(DevicePath, Len(DevicePath) - 4)
        hHID = CreateFile(DevicePath, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, 0&, 0)
        lRet = HidD_GetAttributes(hHID, DeviceAttributes)
        If lRet <> 0 Then
            If DeviceAttributes.VendorID = VID And DeviceAttributes.ProductID = PID Then
                ReDim SerNums(0 To UBound(SerNums) + 1)
                Needed = 127
                ReDim DetailDataBuffer(0 To Needed)
                lRet = HidD_GetSerialNumberString(hHID, VarPtr(DetailDataBuffer(0)), Needed)
                sn = CStr(DetailDataBuffer())
                sn = Left$(sn, InStr(sn, Chr$(0)) - 1)
                SerNums(UBound(SerNums)) = sn
            End If
            lRet = CloseHandle(hHID)
        End If
        MemberIndex = MemberIndex + 1
    Loop
    lRet = SetupDiDestroyDeviceInfoList(DeviceInfoSet)
    USB_GetSerNums = SerNums
End Function

Private Function GetDevicePath(ByVal VID As Integer, ByVal PID As Integer, ByVal SerNum As String) As String
    Dim lRet As Long, MemberIndex As Long, HidGuid As GUID, hHID As Long, DeviceInfoSet As Long, DevicePath As String
    Dim DetailDataBuffer() As Byte, Needed As Long, DetailData As Long
    Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
    Dim Security As SECURITY_ATTRIBUTES, DeviceAttributes As HIDD_ATTRIBUTES
    Dim sn As String, n As Long

    HidD_GetHidGuid HidGuid
    DeviceInfoSet = SetupDiGetClassDevs(HidGuid, vbNullString, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE) ' Or DIGCF_ALLCLASSES)
    If DeviceInfoSet = INVALID_HANDLE_VALUE Then GetDevicePath = vbNullString: Exit Function
    Security.nLength = LenB(Security): Security.bInheritHandle = -1: Security.lpSecurityDescriptor = 0
    DeviceAttributes.Size = LenB(DeviceAttributes)
    MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
    DevicePath = vbNullString
    MemberIndex = 0
    Do Until (SetupDiEnumDeviceInterfaces(DeviceInfoSet, 0, HidGuid, MemberIndex, MyDeviceInterfaceData) = 0) Or (Len(DevicePath) <> 0)
        lRet = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, 0, 0, Needed, 0)
        DetailData = Needed
        MyDeviceInterfaceDetailData.cbSize = Len(MyDeviceInterfaceDetailData)
        ReDim DetailDataBuffer(Needed)
        Call RtlMoveMemory(DetailDataBuffer(0), MyDeviceInterfaceDetailData, 4)
        lRet = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, VarPtr(DetailDataBuffer(0)), DetailData, Needed, 0)
        DevicePath = CStr(DetailDataBuffer()): DevicePath = StrConv(DevicePath, vbUnicode): DevicePath = Right$(DevicePath, Len(DevicePath) - 4)
        hHID = CreateFile(DevicePath, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, 0&, 0)
        lRet = HidD_GetAttributes(hHID, DeviceAttributes)
        Debug.Print "Nr.: "; MemberIndex,
        If lRet <> 0 Then
            Debug.Print "VID: "; DeviceAttributes.VendorID, "PID: "; DeviceAttributes.ProductID
            If DeviceAttributes.VendorID = VID And DeviceAttributes.ProductID = PID Then
                Needed = 127
                ReDim DetailDataBuffer(0 To Needed)
                lRet = HidD_GetSerialNumberString(hHID, VarPtr(DetailDataBuffer(0)), Needed)
                sn = CStr(DetailDataBuffer())
                sn = Left$(sn, InStr(sn, Chr$(0)) - 1)
                If (Len(SerNum) > 0) And (sn <> SerNum) Then DevicePath = vbNullString
            Else
                DevicePath = vbNullString
            End If
        Else
            DevicePath = vbNullString
            Debug.Print
        End If
        lRet = CloseHandle(hHID)
        MemberIndex = MemberIndex + 1
    Loop
    lRet = SetupDiDestroyDeviceInfoList(DeviceInfoSet)
    GetDevicePath = DevicePath
End Function

Public Function USB_Read(ByVal hFile As Long, ByRef Buffer() As Byte, ByVal NumBytes As Long) As Long
    Dim ol As OVERLAPPED, nrb As Long
    USB_Read = ReadFile(hFile, Buffer(0), NumBytes, nrb, ol)
End Function

Private Function String2Guid(ByVal SinP As String) As GUID
    Dim n As Long, i As Long, s As String
    For n = 1 To Len(SinP)
        Select Case Mid$(SinP, n, 1)
            Case "A" To "F", "a" To "f", "0" To "9"
                s = s + Mid$(SinP, n, 1)
        End Select
    Next n
    For n = 1 To Len(s) Step 2
        String2Guid.Data4(n / 2 - 0.5) = CByte("&H" & Mid$(s, n, 2))
    Next n
End Function



Fri, 19 Aug 2011 19:15:47 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. How to flush/disconnect a USB device?

2. Programmatically eject USB device?

3. howto read values from an usb-device

4. comunicate with a usb device

5. Finding a USB device

6. USB Devices under Basic??

7. Cannot get GUID for USB Device Please help

8. USB Devices

9. VB code for accessing USB devices available

10. application software for USB device using VB

11. PILOT A USB DEVICE

12. How to send a string to a peripheral device throug the USB cable

 

 
Powered by phpBB® Forum Software