Attribute VB_Name = "modWinUSB"
'Purpose: <BR>
'   Windows DDK WinUSB API and Setup API Converted to Visual Basic 5/6<BR>
'       Note:   WinUSB Index represents CurrentControlSet device index<BR>
'               MultiUSB Index represents Index of stored WinUsbDevice for multiple DPP devices<BR>

Option Explicit

'#Const bEnableDeviceNotification = 0
#Const bEnableDeviceNotification = 1

'Purpose: MultiUSB Index to DPP Serial Number storage type.
Public Type MUSB_SN_TO_INDEX
    Index As Long   'WinUSB Device Information Array Index for Device
    SerNum As Long  'DPP Device Serial Number
End Type

Public MUSB_MAX_INDEX As Long           'max index is 4 for five devices 0-4
Public MUSB_LAST_INDEX As Long          'last index is read fron vbDP5_MultiUSB.ini file
Public MUSB_SN(4) As Long               'multiusb serial numbers read from file
Public MUSB_Idx(4) As MUSB_SN_TO_INDEX  'multiusb serial numbers read from file

Public CurrentUSBDevice As Long         'WinUSB
Public NumUSBDevices As Long

'Purpose: Enumerates the error levels returned by ProcessError.
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

'Purpose: CopyMemory (RtlMoveMemory) moves memory either forward or backward, _
'         aligned or unaligned, in 4-byte blocks, followed by any remaining bytes.
'<BR>
'<BR>
'Remarks: The (Source + Length) can overlap the Destination range passed in to CopyMemory (RtlMoveMemory).
'<BR>
'<BR>
'Parameter: Destination Points to the destination of the move.
'Parameter: Source      Points to the memory to be copied.
'Parameter: Length      Specifies the number of bytes to be copied.
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 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 RegisterDeviceNotification Lib "user32.dll" Alias "RegisterDeviceNotificationA" (ByVal hRecipient As Long, NotificationFilter As Any, ByVal Flags As Long) As Long
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

'Purpose: DPP WinUSB device information data type.
Public Type WinUsbDevice
    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.
    SerNum As Long              'dpp serial number
    idxUSB As Long              'WinUSB device index (1-NumDevices)
    idxMUSB As Long             'MUSB array index
End Type

Public DppWinUSB As WinUsbDevice     'DppWinUSB device information
Public EmptyWinUSB As WinUsbDevice     'DppWinUSB device information
Public MultiWinUSB(4) As WinUsbDevice     'Multiple WinUSB device information, 0-4
Public NumMultiDpp As Long                  'number of multiusb devices

Public USBDeviceNotificationHandle As Long
Public USBDeviceConnected As Boolean
Public USBDevicePathName As String

'Registry functions for counting WinUSB devices
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const ERROR_SUCCESS = 0&
Public Const MAX_PATH = 260
Public Const MAXREGBUFFER = 128
Public Const MAXERRBUFFER = 256
Public Const MAX_DEVPATH_LENGTH = 256
Public Const NUM_ASYNCH_IO = 100
Public Const BUFFER_SIZE = 1024

Public Const MAXDP5S = 128              ' max number of devices
Public Const WinUSBService = "SYSTEM\CurrentControlSet\Services\WinUSB\Enum"
Public Const WinUsbDP5 = "USB\Vid_10c4&Pid_842a"
Public Const WinUsbDP5Size = 21
Public Const ERROR_NO_MORE_ITEMS = 259&

Public Const REG_NONE = 0                       ' No value type
Public Const REG_DWORD = 4                      ' 32-bit number

