vb USB通讯示例源码

VB编程
下载此实例
开发语言：ASP
实例大小：0.01M
下载次数：106
浏览次数：964
发布时间：2018-09-14
实例类别：VB编程
发布人：wujie1201
文件格式：.rar
所需积分：2
实例介绍

【实例简介】
【实例截图】
【核心代码】
VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   6060
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9075
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   MousePointer    =   1  'Arrow
   ScaleHeight     =   6060
   ScaleMode       =   0  'User
   ScaleWidth      =   9075
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   5820
      ItemData        =   "Form1.frx":0000
      Left            =   2760
      List            =   "Form1.frx":0002
      TabIndex        =   11
      Top             =   120
      Width           =   6255
   End
   Begin VB.Frame Frame3 
      Caption         =   "RWStart area"
      Height          =   1815
      Left            =   120
      TabIndex        =   8
      Top             =   4080
      Width           =   2535
      Begin VB.CommandButton Command2 
         Caption         =   "结束"
         Height          =   495
         Left            =   360
         TabIndex        =   10
         Top             =   1200
         Width           =   1335
      End
      Begin VB.CommandButton Command1 
         Caption         =   "开启"
         Height          =   495
         Left            =   360
         TabIndex        =   9
         Top             =   240
         Width           =   1335
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Data receive area"
      Height          =   1935
      Left            =   120
      TabIndex        =   5
      Top             =   2160
      Width           =   2535
      Begin VB.TextBox Text4 
         Height          =   375
         Left            =   1440
         TabIndex        =   7
         Top             =   720
         Width           =   975
      End
      Begin VB.TextBox Text3 
         Height          =   375
         Left            =   1440
         TabIndex        =   6
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "接收高字节："
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   720
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "接收低字节："
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Data send area"
      Height          =   1935
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2535
      Begin VB.TextBox Text2 
         Height          =   375
         Left            =   1440
         TabIndex        =   2
         Top             =   720
         Width           =   975
      End
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   1440
         TabIndex        =   1
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "发送高字节："
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "发送低字节："
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   1095
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit   '程序中所有变量必须全部声明，否则编译出错
 
 
Dim bAlertable As Long
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Dim HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim LastDevice As Boolean
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 ReadHandle As Long
Dim Result As Long
Dim Security As SECURITY_ATTRIBUTES
Dim Timeout As Boolean
Dim Buffer() As Byte   '转换字符串的缓冲区
Dim RWflage As Boolean
 
'这是厂商ID以及产品ID定义
'16进制定义
Const MyVendorID = &H925
Const MyProductID = &H1299
 
'系统初始化
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
 
MyDeviceDetected = False
End Sub
'数据转换与发送
Private Sub Command1_Click()
 
RWflage = False
If Text1.Text = "" Or Text2.Text = "" Then
 MsgBox "数据输入不能为空"
 Else
  If (Len(Text1.Text) > 2) Or (Len(Text1.Text) > 2) Then
   MsgBox "输入数据范围超出"
   Else
     Call StrringToHex  '字符串转换为16进制数进行发送
   End If
End If
 
