📄 我现在的代码.txt
字号:
Option Explicit
'圈圈的驱动可能不是HID驱动,而是USB驱动
'圈圈的学习板应该不是HID设备吧
'因为我调用该函数HidD_GetPreparsedData()
'来获取HID设备特征信息就会内存报错
'是因为圈圈的学习板不是HID设备 而是一个USB设备
'Const MyVendorID = &H8888
'Const MyProductID = &H88
'**************************首先定义好圈圈的GUID************************
'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
'对D12的读写的端口
Const FILE_DEVICE = &H8000 '圈圈的文件设备
Const Read_Endp1 = &H800
Const Write_Endp1 = &H801
Const Read_Endp2 = &H802
Const Write_Endp2 = &H803
'返回HID群组的GUID---------HidD_GetHidGuid函数
Function FindTheHid() As Boolean
Dim count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim MemberIndex As Long
LastDevice = False
MyDeviceDetected = False
''''''''''''由于圈圈的板不是HID类型 所以不用Result = HidD_GetHidGuid(HidGuid)
'Result = HidD_GetHidGuid(HidGuid)
'Call DisplayResultOfAPICall("GetHidGuid_(返回HID群组的GUID)")
'注意类型的长度
'integer(0~ffff) byte(0~ff) long(0~ffffffff)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步->返回HID群组的GUID
HidGuid.Data1 = &HA2CBE209
HidGuid.Data2 = &H7A8B
HidGuid.Data3 = &H44B4
HidGuid.Data4(0) = &H94
HidGuid.Data4(1) = &HE7
HidGuid.Data4(2) = &HCD
HidGuid.Data4(3) = &H45
HidGuid.Data4(4) = &H4A
HidGuid.Data4(5) = &H42
HidGuid.Data4(6) = &H7F
HidGuid.Data4(7) = &H11
'***********************************
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: " & GUIDString
'************************************
'第二步->返回所有HID信息-------SetupDiGetClassDevs函数
'需求第一步API函数返回的HidD_GetHidGuid返回的HidGuid
'通过该函数我们可以取得系统提供的一个设备的句柄,
'从而将其作为刚连接上的HID设备的一个重要指针
DeviceInfoSet = SetupDiGetClassDevs _
(HidGuid, _
vbNullString, _
0, _
(DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
Call DisplayResultOfAPICall("SetupDiClassDevs_(返回所有HID信息)")
DataString = GetDataString(DeviceInfoSet, 32)
lstResults.AddItem "DeviceInfoSet: " & DeviceInfoSet
'************************************
'第三步->识别每一个HID接口--------SetupDiEnumDeviceInterfaces函数
'需要第二步返回的DeviceInfoSet
'需要第一步返回的HidGuid
'设置该设备的索引值
MemberIndex = 0 '设备索引
'以0开始递增,直到没有设备被检测到为止
Do
'必须设置MyDeviceInterfaceData结构中的cbsize元素
'这个结构以字节为计数数值,大小为28字节
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces _
(DeviceInfoSet, _
0, _
HidGuid, _
MemberIndex, _
MyDeviceInterfaceData)
Call DisplayResultOfAPICall("SetupDiEnumDeviceInterfaces_(识别每一个HID接口)")
'lstResults.AddItem "该函数作用为识别每一个HID接口"
If Result = 0 Then
LastDevice = True
End If
'如果设备还存在,显示返回信息
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)
'*************************************
'第4步->返回设备的路径-------SetupDiGetDeviceInterfaceDetail 函数
'为了返回相关信息,调用此函数两次
'第一次返回所需结构的大小
'第二次返回DeviceInfoSet的数据指针
'需要第三步SetupDiEnumDeviceInterfaces返回的SP_DEVICE_INTERFACE_DATA结构
'和第二步SetupDiGetClassDevs函数返回的DeviceInfoSet的设备句柄
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)
'使用字节数组声明MyDeviceInterfaceDetailData结构的内存
ReDim DetailDataBuffer(Needed)
'储存在数组的前4个字节
Call RtlMoveMemory _
(DetailDataBuffer(0), _
MyDeviceInterfaceDetailData, _
4)
'再一次调用SetupDiGetDeviceInterfaceDetail函数
'这一次传递的DetailDataBuffer中第一个元素的地址
'这里返回的是DetailData所需的缓冲区的大小
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())
'转换成unicode
DevicePathName = StrConv(DevicePathName, vbUnicode)
'从开始处清除cbsize(4个字节)
DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
lstResults.AddItem " Device pathname: "
lstResults.AddItem " " & DevicePathName
'******************************************************
'第五步->返回设备的句柄------------CreateFile函数
'它的返回值 返回用来启用读取和写入此设备的句柄
'需求SetupDiGetDeviceInterfaceDetail 函数返回的DevicePathName
' GENERIC_READ = &H80000000 ' GENERIC_WRITE = &H40000000
' FILE_SHARE_READ = &H1 ''FILE_SHARE_WRITE = &H2
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"
If Hex$(HidDevice) <> "FFFF" And Hex$(HidDevice) <> "FFFFFFFF" Then '检测设备是否打开成功
MyDeviceDetected = True
lstResults.AddItem "打开设备成功"
Else
MyDeviceDetected = False
lstResults.AddItem "打开设备失败"
MsgBox "打开设备失败,请重启单片机设备"
End If
'******************************************************************************
'第六步->返回厂商和产品ID--------HidD_GetAttributes
'需要从设备信息以及CreateFile函数返回的设备句柄
'返回包含厂商VID和产品PID以及产品版本号的HIDD_ATTRIBUTES
'通过执行HidD_GetAttributes函数,我们可以利用返回的相关信息确定这个设备
'是否我们正在寻找的设备
'设置"Size"属性为结构中的字节数值
'*************************************
'DeviceAttributes.Size = LenB(DeviceAttributes)
'Result = HidD_GetAttributes _
'(HidDevice, _
'DeviceAttributes)
'Call DisplayResultOfAPICall("HidD_GetAttributes_(返回厂商和产品ID)")
'If Result <> 0 Then
' lstResults.AddItem " HIDD_ATTRIBUTES structure filled without error."
'Else
' lstResults.AddItem " Error in filling HIDD_ATTRIBUTES structure."
'End If
'stResults.AddItem " Structure size: " & DeviceAttributes.Size
' lstResults.AddItem " Vendor ID: " & Hex$(DeviceAttributes.VendorID)
'lstResults.AddItem " Product ID: " & Hex$(DeviceAttributes.ProductID)
'lstResults.AddItem " Version Number: " & Hex$(DeviceAttributes.VersionNumber)
'找出这个设备是否与正在寻找的设备相符合
' If (DeviceAttributes.VendorID = MyVendorID) And _
' (DeviceAttributes.ProductID = MyProductID) Then
' lstResults.AddItem " My device detected"
' MyDeviceDetected = True
' Else
' MyDeviceDetected = False
'如果不是我们想要的设备,则关闭标识句柄
'若在这里使用Result = CloseHandle(HidDevice)
'会在关闭设备中的关闭句柄无效
'Result = CloseHandle(HidDevice)
' DisplayResultOfAPICall ("CloseHandle")
' End If
End If
'继续寻找,直到发现此设备,或已经没有剩下的设备要检查
MemberIndex = MemberIndex + 1
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
If MyDeviceDetected = True Then
FindTheHid = True
Else
FindTheHid = False
lstResults.AddItem "没有发现任何设备"
End If
End Function
'清空所有数据
Private Sub Clear_All_Click()
Rec_Dat.Text = ""
Send_Dat.Text = ""
lstResults.Clear
End Sub
Private Sub CloseAllLight_Click()
Dim SendDat(0) As Byte
SendDat(0) = &HAA
Call WriteDevice(SendDat(0), 1)
End Sub
Private Sub Led_On_4_Click(Index As Integer)
Dim SendDat(0) As Byte
SendDat(0) = &H8
Call WriteDevice(SendDat(0), 1)
End Sub
Private Sub Led_On_5_Click(Index As Integer)
Index = 4
Dim SendDat(0) As Byte
SendDat(0) = &H10
Call WriteDevice(SendDat(0), 1)
End Sub
'打开设备
Private Sub Open_Dev_Click()
Dim DeviceDetected As Boolean
DeviceDetected = FindTheHid
If DeviceDetected = True Then '假若打开设备成功
Timer1.Enabled = True
Timer1.Interval = 50
Open_Dev.Enabled = False
Close_Dev.Enabled = True
End If
End Sub
'读端口1
Private Sub Read_Ep1_Click()
End Sub
'读端口2
Private Sub Read_Ep2_Click()
Call ReadDevice(1)
End Sub
Private Sub Timer1_Timer()
Call ReadDevice(1)
End Sub
Private Sub WaterLight_Click()
Dim SendDat(0) As Byte
SendDat(0) = &HFF
Call WriteDevice(SendDat(0), 1)
End Sub
'写端口1
Private Sub Write_Ep1_Click()
End Sub
'写端口2_>__<暂时搞一个字节发送算啦
Private Sub Write_Ep2_Click()
Dim SendDat(0) As Byte
Dim count As Integer
If Val(Send_Dat.Text) <= 255 Then
SendDat(0) = Val(Send_Dat.Text)
'SendDat(0) = &H80
'SendDat(1) = &H2
'SendDat(2) = &H4
'SendDat(3) = &H8
'SendDat(4) = &H10
'SendDat(5) = &H20
'SSendDat(6) = &H40
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -