'   This module is common to all of the Example programs

'   It declares the {Open, Read, Write, Close} calls for the USB device

'       These user-calls are translated into OS system calls

'   This module also contains several support routines used by all of the examples

'

'   Declare module-wide variables

Private HidHandle As Long



Public Function OpenUSBdevice(NameOfDevice$) As Boolean

' This function searches the system HID tables for NameOfDevice$

' If found then it opens the device and returns TRUE, else it returns FALSE

Dim HidGuid As Guid: Dim Success As Boolean: Dim Openned As Boolean: Dim Buffer(256) As Byte

Dim DeviceInterfaceData As Device_Interface_Data

Dim FunctionClassDeviceData As Device_Interface_Detail

'

'   First, get the HID class identifier

Call HidD_GetHidGuid(HidGuid.Data(0))

'   Get a handle for the Plug and Play node, request currently active HID devices

PnPHandle& = SetupDiGetClassDevs(HidGuid.Data(0), 0, 0, &H12)

If (PnPHandle& = -1) Then ErrorExit ("Could not attach to PnP node")

'

HidEntry& = 0: Openned = False

DeviceInterfaceData.cbsize = 28 'Length of data structure in bytes

'   Look through the table of HID devices

Do While SetupDiEnumDeviceInterfaces(PnPHandle&, 0, HidGuid.Data(0), HidEntry&, DeviceInterfaceData.cbsize)

'   There is a device here, get it's name

    FunctionClassDeviceData.cbsize = 5

    Success = SetupDiGetDeviceInterfaceDetail(PnPHandle&, DeviceInterfaceData.cbsize, _

            FunctionClassDeviceData.cbsize, UBound(FunctionClassDeviceData.DataPath), BytesReturned&, 0)

    If (Success = 0) Then ErrorExit ("Could not get the name of this HID device")

' Convert returned C string to Visual Basic String

    HidName$ = "": i& = 0

    Do While FunctionClassDeviceData.DataPath(i&) <> 0

        HidName$ = HidName$ & Chr$(FunctionClassDeviceData.DataPath(i&)): i& = i& + 1: Loop

' Can now open this HID device

    HidHandle& = CreateFile(HidName$, &HC0000000, 3, 0, 3, 0, 0)

    If (HidHandle = -1) Then ErrorExit ("Could not open HID device")

' Is it OUR HID device?

    If HidD_GetProductString(HidHandle&, AddressFor(Buffer(0)), UBound(Buffer)) Then

        DeviceName$ = "": i& = 0

        Do While Buffer(i&) <> 0: DeviceName$ = DeviceName$ & Chr$(Buffer(i&)): i& = i& + 2: Loop

        If (StrComp(DeviceName$, NameOfDevice$) = 0) Then

            Openned = True: Exit Do: End If

        End If 'HidD_GetProductString

    Call CloseHandle(HidHandle&) ' Was not OUR HID device

    HidEntry& = HidEntry& + 1 ' Check next entry

    Loop 'SetupDiEnumDeviceInterfaces returns FALSE when there are no more entries

OpenUSBdevice = Openned

End Function



Public Sub ReadUSBdevice(BufferPtr&, ByteCount&)

' This subroutine "reads" from an openned USB device

' This routine gets an Input Report from the USB device and returns the data

' NOTE that ReadFile is a BLOCKING system call, ie it will wait for the USB device to respond

' Do not configure the USB device to "Generate report only on change" since the program

' will appear to 'hang'

' Use a local buffer so that the ReportID (=0) at ReportBuffer(0) may be removed

Dim ReportBuffer(256) As Byte

If ByteCount& > 254 Then ErrorExit ("Maximum ByteCount for ReadUSBdevice is 254")

If ByteCount& < 1 Then ErrorExit ("Minimum ByteCount for ReadUSBdevice is 1")

Success = ReadFile(HidHandle&, AddressFor(ReportBuffer(0)), ByteCount& + 1, BytesReturned&, 0)

If (Success = 0) Then ErrorExit ("Could not get an Input Report")

Call CopyBuffer(AddressFor(ReportBuffer(1)), BufferPtr&, BytesReturned& - 1)

End Sub



Public Sub WriteUSBdevice(BufferPtr&, ByteCount&)

' This subroutine "writes" to an openned USB device

' Copy the user buffer into a local buffer so that a ReportID (=0) may be prepended

' The first byte will contain the ReportID (=0)

Dim ReportBuffer(256) As Byte

If ByteCount& > 254 Then ErrorExit ("Maximum ByteCount for WriteUSBdevice is 254")

Call CopyBuffer(BufferPtr&, AddressFor(ReportBuffer(1)), ByteCount&)

ReportBuffer(0) = 0 ' ReportID

Success = WriteFile(HidHandle&, AddressFor(ReportBuffer(0)), ByteCount& + 1, BytesWritten&, 0)

If (Success = 0) Then ErrorExit ("Could not write an Output Report")

End Sub



Public Sub CloseUSBdevice()

' This subroutine closes the USB device that we have been using

Call CloseHandle(HidHandle&)

End Sub



Public Function ReturnHexByte(Text$) As Byte

' Converts the first two characters of text$ into a byte

Dim Value As Byte

Utext$ = UCase(Text$) ' Convert to uppercase for search

HexString$ = "0123456789ABCDEF" ' Non-Hex characters = 0

Value = 0

For i& = 0 To 15

    If Mid(Utext$, 1, 1) = Mid(HexString$, i& + 1, 1) Then Value = Value + (16 * i&)

    If Mid(Utext$, 2, 1) = Mid(HexString$, i& + 1, 1) Then Value = Value + i&

    Next i&

ReturnHexByte = Value

End Function



Public Function TwoHexCharacters$(Value As Byte)

HexString$ = "0123456789ABCDEF"

TwoHexCharacters$ = Mid(HexString$, Int(Value / 16) + 1, 1) & Mid(HexString$, Int(Value And &HF) + 1, 1)

End Function



Public Function TwoDecimalCharacters$(Value As Byte)

DecimalString$ = "0123456789"

Tens& = Int(Value / 10): Units& = Value - (10 * Tens&)

TwoDecimalCharacters$ = Mid(DecimalString$, Tens& + 1, 1) & Mid(DecimalString$, Units& + 1, 1)

End Function



Public Function ThreeDecimalCharacters$(Value As Byte)

h& = Int(Value / 100): t& = Int((Value - (100 * h&)) / 10): u& = Value - (100 * h&) - (10 * t&)

ThreeDecimalCharacters$ = h& & t& & u&

End Function



Public Sub ErrorExit(Reason$)

ErrorCode = GetLastError()

Call MsgBox(Reason$, vbCritical)

Stop

End Sub