Public Function OpenDevice(hwnd As Long, ByRef DppWinUSB As WinUsbDevice, ByRef DeviceConnected As Boolean, DevicePathName As String, MemberIndex As Long) As Boolean
    Dim deviceFound As Boolean
    Dim NewDevicePathName As String
    Dim success As Boolean
    Dim winUsbDemoGuid As Guid
    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, MemberIndex)
        If deviceFound = True Then
            success = GetDeviceHandle(DppWinUSB, 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 DppWinUSB
            End If
        End If
        If DeviceConnected Then    'The device was detected.
            #If (bEnableDeviceNotification) Then
            '(Re)Register to receive notifications if the device is removed or attached.
            If USBDeviceNotificationHandle <> 0 Then   'Unregister old notification before creating new
                Call UnregisterDeviceNotification(USBDeviceNotificationHandle) 'Stop receiving notification messages.
            End If
            SetWindowLong hwnd, GWL_WNDPROC, glngPrevWndProc 'pass control back to previous windows
            success = RegisterForDeviceNotifications(DevicePathName, hwnd, winUsbDemoGuid, USBDeviceNotificationHandle)
            success = VbBool(success)
            If success Then
                glngPrevWndProc = GetWindowLong(hwnd, GWL_WNDPROC)
                SetWindowLong hwnd, GWL_WNDPROC, AddressOf WndProc
                InitializeDevice DppWinUSB
            End If
            #Else
                InitializeDevice DppWinUSB
            #End If
        End If
    End If
    OpenDevice = DeviceConnected
    Exit Function
OpenDeviceErr:
    Call ProcessError(Err)
End Function

'Purpose: Copies WinUsbDevice storage.
'Parameter: Source WinUsbDevice storage to be saved
'Parameter: Destination WinUsbDevice storage copy
Public Sub CopyWinUsbDevice(Source As WinUsbDevice, Destination As WinUsbDevice)
    Destination.DeviceHandle = Source.DeviceHandle             'Communications device resource handle.
    Destination.winUsbHandle = Source.winUsbHandle             'WinUSB interface handle.
    Destination.bulkInPipe = Source.bulkInPipe                 'Bulk IN pipe id.
    Destination.bulkOutPipe = Source.bulkOutPipe               'Bulk OUT pipe id.
    Destination.interruptInPipe = Source.interruptInPipe       'Interrupt IN pipe id.
    Destination.interruptOutPipe = Source.interruptOutPipe     'Interrupt OUT pipe id.
    Destination.devicespeed = Source.devicespeed               'Device speed indicator.
    
    Destination.SerNum = Source.SerNum                          'dpp serial number
    Destination.idxUSB = Source.idxUSB                          'WinUSB device index (1-NumDevices)
    Destination.idxMUSB = Source.idxMUSB                        'MUSB array index
End Sub

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

'Purpose: Closes the device handle obtained with CreateFile and frees resources.
Public Sub CloseDeviceHandle(DppWinUSB As WinUsbDevice)
    Dim success As Boolean
    On Error GoTo CloseDeviceHandleErr
        success = WinUsb_Free(DppWinUSB.winUsbHandle)
        success = VbBool(success)
        If Not (DppWinUSB.DeviceHandle = 0) Then
            If Not (DppWinUSB.DeviceHandle) Then
                CloseHandle (DppWinUSB.DeviceHandle)
            End If
        End If
    Exit Sub
CloseDeviceHandleErr:
    Call ProcessError(Err)
End Sub

'Purpose: Requests a handle with CreateFile.
'<BR>
' Returns The handle.
'<BR>
'<BR>
'Parameter: devicePathName Returned by SetupDiGetDeviceInterfaceDetail
' in an SP_DEVICE_INTERFACE_DETAIL_DATA structure.
Public Function GetDeviceHandle(ByRef DppWinUSB As WinUsbDevice, ByVal DevicePathName As String) As Boolean
    Dim security As SECURITY_ATTRIBUTES
    security.lpSecurityDescriptor = 0
    security.bInheritHandle = 1
    security.nLength = Len(security)
    DppWinUSB.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 (DppWinUSB.DeviceHandle) Then
        GetDeviceHandle = True
    Else
        MsgBox GetErrorString(Err.LastDllError)
        GetDeviceHandle = False
    End If
End Function

'Purpose: Initializes a device interface and obtains information about it.  Calls these
' winusb API functions: WinUsb_Initialize,WinUsb_QueryInterfaceSettings, WinUsb_QueryPipe
'<BR>
' Returns True on success, False on failure.
'<BR>
'<BR>
'Parameter: DppWinUSB DPP WinUSB device information
Public Function InitializeDevice(ByRef DppWinUSB As WinUsbDevice) 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(DppWinUSB.DeviceHandle, DppWinUSB.winUsbHandle)
    success = VbBool(success)
    If success Then
        success = WinUsb_QueryInterfaceSettings(DppWinUSB.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(DppWinUSB.winUsbHandle, 0, CByte(i), pipeInfo)
                success1 = VbBool(success1)
                If ((pipeInfo.PipeType = USBD_PIPE_TYPE.UsbdPipeTypeBulk) And _
                    UsbEndpointDirectionIn(pipeInfo.PipeId)) Then
                    DppWinUSB.bulkInPipe = pipeInfo.PipeId
                    Call SetPipePolicy(DppWinUSB, CByte(DppWinUSB.bulkInPipe), CInt(PIPE_POLICY_TYPE.IGNORE_SHORT_PACKETS), False)   ' this is the default, but set it anyway
                    Call SetPipePolicy(DppWinUSB, CByte(DppWinUSB.bulkInPipe), CInt(PIPE_POLICY_TYPE.AUTO_CLEAR_STALL), True)    ' new - 2/5/2010
                    Call SetPipePolicy(DppWinUSB, CByte(DppWinUSB.bulkInPipe), CInt(PIPE_POLICY_TYPE.ALLOW_PARTIAL_READS), False)    ' new - 5/25/2010
                    Call SetPipePolicy1(DppWinUSB, CByte(DppWinUSB.bulkInPipe), CInt(PIPE_POLICY_TYPE.PIPE_TRANSFER_TIMEOUT), pipeTimeout)
                ElseIf ((pipeInfo.PipeType = USBD_PIPE_TYPE.UsbdPipeTypeBulk) And _
                    UsbEndpointDirectionOut(pipeInfo.PipeId)) Then
                    DppWinUSB.bulkOutPipe = pipeInfo.PipeId
                    'Call SetPipePolicy(CByte(DppWinUSB.bulkOutPipe), CInt(PIPE_POLICY_TYPE.IGNORE_SHORT_PACKETS), False)
                    Call SetPipePolicy(DppWinUSB, CByte(DppWinUSB.bulkOutPipe), CInt(PIPE_POLICY_TYPE.SHORT_PACKET_TERMINATE), True)
                    Call SetPipePolicy(DppWinUSB, CByte(DppWinUSB.bulkOutPipe), CInt(PIPE_POLICY_TYPE.AUTO_CLEAR_STALL), True)
                    Call SetPipePolicy1(DppWinUSB, CByte(DppWinUSB.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

'Purpose: Sets pipe policy.
' Used when the value parameter is a byte (all except PIPE_TRANSFER_TIMEOUT).
'<BR>
' Returns True on success, False on failure.
'<BR>
'<BR>
'Parameter: PipeId Pipe to set a policy for.
'Parameter: PolicyType PIPE_POLICY_TYPE member.
'Parameter: Value Policy value.
Private Function SetPipePolicy(ByRef DppWinUSB As WinUsbDevice, 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(DppWinUSB.winUsbHandle, PipeId, PolicyType, 1, CByte(Value))
    success = VbBool(success)
    SetPipePolicy = success
    Exit Function
SetPipePolicyErr:
    Call ProcessError(Err)
End Function

'Purpose: Sets pipe policy.
' Used when the value parameter is a long (PIPE_TRANSFER_TIMEOUT only).
'<BR>
' Returns True on success, False on failure.
'<BR>
'<BR>
'Parameter: PipeId     Pipe to set a policy for.
'Parameter: PolicyType PIPE_POLICY_TYPE member.
'Parameter: Value      Policy value.
Public Function SetPipePolicy1(ByRef DppWinUSB As WinUsbDevice, 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(DppWinUSB.winUsbHandle, PipeId, PolicyType, 4, Value)
    success = VbBool(success)
    SetPipePolicy1 = success
    Exit Function
SetPipePolicy1Err:
    Call ProcessError(Err)
End Function

'Purpose: Is the endpoint's direction IN (device to host)
'<BR>
' Returns True if IN (device to host), False if OUT (host to device)
'<BR>
'<BR>
'Parameter: addr The endpoint address.
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

'Purpose: Is the endpoint's direction OUT (host to device)
'<BR>
' Returns True if OUT (host to device, False if IN (device to host)
'<BR>
'<BR>
'Parameter: addr The endpoint address.
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

'Purpose: Compares two device path names. Used to find out if the device name
'       of a recently attached or removed device matches the name of a
'       device the application is communicating with.
'<BR>
'<BR>
' Returns True if the names match, False if not.
'<BR>
'<BR>
'Parameter: m              A WM_DEVICECHANGE message. A call to RegisterDeviceNotification
'                          causes WM_DEVICECHANGE messages to be passed to an OnDeviceChange routine..
'Parameter: DevicePathName A device pathname returned by SetupDiGetDeviceInterfaceDetail
'                          in an SP_DEVICE_INTERFACE_DETAIL_DATA structure.
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

'Purpose: Use SetupDi (Setup Device Installation) API functions to retrieve the device path name of an
'           attached device that belongs to a device interface class.
'<BR>
'<BR>
' Returns True if a device is found, False if not.
'<BR>
'<BR>
'Parameter: TestGuid         Interface class GUID.
'Parameter: devicePathName A pointer to the device path name of an attached device.
Public Function FindDeviceFromGuid(ByRef TestGuid As Guid, ByRef DevicePathName As String, MemberIndex As Long) 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 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
        End If
        'MemberIndex = MemberIndex + 1
    'Loop Until (lastDevice = True)
    SetupDiDestroyDeviceInfoList (DeviceInfoSet)
    FindDeviceFromGuid = deviceFound
    Exit Function
FindDeviceFromGuidErr:
    Call ProcessError(Err)
End Function

'Purpose: Requests to receive a notification when a device is attached or removed.
'<BR>
'<BR>
' Returns True on success, False otherwise.
'<BR>
'<BR>
'Parameter: devicePathName           Handle to a device.
'Parameter: formHandle               Handle to the window that will receive device events.
'Parameter: classGuid                Device interface GUID.
'Parameter: deviceNotificationHandle Returned device notification handle.
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.
    #If (bEnableDeviceNotification) Then
    deviceNotificationHandle = RegisterDeviceNotification(formHandle, devBroadcastDeviceInterface, DEVICE_NOTIFY_WINDOW_HANDLE)
    If (deviceNotificationHandle = 0#) Then
        RegisterForDeviceNotifications = False
    Else
        RegisterForDeviceNotifications = True
    End If
    #Else
        RegisterForDeviceNotifications = False
    #End If
    Exit Function
RegisterForDeviceNotificationsErr:
    Call ProcessError(Err)
End Function

'Purpose: Returns and/or displays process error messages
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

#If (bEnableDeviceNotification) Then
'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.
        'frmDP5.OnDeviceChange hWnd, Msg, wParam, lParam
        frmDP5.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
#End If

'Purpose: Counts the number of WinUSB DPP device connected
Public Function CountDP5WinusbDevices()
    Dim hKey As Long
    Dim retCode As Long
    Dim lRet As Long
    Dim idxDP5 As Long
    Dim DevicePath(MAXREGBUFFER - 1) As Byte
    Dim cbDevicePath As Long
    Dim KeyName As String
    Dim cbKeyName As Long
    Dim ErrMsg As String
    Dim cbErrMsg As Long
    Dim strDevicePath As String

    NumUSBDevices = 0
    retCode = RegOpenKeyEx(HKEY_LOCAL_MACHINE, WinUSBService, 0&, KEY_QUERY_VALUE, hKey)
    If (retCode <> ERROR_SUCCESS) Then
        CountDP5WinusbDevices = 0
        Exit Function
    End If
    KeyName = Space(MAX_PATH)
    ' Test ALL Keys (0,1,... are device paths, Count,NextInstance,(Default) have other info)
    For idxDP5 = 0 To (MAXDP5S + 3) - 1 'devs + 3 other keys
        cbKeyName = MAX_PATH
        cbDevicePath = MAXREGBUFFER
        retCode = RegEnumValue(hKey, idxDP5, ByVal KeyName, cbKeyName, 0&, REG_NONE, DevicePath(0), cbDevicePath)
        If (retCode = ERROR_SUCCESS) Then
            strDevicePath = ByteArrayToString(DevicePath)
            If (StrComp(Left(KeyName, 5), "Count", vbTextCompare) = 0) Then
                'do nothing
            ElseIf (StrComp(Left(strDevicePath, WinUsbDP5Size), WinUsbDP5, vbTextCompare) = 0) Then ' DP5 device path found
                'TRACE("DP5 device [%d]: %s=%s\r\n", (NumUSBDevices + 1), KeyName, DevicePath);
                NumUSBDevices = NumUSBDevices + 1
            End If
        ElseIf (retCode = ERROR_NO_MORE_ITEMS) Then    ' no more values to read
            Exit For
        Else                                        ' error reading values
            cbErrMsg = MAXERRBUFFER
            ErrMsg = Space(MAXERRBUFFER)
            lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, retCode, 0&, ErrMsg, cbErrMsg, 0&)
            If (lRet > 0) Then ErrMsg = Left(ErrMsg, lRet) Else ErrMsg = ""
            'MsgBox ErrMsg
            Exit For
        End If
    Next
    Call RegCloseKey(hKey)
    CountDP5WinusbDevices = NumUSBDevices      '/* return number of devices */
End Function

Public Function ByteArrayToString(byteArray() As Byte) As String
    Dim str As String
    Dim PosTerminator As String
    str = StrConv(byteArray, vbUnicode)
    PosTerminator = InStr(str, Chr(0))
    If PosTerminator > 0 Then str = Left(str, PosTerminator - 1)
    ByteArrayToString = str
End Function