📄 frmmain.frm
字号:
Height = 495
Left = 3840
TabIndex = 2
Text = "045E"
Top = 360
Width = 855
End
Begin VB.CommandButton cmdFindHID
BackColor = &H00FF0000&
Caption = "查找HID"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 600
MaskColor = &H00FF0000&
TabIndex = 0
Top = 360
Width = 1575
End
Begin VB.Timer tmrDelay
Left = 1680
Top = 360
End
Begin VB.Timer tmrContinuousDataCollect
Left = 720
Top = 360
End
Begin VB.ListBox lstResults
Height = 6000
ItemData = "frmMain.frx":0000
Left = 480
List = "frmMain.frx":0002
OLEDropMode = 1 'Manual
TabIndex = 1
Top = 3600
Width = 9375
End
Begin VB.Label lblCaps
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 375
Left = 5280
TabIndex = 23
Top = 960
Width = 1935
End
Begin VB.Label lblHID
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 375
Left = 600
TabIndex = 22
Top = 960
Width = 1575
End
Begin VB.Label Label4
Caption = "年 月 日 时 分 秒"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4560
TabIndex = 17
Top = 2160
Width = 4935
End
Begin VB.Label Label3
Caption = "R1 R2 R3 R4 R5 R6 R7 R8"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 255
Left = 1320
TabIndex = 6
Top = 1680
Width = 8175
End
Begin VB.Label Label2
Caption = "ProductID"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 5
Top = 960
Width = 1455
End
Begin VB.Label Label1
Caption = "VendorID"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 4
Top = 360
Width = 1455
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'HID查找、能力检测、输入报表、输出报表演示程序
'修改自许永和的《介面设计与实习 使用Bisual Basic》
Option Explicit
'变量定义 ******************************************************************************
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 HidDevice As Long
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 Result As Long
Dim Timeout As Boolean
Dim MyVendorID As Long 'VID、PID
Dim MyProductID As Long
'**************************************************************************************
'查找全部的HID设备，直到找到VID、PID符合的一个HID
'如果找到，MyDeviceDetected为True
'**************************************************************************************
Function FindTheHid() As Boolean
Dim Count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim MemberIndex As Long
LastDevice = False
MyDeviceDetected = False
'调用 HidD_GetHidGuid 函数获得GUID
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
lstResults.AddItem " GUID for system HIDs: "
lstResults.AddItem " " & GUIDString
'调用 SetupDiGetClassDevs 函数获得指向HID信息集的指针
DeviceInfoSet = SetupDiGetClassDevs(HidGuid, vbNullString, 0, (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
Call DisplayResultOfAPICall("SetupDiClassDevs")
DataString = GetDataString(DeviceInfoSet, 32)
lstResults.AddItem " DeviceInfoSet:" & DeviceInfoSet
'下面循环，从MemberIndex=0开始，查找指定HID
MemberIndex = 0
Do
'调用 SetupDiEnumDeviceInterfaces 函数获得 SP_DEVICE_INTERFACE_DATA 结构指针
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces(DeviceInfoSet, 0, HidGuid, MemberIndex, MyDeviceInterfaceData)
Call DisplayResultOfAPICall("SetupDiEnumDeviceInterfaces")
If Result = 0 Then LastDevice = True
'如果调用成功
If Result <> 0 Then
'显示获得的信息
lstResults.AddItem " DeviceInfoSet for device #" & CStr(MemberIndex) & ": "
lstResults.AddItem " cbSize = " & CStr(MyDeviceInterfaceData.cbSize)
lstResults.AddItem " InterfaceClassGuid.Data1 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data1)
lstResults.AddItem " InterfaceClassGuid.Data2 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data2)
lstResults.AddItem " InterfaceClassGuid.Data3 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data3)
lstResults.AddItem " Flags = " & Hex$(MyDeviceInterfaceData.Flags)
'调用 SetupDiGetDeviceInterfaceDetail函数，获得SP_DEVICE_INTERFACE_DETAIL_DATA结构
'注意：该函数需要调用两次，最后获得设备路径
MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
Result = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, 0, 0, Needed, 0)
DetailData = Needed
Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")
lstResults.AddItem " (OK to say too small)"
lstResults.AddItem " Required buffer size for the data: " & Needed
'存储结构的长度
MyDeviceInterfaceDetailData.cbSize = Len(MyDeviceInterfaceDetailData)
ReDim DetailDataBuffer(Needed)
'存储结构的前4和字节，cbSize
Call RtlMoveMemory(DetailDataBuffer(0), MyDeviceInterfaceDetailData, 4)
'再一次调用
Result = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, VarPtr(DetailDataBuffer(0)), DetailData, Needed, 0)
Call DisplayResultOfAPICall(" Result of second call: ")
lstResults.AddItem " MyDeviceInterfaceDetailData.cbSize: " & CStr(MyDeviceInterfaceDetailData.cbSize)
DevicePathName = CStr(DetailDataBuffer())
DevicePathName = StrConv(DevicePathName, vbUnicode) '转换成Unicode
DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4) '删除4个字节
lstResults.AddItem " Device pathname: "
lstResults.AddItem " " & DevicePathName
'调用 CreateFile 函数，获得设备句柄：HidDevice
HidDevice = CreateFile(DevicePathName, GENERIC_READ Or GENERIC_WRITE, (FILE_SHARE_READ Or FILE_SHARE_WRITE), 0, OPEN_EXISTING, 0, 0)
Call DisplayResultOfAPICall("CreateFile")
lstResults.AddItem " Returned handle: " & Hex$(HidDevice) & "h"
'调用 HidD_GetAttributes 获得HID的VID、PID
DeviceAttributes.Size = LenB(DeviceAttributes)
Result = HidD_GetAttributes(HidDevice, DeviceAttributes)
Call DisplayResultOfAPICall("HidD_GetAttributes")
If Result <> 0 Then
lstResults.AddItem " HIDD_ATTRIBUTES structure filled without error."
Else
lstResults.AddItem " Error in filling HIDD_ATTRIBUTES structure."
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -