Attribute VB_Name = "modWinUSB"
Option Explicit

Public Type Message
    hWnd As Long    'Handle of window.
    Msg As Long     'Message.
    wParam As Long  'First message parameter.
    lParam As Long  'Second message parameter.
End Type

Public Enum ERRORLEVEL
    elevCodeReturn          'Return error code.
    elevDescReturn          'Return error description string.
    elevSrcDescReturn       'Return error description string and error source string.
    elevMsgBox              'Return/Display error description string and error source string.
End Enum

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public glngPrevWndProc As Long
Public Declare Function RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal Count As Long) As Long
Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageZId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByVal Arguments As Long) As Long

Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Public Const DBT_DEVICEARRIVAL As Long = 32768
Public Const DBT_DEVICEREMOVECOMPLETE As Long = 32772
Public Const DBT_DEVTYP_DEVICEINTERFACE     As Long = 5
Public Const DEVICE_NOTIFY_WINDOW_HANDLE As Long = 0
Public Const WM_DEVICECHANGE As Long = &H219
Public Const DIGCF_PRESENT As Integer = &H2
Public Const DIGCF_DEVICEINTERFACE As Integer = &H10

Public Type Guid
    D1 As Long
    D2 As Integer
    D3 As Integer
    D4(7) As Byte
End Type

Public Type DEV_BROADCAST_DEVICEINTERFACE
    dbcc_size As Long
    dbcc_devicetype As Long
    dbcc_reserved As Long
    dbcc_classguid As Guid
    dbcc_name As Long
End Type

Public Type DEV_BROADCAST_DEVICEINTERFACE2
  dbcc_size As Long
  dbcc_devicetype As Long
  dbcc_reserved As Long
  dbcc_classguid As Guid
  dbcc_name As String * 1024
End Type

Public Type DEV_BROADCAST_HDR
    dbch_size As Long
    dbch_devicetype As Long
    dbch_reserved As Long
End Type

Public Type SP_DEVICE_INTERFACE_DATA
    cbSize As Long
    InterfaceClassGuid As Guid
    Flags As Long
    Reserved As Long
End Type

Public Type SP_DEVICE_INTERFACE_DETAIL_DATA
    cbSize As Long
    DevicePath As Byte
    'DataPath(256) As Byte
End Type

Public Declare Function RegisterDeviceNotification Lib "user32.dll" Alias "RegisterDeviceNotificationA" (ByVal hRecipient As Long, NotificationFilter As Any, ByVal Flags As Long) As Long
Public Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
Public Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As Guid, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Boolean
Public Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassGuid As Guid, ByVal Enumerator As String, ByVal hwndParent As Long, ByVal Flags As Long) As Long
Public Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, ByVal DeviceInterfaceDetailData As Long, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, ByVal DeviceInfoData As Long) As Boolean
Public Declare Function UnregisterDeviceNotification Lib "user32.dll" (ByVal Handle As Long) As Boolean

Public Const FILE_ATTRIBUTE_NORMAL As Integer = &H80
Public Const FILE_FLAG_OVERLAPPED As Long = &H40000000
Public Const FILE_SHARE_READ As Integer = &H1
Public Const FILE_SHARE_WRITE As Integer = &H2
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const OPEN_EXISTING As Integer = 3

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

Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Boolean
Public Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Public Enum PIPE_POLICY_TYPE
    SHORT_PACKET_TERMINATE = &H1
    AUTO_CLEAR_STALL
    PIPE_TRANSFER_TIMEOUT
    IGNORE_SHORT_PACKETS
    ALLOW_PARTIAL_READS
    AUTO_FLUSH
    RAW_IO
    MAXIMUM_TRANSFER_SIZE
End Enum

Public Type WINUSB_PIPE_INFORMATION
    PipeType As USBD_PIPE_TYPE
    PipeId As Byte
    MaximumPacketSize As Integer
    Interval As Byte
End Type

Public Enum USBD_PIPE_TYPE
    UsbdPipeTypeControl
    UsbdPipeTypeIsochronous
    UsbdPipeTypeBulk
    UsbdPipeTypeInterrupt
End Enum

Public Type USB_INTERFACE_DESCRIPTOR
    bLength As Byte
    bDescriptorType As Byte
    bInterfaceNumber As Byte
    bAlternateSetting As Byte
    bNumEndpoints As Byte
    bInterfaceClass As Byte
    bInterfaceSubClass As Byte
    bInterfaceProtocol As Byte
    iInterface As Byte
End Type

Public Declare Function WinUsb_Initialize Lib "winusb.dll" (ByVal DeviceHandle As Long, ByRef InterfaceHandle As Long) As Boolean
Public Declare Function WinUsb_Free Lib "winusb.dll" (ByVal InterfaceHandle As Long) As Boolean
Public Declare Function WinUsb_QueryInterfaceSettings Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal AlternateInterfaceNumber As Byte, ByRef UsbAltInterfaceDescriptor As USB_INTERFACE_DESCRIPTOR) As Boolean
Public Declare Function WinUsb_QueryPipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal AlternateInterfaceNumber As Byte, ByVal PipeIndex As Byte, ByRef PipeInformation As WINUSB_PIPE_INFORMATION) As Boolean
Public Declare Function WinUsb_SetPipePolicy Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte, ByVal PolicyType As Long, ByVal ValueLength As Long, ByRef Value As Byte) As Boolean
Public Declare Function WinUsb_SetPipePolicy1 Lib "winusb.dll" Alias "WinUsb_SetPipePolicy" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte, ByVal PolicyType As Long, ByVal ValueLength As Long, ByRef Value As Long) As Boolean
Public Declare Function WinUsb_ReadPipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte, ByRef Buffer As Byte, ByVal BufferLength As Long, ByRef LengthTransferred As Long, ByVal Overlapped As Long) As Boolean
Public Declare Function WinUsb_WritePipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte, ByRef Buffer As Byte, ByVal BufferLength As Long, ByRef LengthTransferred As Long, ByVal Overlapped As Long) As Boolean
Public Declare Function WinUsb_ResetPipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte) As Boolean
Public Declare Function WinUsb_AbortPipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte) As Boolean
Public Declare Function WinUsb_FlushPipe Lib "winusb.dll" (ByVal InterfaceHandle As Long, ByVal PipeId As Byte) As Boolean

Public Type devInfo
    DeviceHandle As Long        'Communications device resource handle.
    winUsbHandle As Long        'WinUSB interface handle.
    bulkInPipe As Long          'Bulk IN pipe id.
    bulkOutPipe As Long         'Bulk OUT pipe id.
    interruptInPipe As Long     'Interrupt IN pipe id.
    interruptOutPipe As Long    'Interrupt OUT pipe id.
    devicespeed As Long         'Device speed indicator.
End Type

Public TestDevInfo As devInfo     'Test device information


Public deviceNotificationHandle As Long
Public DeviceConnected As Boolean
Public DevicePathName As String

'Public Function OpenDevice(hWnd As Long, DeviceConnected As Boolean, DevicePathName As String) As Boolean
Public Function OpenDevice(hWnd As Long, DeviceConnected As Boolean, DevicePathName As String, ByRef TotalDevices As Integer) As Boolean
    Dim deviceFound As Boolean
    Dim NewDevicePathName As String
    Dim success As Boolean
    Dim winUsbDemoGuid As Guid
    'Dim TotalDevices As Integer ' added by DS for multiple USB devices
    OpenDevice = False
    NewDevicePathName = ""
    On Error GoTo OpenDeviceErr
    If Not DeviceConnected Then
        winUsbDemoGuid.D1 = &H5A8ED6A1
        winUsbDemoGuid.D2 = &H7FC3
        winUsbDemoGuid.D3 = &H4B6A
        winUsbDemoGuid.D4(0) = &HA5
        winUsbDemoGuid.D4(1) = &H36
        winUsbDemoGuid.D4(2) = &H95
        winUsbDemoGuid.D4(3) = &HDF
        winUsbDemoGuid.D4(4) = &H35
        winUsbDemoGuid.D4(5) = &HD0
        winUsbDemoGuid.D4(6) = &H34
        winUsbDemoGuid.D4(7) = &H48
        'Fill an array with the device path names of all attached devices with matching GUIDs.
        'deviceFound = FindDeviceFromGuid(winUsbDemoGuid, NewDevicePathName)
        deviceFound = FindDeviceFromGuid(winUsbDemoGuid, NewDevicePathName, TotalDevices)
        If deviceFound = True Then
            success = GetDeviceHandle(NewDevicePathName)
            success = VbBool(success)
            If (success) Then
                DeviceConnected = True
                DevicePathName = NewDevicePathName   'Save NewDevicePathName so OnDeviceChange() knows which name is Test device.
            Else    'There was a problem in retrieving the information.
                DeviceConnected = False
                CloseDeviceHandle
            End If
        End If
        If DeviceConnected Then    'The device was detected.
            '(Re)Register to receive notifications if the device is removed or attached.
            If deviceNotificationHandle <> 0 Then   'Unregister old notification before creating new
                Call UnregisterDeviceNotification(deviceNotificationHandle) 'Stop receiving notification messages.
            End If
            SetWindowLong hWnd, GWL_WNDPROC, glngPrevWndProc 'pass control back to previous windows
            success = RegisterForDeviceNotifications(DevicePathName, hWnd, winUsbDemoGuid, deviceNotificationHandle)
            success = VbBool(success)
            If success Then
                glngPrevWndProc = GetWindowLong(hWnd, GWL_WNDPROC)
                SetWindowLong hWnd, GWL_WNDPROC, AddressOf WndProc
                InitializeDevice
            End If
        End If
    End If
    OpenDevice = DeviceConnected
    Exit Function
OpenDeviceErr:
    Call ProcessError(Err)
End Function

Public Sub DeviceConnectedDisplay(rtbStatus As RichTextLib.RichTextBox, isDetected As Boolean)
    If (isDetected) Then
        UpdateStatusList rtbStatus, "Device connected.", RGB(0, 128, 0)
    Else
        UpdateStatusList rtbStatus, "Could not connect to device.", vbRed
    End If
End Sub

Public Sub UpdateStatusList(rtbStatus As RichTextLib.RichTextBox, strStatus As String, Optional clrColor As Long = vbBlack)
    On Error GoTo UpdateStatusListErr
    StatusList rtbStatus, strStatus, clrColor
    Exit Sub
UpdateStatusListErr:
    Call ProcessError(Err)
End Sub

Public Sub StatusList(rtbStatus As RichTextLib.RichTextBox, strStatus As String, clrColor As Long, Optional bNL As Boolean = True)
    Dim prvlen As Long
    Dim strNL As String
On Error GoTo 0
    prvlen = Len(rtbStatus.Text)
    rtbStatus.SelStart = Len(rtbStatus.Text) + 1
    strNL = ""
    If (bNL) Then strNL = vbNewLine
    rtbStatus.SelText = strStatus & strNL
    rtbStatus.SelStart = prvlen
    rtbStatus.SelLength = Len(strStatus & strNL)
    rtbStatus.SelColor = clrColor
    rtbStatus.SelStart = Len(rtbStatus.Text) + 1
End Sub

Public Sub CloseDeviceHandle()
    Dim success As Boolean
    On Error GoTo CloseDeviceHandleErr
        success = WinUsb_Free(TestDevInfo.winUsbHandle)
        success = VbBool(success)
        If Not (TestDevInfo.DeviceHandle = 0) Then
            If Not (TestDevInfo.DeviceHandle) Then
                CloseHandle (TestDevInfo.DeviceHandle)
            End If
        End If
    Exit Sub
CloseDeviceHandleErr:
    Call ProcessError(Err)
End Sub

Public Function GetDeviceHandle(ByVal DevicePathName As String) As Boolean
    Dim security As SECURITY_ATTRIBUTES
    security.lpSecurityDescriptor = 0
    security.bInheritHandle = 1
    security.nLength = Len(security)
    TestDevInfo.DeviceHandle = CreateFile(DevicePathName, _
                                GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                                security, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0)
    If Not (TestDevInfo.DeviceHandle) Then
        GetDeviceHandle = True
    Else
        MsgBox GetErrorString(Err.LastDllError)
        GetDeviceHandle = False
    End If
End Function

Public Function InitializeDevice() As Boolean
    Dim ifaceDescriptor As USB_INTERFACE_DESCRIPTOR
    Dim pipeInfo As WINUSB_PIPE_INFORMATION
    Dim pipeTimeout As Long
    Dim success As Boolean
    Dim success1 As Boolean
    Dim i As Long

    pipeTimeout = 500   ' 2/4/10 - seems like 500mS should be plenty?
    'Erase FPGA' takes 4s, worst case! Change timeout just for that command
    On Error GoTo InitializeDeviceErr
    success = WinUsb_Initialize(TestDevInfo.DeviceHandle, TestDevInfo.winUsbHandle)
    success = VbBool(success)
    If success Then
        success = WinUsb_QueryInterfaceSettings(TestDevInfo.winUsbHandle, 0, ifaceDescriptor)
        success = VbBool(success)
        If success Then
            ' Get the transfer type, endpoint number, and direction for the interface's
            ' bulk and interrupt endpoints. Set pipe policies.
            For i = 0 To ifaceDescriptor.bNumEndpoints - 1
                success1 = WinUsb_QueryPipe(TestDevInfo.winUsbHandle, 0, CByte(i), pipeInfo)
                success1 = VbBool(success1)
                If ((pipeInfo.PipeType = USBD_PIPE_TYPE.UsbdPipeTypeBulk) And _
                    UsbEndpointDirectionIn(pipeInfo.PipeId)) Then
                    TestDevInfo.bulkInPipe = pipeInfo.PipeId
                    Call SetPipePolicy(CByte(TestDevInfo.bulkInPipe), CInt(PIPE_POLICY_TYPE.IGNORE_SHORT_PACKETS), False)   ' this is the default, but set it anyway
                    Call SetPipePolicy(CByte(TestDevInfo.bulkInPipe), CInt(PIPE_POLICY_TYPE.AUTO_CLEAR_STALL), True)    ' new - 2/5/2010
                    Call SetPipePolicy(CByte(TestDevInfo.bulkInPipe), CInt(PIPE_POLICY_TYPE.ALLOW_PARTIAL_READS), False)    ' new - 5/25/2010
                    Call SetPipePolicy1(CByte(TestDevInfo.bulkInPipe), CInt(PIPE_POLICY_TYPE.PIPE_TRANSFER_TIMEOUT), pipeTimeout)
                ElseIf ((pipeInfo.PipeType = USBD_PIPE_TYPE.UsbdPipeTypeBulk) And _
                    UsbEndpointDirectionOut(pipeInfo.PipeId)) Then
                    TestDevInfo.bulkOutPipe = pipeInfo.PipeId
                    'Call SetPipePolicy(CByte(TestDevInfo.bulkOutPipe), CInt(PIPE_POLICY_TYPE.IGNORE_SHORT_PACKETS), False)
                    Call SetPipePolicy(CByte(TestDevInfo.bulkOutPipe), CInt(PIPE_POLICY_TYPE.SHORT_PACKET_TERMINATE), True)
                    Call SetPipePolicy(CByte(TestDevInfo.bulkOutPipe), CInt(PIPE_POLICY_TYPE.AUTO_CLEAR_STALL), True)
                    Call SetPipePolicy1(CByte(TestDevInfo.bulkOutPipe), CInt(PIPE_POLICY_TYPE.PIPE_TRANSFER_TIMEOUT), pipeTimeout)
                End If
            Next i
        Else
            success = False
        End If
    End If
    success = VbBool(success)
    InitializeDevice = success
    Exit Function
InitializeDeviceErr:
    Call ProcessError(Err)
End Function

Private Function SetPipePolicy(ByVal PipeId As Byte, ByVal PolicyType As Long, ByVal Value As Boolean) As Boolean
    Dim success As Boolean
    On Error GoTo SetPipePolicyErr
    success = WinUsb_SetPipePolicy(TestDevInfo.winUsbHandle, PipeId, PolicyType, 1, CByte(Value))
    success = VbBool(success)
    SetPipePolicy = success
    Exit Function
SetPipePolicyErr:
    Call ProcessError(Err)
End Function

Public Function SetPipePolicy1(ByVal PipeId As Byte, ByVal PolicyType As Long, ByVal Value As Long) As Boolean
    Dim success As Boolean
    SetPipePolicy1 = False
    On Error GoTo SetPipePolicy1Err
    success = WinUsb_SetPipePolicy1(TestDevInfo.winUsbHandle, PipeId, PolicyType, 4, Value)
    success = VbBool(success)
    SetPipePolicy1 = success
    Exit Function