If RWflage = True Then
Call StartRW            '调用函数进行数据发送与接收
RWflage = False
End If
End Sub
'字符串到16进制数转换函数
Private Sub StrringToHex()
 
 Dim Stri(4) As String
 Dim Store(4) As Byte
 Dim Flageerror1 As Boolean
 Dim Flageerror2 As Boolean
 Dim Flageerror3 As Boolean
 Dim Flageerror4 As Boolean
  
  
 Flageerror1 = True
 Flageerror2 = True
 Flageerror3 = True
 Flageerror4 = True
 's首先转换低位数
  
 Stri(0) = Mid$(Text1.Text, 1, 1)
 If (Stri(0) >= "0") And (Stri(0) <= "9") Then
   Store(0) = Asc(Stri(0)) - Asc("0")
 Else
  If (Stri(0) >= "A") And (Stri(0) <= "F") Then
    Store(0) = Asc(Stri(0)) - Asc("A")   10
  Else
    If (Stri(0) >= "a") And (Stri(0) <= "f") Then
     Store(0) = Asc(Stri(0)) - Asc("a")   10
    Else
      Flageerror1 = False
      MsgBox "输入数据有错，不再范围内"
       
    End If
   End If
 End If
  
 Stri(1) = Mid$(Text1.Text, 2, 1)
 If (Stri(1) >= "0") And (Stri(1) <= "9") Then
   Store(1) = Asc(Stri(1)) - Asc("0")
 Else
  If (Stri(1) >= "A") And (Stri(1) <= "F") Then
    Store(1) = Asc(Stri(1)) - Asc("A")   10
  Else
    If (Stri(1) >= "a") And (Stri(1) <= "f") Then
     Store(1) = Asc(Stri(1)) - Asc("a")   10
    Else
      Flageerror2 = False
      MsgBox "输入数据有错，不再范围内"
       
    End If
   End If
 End If
 
 
 Stri(2) = Mid$(Text2.Text, 1, 1)
  If (Stri(2) >= "0") And (Stri(2) <= "9") Then
   Store(2) = Asc(Stri(2)) - Asc("0")
 Else
  If (Stri(2) >= "A") And (Stri(2) <= "F") Then
    Store(2) = Asc(Stri(2)) - Asc("A")   10
  Else
    If (Stri(2) >= "a") And (Stri(2) <= "f") Then
     Store(2) = Asc(Stri(2)) - Asc("a")   10
    Else
      Flageerror3 = False
      MsgBox "输入数据有错，不再范围内"
       
    End If
   End If
 End If
  
 Stri(3) = Mid$(Text2.Text, 2, 1)
 If (Stri(3) >= "0") And (Stri(3) <= "9") Then
   Store(3) = Asc(Stri(3)) - Asc("0")
 Else
  If (Stri(3) >= "A") And (Stri(3) <= "F") Then
    Store(3) = Asc(Stri(3)) - Asc("A")   10
  Else
    If (Stri(3) >= "a") And (Stri(3) <= "f") Then
     Store(3) = Asc(Stri(3)) - Asc("a")   10
    Else
      Flageerror4 = False
      MsgBox "输入数据有错，不再范围内"
       
    End If
   End If
 End If
   
If (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) Then
  RWflage = True
   
  OutputReportData(0) = (Store(0) * 16   Store(1))
  OutputReportData(1) = (Store(2) * 16   Store(3))
End If
 
End Sub
Private Sub StartRW()
Dim count As Integer
 List1.AddItem ""
 List1.AddItem "***** HID Test Report *****"
 List1.AddItem "     " & Format(Now, "general date")
  
If MyDeviceDetected = False Then
  MyDeviceDetected = FindtheHid
End If
 
If MyDeviceDetected = True Then    '如果设备找到了，准备数据进行发送
       
    'OutputReportData(0) = Val(Text1.Text)
     
    'OutputReportData(1) = Val(Text2.Text)
 
  Call WriteReport
   
  Call ReadReport
   
End If
List1.ListIndex = List1.ListCount - 1
 
'清楚部分数据，最多显示300个列表
If List1.ListCount > 300 Then
    For count = 1 To 100
        List1.RemoveItem (count)
    Next count
End If
End Sub
 
'系统退出函数
Private Sub Command2_Click()
Dim a As Integer
 a = MsgBox("确定要退出?", 1   64   0)
 If a = 1 Then
  End
 End If
End Sub
 
'查询HID函数
Function FindtheHid() As Boolean
 
  Dim HidGuid As GUID
  Dim MemberIndex As Long
  Dim GUIDString As String
  Dim count As Integer
 
  LastDevice = False
  MyDeviceDetected = False
 
 
  Security.lpSecurityDescriptor = 0
  Security.bInheritHandle = True
  Security.nLength = Len(Security)
 
'*******************************************************
'HidD_GetHidGuid
'获得HID GUID
'Returns: the GUID in HidGuid.
'这个函数不从Result返回数值
'*******************************************************
  Result = HidD_GetHidGuid(HidGuid)
  Call DisplayResultOfAPICall("GetHidGuid")
 
  GUIDString = Hex$(HidGuid.Data1) & "-" & _
              Hex$(HidGuid.Data2) & "-" & _
              Hex$(HidGuid.Data3) & "-"
  For count = 0 To 7
   If HidGuid.Data4(count) >= &H10 Then
     GUIDString = GUIDString & Hex$(HidGuid.Data4(count))
   Else
     GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(count))
   End If
  Next count
  List1.AddItem "  GUID is:" & GUIDString
 
'*****************************************************
'SetupDiGetClassDevs
'返回值：是所有HID设备的借口的数组地址
'需要参数：HidD_GetHidGuid函数返回的HidGuid
'*****************************************************
  DeviceInfoSet = SetupDiGetClassDevs _
             (HidGuid, _
              vbNullString, _
              0, _
              (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
             
  Call DisplayResultOfAPICall("SetupDiClassDevs")
  DataString = GetDataString(DeviceInfoSet, 32)
  List1.AddItem DataString
 
'*****************************************************
'SetupDiEnumDeviceInterfaces识别HID接口
'次函数每一次调用都必须传递一个数组索引值来指定一个接口，用于查询所需要的HID接口
'DeviceInfoSet是SetupDiGetClassDevs函数的返回值
'InterfaceClassGuid 是HidGuid
'DeviceInterfaceData是要传回的结构，来识别HID的一个接口
'*****************************************************
   MemberIndex = 0
Do
   MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
   Result = SetupDiEnumDeviceInterfaces _
        (DeviceInfoSet, _
        0, _
        HidGuid, _
        MemberIndex, _
        MyDeviceInterfaceData)
   If Result = 0 Then LastDevice = True   '如果返回0则证明所有查询已经结束
   If Result <> 0 Then
      List1.AddItem "  DeviceInfoSet for device #" & CStr(MemberIndex) & ": "
      List1.AddItem "  cbSize = " & CStr(MyDeviceInterfaceData.cbSize)
      List1.AddItem "  InterfaceclassGuid =" & GUIDString
      List1.AddItem " Flage =" & Hex$(MyDeviceInterfaceData.Flags)
  '******************************************************************************
  'SetupDiGetDeviceInterfaceDetail取得设备的路径,这个函数需要调用两次才能传递成功
  '返回值：SP_DEVICE_INTERFACE_DETAIL_DATA结构，包含设备的信息
  '调用两次：第一次返回正确的DeviceInterfaceDetailDataSize（Needed）
  '          第二次返回正确的结构体
  '******************************************************************************
       MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
       Result = SetupDiGetDeviceInterfaceDetail _
          (DeviceInfoSet, _
          MyDeviceInterfaceData, _
          0, _
          0, _
          Needed, _
          0)
         
       DetailData = Needed
             
       Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")
       List1.AddItem "  (OK to say too small)"
       List1.AddItem "  Required buffer size for the data: " & Needed
         
        'Store the structure's size.
         
        MyDeviceInterfaceDetailData.cbSize = _
            Len(MyDeviceInterfaceDetailData)
                 
      ReDim DetailDataBuffer(Needed)   '分配给字节数组足够的内存来存储结构
       
      '把cbSize存储在数组的前4个字节中
       
        Call RtlMoveMemory _
            (DetailDataBuffer(0), _
            MyDeviceInterfaceDetailData, _
            4)
         
        'Call SetupDiGetDeviceInterfaceDetail again.
        'This time, pass the address of the first element of DetailDataBuffer
        'and the returned required buffer size in DetailData.
         
        Result = SetupDiGetDeviceInterfaceDetail _
           (DeviceInfoSet, _
           MyDeviceInterfaceData, _
           VarPtr(DetailDataBuffer(0)), _
           DetailData, _
           Needed, _
           0)
         
        Call DisplayResultOfAPICall(" Result of second call: ")
        List1.AddItem "  MyDeviceInterfaceDetailData.cbSize: " & _
            CStr(MyDeviceInterfaceDetailData.cbSize)
         
        'Convert the byte array to a string.
         
        DevicePathName = CStr(DetailDataBuffer())
         
        'Convert to Unicode.
         
        DevicePathName = StrConv(DevicePathName, vbUnicode)
         
        'Strip cbSize (4 bytes) from the beginning.
        DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
        List1.AddItem "  Device pathname: "
        List1.AddItem "    " & DevicePathName
       
 '*******************************************************************
 'CreateFile取得设备的代号
 '应用此函数获得设备的代号，以后使用设备的代号来与设备交换数据
 '数据需求：SetupDiGetDeviceInterfaceDetail函数返回的设备路径
 '*******************************************************************
        HIDHandle = CreateFile _
            (DevicePathName, _
            GENERIC_READ Or GENERIC_WRITE, _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            Security, _
            OPEN_EXISTING, _
            0&, _
            0)
             
        Call DisplayResultOfAPICall("CreateFile")
        List1.AddItem "  Returned handle: " & Hex$(HIDHandle) & "h"
       
 '下面开始检测HID接口是否是我们需要的HID接口，通过判断厂商ID与产品ID来确定
 '************************************************************************
 'HidD_GetAttributes 获得厂商ID以及产品ID
 '数据需求：HIDD_ATTRIBUTES结构的Size成员的大小
 '          产品的HIDHandle(在CreatFile中的返回值)
 '************************************************************************
     DeviceAttributes.Size = LenB(DeviceAttributes)
     Result = HidD_GetAttributes _
            (HIDHandle, _
            DeviceAttributes)
             
     Call DisplayResultOfAPICall("HidD_GetAttributes")
     If Result <> 0 Then
       List1.AddItem "  HIDD_ATTRIBUTES 结构文件读取无误 "
     Else
       List1.AddItem "  HIDD_ATTRIBUTES 结构文件读取错误 "
     End If
      
        List1.AddItem "  Structure size: " & DeviceAttributes.Size
        List1.AddItem "  Vendor ID: " & Hex$(DeviceAttributes.VendorID)
        List1.AddItem "  Product ID: " & Hex$(DeviceAttributes.ProductID)
        List1.AddItem "  Version Number: " & Hex$(DeviceAttributes.VersionNumber)
         
    If (DeviceAttributes.VendorID = MyVendorID) And (DeviceAttributes.ProductID = MyProductID) Then
                 
         List1.AddItem "  My device detected"
         MyDeviceDetected = True
    Else
         MyDeviceDetected = False
         '如果不是我们要找的HID接口，关闭此接口的代号
                 
                Result = CloseHandle _
                    (HIDHandle)
              Call DisplayResultOfAPICall("CloseHandle")
    End If
     MemberIndex = MemberIndex   1 '查询下一个
 End If
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
 
 
 
'释放SetupDiGetClassDevs函数获得的所有连接设备结构数组
Result = SetupDiDestroyDeviceInfoList _
    (DeviceInfoSet)
     
Call DisplayResultOfAPICall("DestroyDeviceInfoList")
     
      
If MyDeviceDetected = True Then
   FindtheHid = True '函数返回值
    
'获得设备的信息
 
   Call GetDeviceCapabilities
 
'获得读的代号
 
   ReadHandle = CreateFile _
            (DevicePathName, _
            (GENERIC_READ Or GENERIC_WRITE), _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            Security, _
            OPEN_EXISTING, _
            FILE_FLAG_OVERLAPPED, _
            0)
 
   Call DisplayResultOfAPICall("CreateFile, ReadHandle")
   List1.AddItem "  Returned handle: " & Hex$(ReadHandle) & "h"
   Else
    List1.AddItem " Device not found."
    FindtheHid = False  '函数返回值
End If
     
End Function
'取得设备的信息
Private Sub GetDeviceCapabilities()
'***************************************************************
'HidD_GetPreparsedData
'   HidDeviceObject 是前面CREATFILE函数获得的设备代号
'   PreparsedData是函数返回值，使一个班汉数据的缓冲区的指针
'***************************************************************
Result = HidD_GetPreparsedData _
    (HIDHandle, _
    PreparsedData)
     
'***************************************************************
'HidP_GetCaps取得设备的能力
'是获得设备的报表描述符的一些基本内容，比如Usage、UsagePage、报表长度以及按钮能力、数值能力等的数目
'***************************************************************
Result = HidP_GetCaps _
    (PreparsedData, _
    Capabilities)
     
Call DisplayResultOfAPICall("HidP_GetCaps")
List1.AddItem "  Last error: " & ErrorString
List1.AddItem "  Usage: " & Hex$(Capabilities.Usage)
List1.AddItem "  Usage Page: " & Hex$(Capabilities.UsagePage)
List1.AddItem "  Input Report Byte Length: " & Capabilities.InputReportByteLength
List1.AddItem "  Output Report Byte Length: " & Capabilities.OutputReportByteLength
List1.AddItem "  Feature Report Byte Length: " & Capabilities.FeatureReportByteLength
List1.AddItem "  Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes
List1.AddItem "  Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps
List1.AddItem "  Number of Input Value Caps: " & Capabilities.NumberInputValueCaps
List1.AddItem "  Number of Input Data Indices: " & Capabilities.NumberInputDataIndices
List1.AddItem "  Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps
List1.AddItem "  Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps
List1.AddItem "  Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices
List1.AddItem "  Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps
List1.AddItem "  Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps
List1.AddItem "  Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices
 
'*****************************************************************
'HidP_GetValueCaps 取得设备的数值能力
'此函数传回一个报表中关于每个数值的信息的结构数组的指针
'NumberInputValueCaps属性是HidP_GetCaps函数返回结构中的Capabilities.NumberInputValueCaps属性
'*****************************************************************
Dim ValueCaps(1023) As Byte
 
Result = HidP_GetValueCaps _
    (HidP_Input, _
    ValueCaps(0), _
    Capabilities.NumberInputValueCaps, _
    PreparsedData)
     
Call DisplayResultOfAPICall("HidP_GetValueCaps")
 
'释放获得的设备能力的缓冲区指针
Result = HidD_FreePreparsedData _
    (PreparsedData)
     
Call DisplayResultOfAPICall("HidD_FreePreparsedData")
 
End Sub
'写数据到设备
Private Sub WriteReport()
 
 Dim count As Integer
 
 Dim NumberOfBytesToSend As Long
 Dim NumberOfBytesWritten As Long
 Dim ReadBuffer() As Byte
 Dim SendBuffer() As Byte
  
 ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)
  
 SendBuffer(0) = 0  '这是报表ID号
  
 For count = 1 To Capabilities.OutputReportByteLength - 1
   SendBuffer(count) = OutputReportData(count - 1)   '发送数据到发送缓冲区
 Next count
  
 NumberOfBytesWritten = 0
  
 Result = WriteFile _
    (HIDHandle, _
    SendBuffer(0), _
    CLng(Capabilities.OutputReportByteLength), _
    NumberOfBytesWritten, _
    0)
 
Call DisplayResultOfAPICall("WriteFile")
 
List1.AddItem " OutputReportByteLength = " & Capabilities.OutputReportByteLength
List1.AddItem " NumberOfBytesWritten = " & NumberOfBytesWritten
List1.AddItem " Report ID: " & SendBuffer(0)
List1.AddItem " Report Data:"
 
'UBound函数返回数组的长度（返回值是long型数据）
For count = 1 To UBound(SendBuffer)
    List1.AddItem " " & Hex$(SendBuffer(count))
Next count
  
End Sub
'读取报表函数
Private Sub ReadReport()
 
Dim count
Dim NumberOfBytesRead As Long
Dim ReadBuffer() As Byte
Dim UBoundReadBuffer As Integer
 
Dim ByteValue As String
 
ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
 
'把列表框滚动到最低部
List1.ListIndex = List1.ListCount - 1
 
 
'建立一个事件对象来指示ReadFile的完成
If EventObject = 0 Then
    EventObject = CreateEvent _
        (Security, _
        True, _
        True, _
        "")
End If
     
Call DisplayResultOfAPICall("CreateEvent")
     
HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
 
 
 
Result = ReadFile _
    (ReadHandle, _
    ReadBuffer(0), _
    CLng(Capabilities.InputReportByteLength), _
    NumberOfBytesRead, _
    HIDOverlapped)
 
Call DisplayResultOfAPICall("ReadFile")
 
'等待数据取回完毕
List1.AddItem "waiting for ReadFile"
List1.ListIndex = List1.ListCount - 1
 
'****************************************************************
'WaitForSingleObject
'函数返回值代表是在规定时间内传回数据还是时间溢出
'****************************************************************
Result = WaitForSingleObject _
    (EventObject, _
    6000)        '6000代表6000毫秒
 
Select Case Result
    Case WAIT_OBJECT_0    '如果数据完成的话
      List1.AddItem "ReadFile completed successfully."
    Case WAIT_TIMEOUT     '如果超时接收数据
           
    '释放设备代号句柄
      Result = CancelIo _
            (ReadHandle)
    Call DisplayResultOfAPICall("CancelIo")
    '产生的原因可能是由于设备移除，所以应该释放设备代号
    CloseHandle (HIDHandle)
    Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")
    CloseHandle (ReadHandle)
    Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")
    MyDeviceDetected = False
     
    Case Else     '其他情况下
        List1.AddItem "Readfile undefined error"
        MyDeviceDetected = False
         
End Select
 
List1.AddItem " Report ID: " & ReadBuffer(0)
List1.AddItem " Report Data:"
 
Text3.Text = ""
Text4.Text = ""
 
For count = 1 To UBound(ReadBuffer)
     
    'Add a leading 0 to values 0 - Fh.
     
    If Len(Hex$(ReadBuffer(count))) < 2 Then
        ByteValue = "0" & Hex$(ReadBuffer(count))
    Else
        ByteValue = Hex$(ReadBuffer(count))
    End If
     
    List1.AddItem " " & ByteValue
     
    'Display the received bytes in the text box.
 
 
Next count
 
   If (ReadBuffer(1)) < 16 Then
    Text3.Text = "0" & Hex$(ReadBuffer(1))
    Else
    Text3.Text = Hex$(ReadBuffer(1))
   End If
    
    If (ReadBuffer(2)) < 16 Then
    Text4.Text = "0" & Hex$(ReadBuffer(2))
    Else
    Text4.Text = Hex$(ReadBuffer(2))
   End If
 
Call ResetEvent(EventObject)
Call DisplayResultOfAPICall("ResetEvent")
 
End Sub
'添加头
Private Sub DisplayResultOfAPICall(FunctionName As String)
List1.AddItem ""
List1.AddItem FunctionName & ":"
List1.ListIndex = List1.ListCount - 1
End Sub
'获得字符串表述符
Private Function GetDataString _
    (Address As Long, _
    Bytes As Long) _
As String
 
 
Dim Offset As Integer
Dim Result$
Dim ThisByte As Byte
 
For Offset = 0 To Bytes - 1
    Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address   Offset, 1)
    If (ThisByte And &HF0) = 0 Then
        Result$ = Result$ & "0"
    End If
    Result$ = Result$ & Hex$(ThisByte)
Next Offset
 
GetDataString = Result$
End Function
标签： usb USB_com
实例下载地址

vb USB通讯示例源码

点此下载实例
不能下载？内容有错？点击这里报错 + 投诉 + 提问
好例子网口号：伸出你的我的手 — 分享！
网友评论

我要评论
小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见版权及免责申明
vb USB通讯示例源码

同类人气实例

实例介绍

实例下载地址

vb USB通讯示例源码

相关软件

相关文章

网友评论

小贴士

关于好例子网

下载周排行

下载总排行
