www.pudn.com > the PC Host examples .zip > HIDInterface.bas

Attribute VB_Name = "AccessIODevice" 
'   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