SetPipePolicy1Err:
    Call ProcessError(Err)
End Function

Private Function UsbEndpointDirectionIn(ByVal addr As Long) As Boolean
    On Error GoTo UsbEndpointDirectionInErr
        If ((addr And &H80) = &H80) Then
            UsbEndpointDirectionIn = True
        Else
            UsbEndpointDirectionIn = False
        End If
    Exit Function
UsbEndpointDirectionInErr:
    Call ProcessError(Err)
End Function

Private Function UsbEndpointDirectionOut(ByVal addr As Long) As Boolean
    On Error GoTo UsbEndpointDirectionOutErr
        If ((addr And &H80) = 0) Then
            UsbEndpointDirectionOut = True
        Else
            UsbEndpointDirectionOut = False
        End If
    Exit Function
UsbEndpointDirectionOutErr:
    Call ProcessError(Err)
End Function

Public Function DeviceNameMatch(m As Message, ByVal DevicePathName As String) As Boolean
    Dim deviceNameString As String
    Dim stringSize As Long
    deviceNameString = ""
    On Error GoTo DeviceNameMatchErr
    Dim devBroadcastDeviceInterface As DEV_BROADCAST_DEVICEINTERFACE2
    Dim devBroadcastHeader As DEV_BROADCAST_HDR
    CopyMemory devBroadcastHeader, ByVal (m.lParam), Len(devBroadcastHeader)
    If (devBroadcastHeader.dbch_devicetype = DBT_DEVTYP_DEVICEINTERFACE) Then
        CopyMemory devBroadcastDeviceInterface, ByVal (m.lParam), ByVal (devBroadcastHeader.dbch_size)
        stringSize = CInt((devBroadcastHeader.dbch_size - 32) / 2) + 1
        deviceNameString = CStr(Left(devBroadcastDeviceInterface.dbcc_name, stringSize)) 'Store the device name in a String.
        If (StrComp(deviceNameString, DevicePathName, vbTextCompare) = 0) Then    'Set ignorecase True.
            DeviceNameMatch = True
        Else
            DeviceNameMatch = False
        End If
    End If
    Exit Function
DeviceNameMatchErr:
    Call ProcessError(Err)
End Function

'Public Function FindDeviceFromGuid(ByRef TestGuid As Guid, ByRef DevicePathName As String) As Boolean
Public Function FindDeviceFromGuid(ByRef TestGuid As Guid, ByRef DevicePathName As String, ByRef NumberOfDevices As Integer) As Boolean
    Dim bufferSize As Long
    Dim bufferSizeReq As Long
    Dim detailDataBuffer() As Byte
    Dim DevDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
    Dim deviceFound As Boolean
    Dim DeviceInfoSet As Long
    Dim lastDevice As Boolean
    Dim MemberIndex As Long
    Dim TestDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
    'Dim pDevicePathName As Long
    Dim success As Boolean
    Dim pDevicePathName As String

    On Error GoTo FindDeviceFromGuidErr
    DeviceInfoSet = SetupDiGetClassDevs(TestGuid, vbNullString, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)
    deviceFound = False
    MemberIndex = 0
    Do
        TestDeviceInterfaceData.cbSize = Len(TestDeviceInterfaceData)   'The size is 28 bytes.
        success = SetupDiEnumDeviceInterfaces(DeviceInfoSet, 0, TestGuid, MemberIndex, TestDeviceInterfaceData)
        success = VbBool(success)
        If (Not CBool(success)) Then    'Find out if a device information set was retrieved.
            lastDevice = True
        Else    'A device is present.
            success = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, TestDeviceInterfaceData, 0, 0, bufferSize, 0)
            success = VbBool(success)
            DevDetailData.cbSize = Len(DevDetailData)
            ReDim detailDataBuffer(bufferSize)  '
            Call RtlMoveMemory(detailDataBuffer(0), DevDetailData, 4)
            success = SetupDiGetDeviceInterfaceDetail _
                        (DeviceInfoSet, _
                        TestDeviceInterfaceData, _
                        VarPtr(detailDataBuffer(0)), _
                        bufferSize, _
                        bufferSizeReq, _
                        0)
            success = VbBool(success)
            pDevicePathName = CStr(detailDataBuffer())                          'Convert the byte array to a string.
            pDevicePathName = StrConv(pDevicePathName, vbUnicode)               'Convert to Unicode.
            pDevicePathName = Right$(pDevicePathName, Len(pDevicePathName) - 4) 'Strip cbSize (4 bytes) from the beginning.
            DevicePathName = pDevicePathName    'Get the String containing the devicePathName.
            deviceFound = True
        
            'UpdateStatusList Form1.rtbStatus, DevicePathName, vbBlue
        
        End If
        MemberIndex = MemberIndex + 1
    Loop Until (lastDevice = True)
    SetupDiDestroyDeviceInfoList (DeviceInfoSet)
    FindDeviceFromGuid = deviceFound
    NumberOfDevices = MemberIndex - 1 ' added by DS for multiple units
    Exit Function
