原创 vb与usb通讯主要程序

Option Explicit
Dim EventObject As Long
Dim HIDOverlapped As OVERLAPPED
Dim Capabilities As HIDP_CAPS
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim HidDevice As Long
Dim RidDevice As Long
'Dim WidDevice As Long
Dim LastDevice As Boolean
Dim Security As SECURITY_ATTRIBUTES
Dim MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim Needed As Long
Dim OutputReportData(7) As Byte
Dim PreparsedData As Long
Dim Result As Long
Dim Timeout As Boolean
Dim DeviceDetected As Boolean
Const MyVendorID = &H8888 '设备ID
Const MyProductID = &H6

Function FindTheHid() As Boolean

Dim Count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim MemberIndex As Long

LastDevice = False
MyDeviceDetected = False
Security.lpSecurityDescriptor = 0
Security.bInheritHandle = True
Security.nLength = Len(Security)
Result = HidD_GetHidGuid(HidGuid) '取得HID群组的GUID
DeviceInfoSet = SetupDiGetClassDevs _
    (HidGuid, _
    vbNullString, _
    0, _
    (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)) '取得所有HID信息的结构数组
MemberIndex = 0

Do
    MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
    Result = SetupDiEnumDeviceInterfaces _
        (DeviceInfoSet, _
        0, _
        HidGuid, _
        MemberIndex, _
        MyDeviceInterfaceData) '识别每一个HID接口
    If Result = 0 Then LastDevice = True
    If Result <> 0 Then
    MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
        Result = SetupDiGetDeviceInterfaceDetail _
           (DeviceInfoSet, _
           MyDeviceInterfaceData, _
           0, _
           0, _
           Needed, _
           0) '取得设备路径（为了分配空间）
       
    DetailData = Needed
    MyDeviceInterfaceDetailData.cbSize = _
            Len(MyDeviceInterfaceDetailData)
    ReDim DetailDataBuffer(Needed)
    Call RtlMoveMemory _
            (DetailDataBuffer(0), _
            MyDeviceInterfaceDetailData, _
            4)
    Result = SetupDiGetDeviceInterfaceDetail _
           (DeviceInfoSet, _
           MyDeviceInterfaceData, _
           VarPtr(DetailDataBuffer(0)), _
           DetailData, _
           Needed, _
0)  '取得设备路径
DevicePathName = CStr(DetailDataBuffer())
        DevicePathName = StrConv(DevicePathName, vbUnicode)
        DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)

      
    HidDevice = CreateFile _
            (DevicePathName, _
            0, _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            Security, _
            OPEN_EXISTING, _
            FILE_ATTRIBUTE_NORMAL, _
            0) '取得设备的标示代号
    DeviceAttributes.Size = LenB(DeviceAttributes)
        Result = HidD_GetAttributes _
            (HidDevice, _
            DeviceAttributes) '取得厂商与产品ID
    If (DeviceAttributes.VendorID = MyVendorID) And _
            (DeviceAttributes.ProductID = MyProductID) Then
                MyDeviceDetected = True
        Else
                MyDeviceDetected = False
    Result = CloseHandle _
                    (HidDevice)
        End If
End If
MemberIndex = MemberIndex + 1

Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
Result = SetupDiDestroyDeviceInfoList _
    (DeviceInfoSet)
If MyDeviceDetected = True Then
FindTheHid = True
Call GetDeviceCapabilities '调用获取设备能力
RidDevice = CreateFile _
            (DevicePathName, _
            (GENERIC_READ Or GENERIC_WRITE), _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            Security, _
            OPEN_EXISTING, _
           FILE_FLAG_OVERLAPPED, _
            0)
  If EventObject = 0 Then
    EventObject = CreateEvent _
        (Security, _
        True, _
        True, _
        "")
End If

HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
Else
MsgBox "没找到设备！", vbOKOnly
End If
End Function

Private Sub Command1_Click()

    Call ReadAndWriteToDevice
    Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
If Command2.Caption = "打开设备" Then
   Command2.Caption = "关闭设备"
DeviceDetected = FindTheHid
Else
  Command2.Caption = "打开设备"
  Timer1.Enabled = False
  End If
  Text1.Text = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Shutdown
End Sub
Private Sub Command3_Click()
Call Shutdown
End
End Sub
Private Sub Shutdown()

Result = CloseHandle _
    (HidDevice)
Result = CloseHandle _
    (RidDevice)
End Sub
Private Sub Form_Load()
Form1.Show
Timer1.Enabled = False
Timer1.Interval = 100
End Sub
Private Sub timer1_Timer()
Call ReadAndWriteToDevice
End Sub
Private Sub ReadAndWriteToDevice()
'Timer1.Enabled = False
If DeviceDetected = True Then
    Call ReadReport
    End If
End Sub
Private Sub GetDeviceCapabilities()
Dim ppData(29) As Byte
Dim ppDataString As Variant
Result = HidD_GetPreparsedData _
    (HidDevice, _
    PreparsedData)
Result = RtlMoveMemory _
    (ppData(0), _
    PreparsedData, _
    30)
ppDataString = ppData()
ppDataString = StrConv(ppDataString, vbUnicode)
Result = HidP_GetCaps _
    (PreparsedData, _
    Capabilities)
Dim ValueCaps(1023) As Byte

Result = HidP_GetValueCaps _
    (HidP_Input, _
    ValueCaps(0), _
    Capabilities.NumberInputValueCaps, _
    PreparsedData)
Result = HidD_FreePreparsedData _
    (PreparsedData)
End Sub
Private Sub ReadReport()
Dim Count
Dim NumberOfBytesRead As Long
Dim ReadBuffer() As Byte
Dim UBoundReadBuffer As Integer
Dim ByteValue As String
Dim length As Long
ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
'EventObject = CreateEvent _
'(Security, _
'True, _
'True, _
'"")
'HIDOverlapped.hEvent = EventObject
'HIDOverlapped.Offset = 0
'HIDOverlapped.OffsetHigh = 0

Result = ReadFile _
    (RidDevice, _
    ReadBuffer(0), _
    CLng(Capabilities.InputReportByteLength), _
    NumberOfBytesRead, _
    HIDOverlapped)
Result = WaitForSingleObject _
    (EventObject, _
    100)
    Select Case Result
    Case WAIT_TIMEOUT
    Result = CancelIo _
            (RidDevice)
            End Select
            Result = GetOverlappedResult _
            (RidDevice, _
            HIDOverlapped, _
            length, _
            True)
            If length = 9 Then
   Text1.Text = ""
    For Count = 1 To UBound(ReadBuffer)
    If Len(Hex$(ReadBuffer(Count))) < 2 Then
        ByteValue = "0" & Hex$(ReadBuffer(Count))
    Else
        ByteValue = Hex$(ReadBuffer(Count))
    End If
    Text1.SelStart = Len(Text1.Text)
    Text1.SelText = ByteValue & " "
Next Count
End If
Call ResetEvent(EventObject)
'Timer1.Enabled = True
End Sub

希望本资源发挥它最大价值。。