FindDeviceFromGuidErr:
    Call ProcessError(Err)
End Function

Public Function RegisterForDeviceNotifications(ByVal DevicePathName As String, ByVal formHandle As Long, ByRef ClassGuid As Guid, ByRef deviceNotificationHandle As Long) As Boolean
    Dim devBroadcastDeviceInterface As DEV_BROADCAST_DEVICEINTERFACE
    Dim devBroadcastDeviceInterfaceBuffer As Long
    Dim size As Long
    On Error GoTo RegisterForDeviceNotificationsErr
    size = Len(devBroadcastDeviceInterface)         'Set the size.
    devBroadcastDeviceInterface.dbcc_size = size
    devBroadcastDeviceInterface.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
    devBroadcastDeviceInterface.dbcc_reserved = 0
    devBroadcastDeviceInterface.dbcc_classguid = ClassGuid  'Specify the interface class to receive notifications about.
    deviceNotificationHandle = RegisterDeviceNotification(formHandle, devBroadcastDeviceInterface, DEVICE_NOTIFY_WINDOW_HANDLE)
    If (deviceNotificationHandle = 0#) Then
        RegisterForDeviceNotifications = False
    Else
        RegisterForDeviceNotifications = True
    End If
    Exit Function
RegisterForDeviceNotificationsErr:
    Call ProcessError(Err)
End Function

Public Function ProcessError(errError As ErrObject, Optional errSource As String = "", Optional errControl As ERRORLEVEL = elevSrcDescReturn) As Variant
    Select Case errControl
        Case elevCodeReturn
            ProcessError = errError.Number
        Case elevDescReturn
            ProcessError = errError.Description
        Case elevSrcDescReturn
            ProcessError = errSource & " : " & errError.Description
        Case elevMsgBox
            ProcessError = errSource & " : " & errError.Description
            MsgBox errError.Description, vbCritical, errSource
        Case Else
            ProcessError = errSource & " : " & errError.Description
    End Select
    MsgBox errError.Description & " " & errError.LastDllError
End Function

'Purpose: Converts any C boolean type to a VB boolean type
Public Function VbBool(bBool As Variant) As Boolean
    On Error GoTo VbBoolErr
    VbBool = False
    If (bBool = 0) Then
        VbBool = False
    Else
        VbBool = True
    End If
    Exit Function
VbBoolErr:
End Function

'Purpose: Returns the error message for the last error.
'Adapted from Dan Appleman's "Win32 API Puzzle Book"
Public Function GetErrorString(ByVal LastError As Long) As String
    Dim Bytes As Long
    Dim ErrorString As String
    ErrorString = String$(129, 0)
    Bytes = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, LastError, 0, ErrorString$, 128, 0)
    'Subtract two characters from the message to strip the CR and LF.
    If Bytes > 2 Then
        GetErrorString = Left$(ErrorString, Bytes - 2)
    End If
End Function

'Purpose: Overrides WndProc to enable checking for and handling WM_DEVICECHANGE messages.
'Parameter: Windows message info
Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo WndProcErr
    If Msg = WM_DEVICECHANGE Then   'The OnDeviceChange routine processes WM_DEVICECHANGE messages.
        Form1.OnDeviceChange hWnd, Msg, wParam, lParam
    End If
    Debug.Print Msg
    'Pass the messages onto VB's own Window Procedure to let the base form process the message.
    WndProc = CallWindowProc(glngPrevWndProc, hWnd, Msg, wParam, lParam)
    Exit Function
WndProcErr:
    Call ProcessError(Err)
End Function