📄 form1.frm
字号:
BorderStyle = 1 'Fixed Single
Caption = "USB THERMOSTAT VER 2.01"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 660
Left = 5010
TabIndex = 25
Top = 2850
Width = 1350
End
Begin VB.Label Label3
Caption = "系 统 设 置"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 225
Left = 3210
TabIndex = 3
Top = 75
Width = 2130
End
Begin VB.Line Line3
BorderColor = &H00FF0000&
BorderWidth = 3
X1 = 2010
X2 = 2010
Y1 = 3960
Y2 = 180
End
Begin VB.Label Label1
BackColor = &H8000000A&
Caption = "数字式温度调节器"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 255
Left = 90
TabIndex = 0
Top = 90
Width = 1695
End
Begin VB.Shape Shape6
BackStyle = 1 'Opaque
BorderColor = &H00E0E0E0&
FillColor = &H00E0E0E0&
FillStyle = 0 'Solid
Height = 1425
Left = 810
Top = 510
Width = 375
End
Begin VB.Shape Shape4
BackStyle = 1 'Opaque
BorderColor = &H000000FF&
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 2745
Left = 810
Top = 510
Width = 375
End
Begin VB.Shape Shape1
BackColor = &H80000004&
BorderColor = &H00E0E0E0&
FillColor = &H00E0E0E0&
FillStyle = 0 'Solid
Height = 2805
Left = 780
Top = 450
Width = 435
End
Begin VB.Shape Shape3
BorderColor = &H000000FF&
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 1035
Left = 720
Shape = 3 'Circle
Top = 2925
Width = 555
End
Begin VB.Shape Shape2
BorderColor = &H00E0E0E0&
FillColor = &H00E0E0E0&
FillStyle = 0 'Solid
Height = 915
Left = 690
Shape = 3 'Circle
Top = 2985
Width = 615
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Form1.Width = 6540
Command1.Visible = False
Command2.Visible = True
End Sub
Private Sub Command10_Click()
Dim myRequest As VENDOR_REQUEST_IN
Dim bResult As Boolean
Dim ReData(8) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String
Dim IoAddress As String
IoAddress = InputBox(" 请输入CY7C63001的IO端口号: " + _
Chr(13) & Chr(10) + _
" (取值范围为0-1)", "CY7C63001设置", "1")
If (IoAddress = "") Then
Exit Sub
Else
If (Not IsNumeric(IoAddress) Or Val(IoAddress) < 0 Or Val(IoAddress) > 1) Then
MsgBox "CY7C63001只有两个IO端口:0和1", 16, "I/O错误"
Exit Sub
End If
End If
DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
myRequest.bRequest = &H4
myRequest.wValue = Val(IoAddress)
myRequest.wIndex = &H0
myRequest.wLength = &H8
myRequest.bData = &H0
myRequest.direction = &H1
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_VENDOR_REQUEST, _
myRequest, _
10, _
ReData(0), _
8, _
nBytes, _
OverLap)
If (bResult = True) Then
MsgBox "IO端口" + IoAddress + "的值为:0x" + Hex(ReData(1)), , "CY7C63001"
CloseHandle (HidDevice)
Else
MsgBox " 与USB设备通信失败！" + _
Chr(13) & Chr(10) + _
"USB数据传输错误，请重新启动硬件！", _
16, "I/O错误"
CloseHandle (HidDevice)
Unload Form1
End
End If
End If
End Sub
Private Sub Command11_Click()
Dim bResult As Boolean
Dim ReData(18) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String
DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_GET_CONFIGURATION_DESCRIPTOR, _
0, _
0, _
ReData(0), _
18, _
nBytes, _
OverLap)
If (bResult = True) Then
MsgBox " 接口描述符" + _
Chr(13) & Chr(10) + _
Chr(13) & Chr(10) + _
"bLength: 0x" + Hex(ReData(9)) + _
Chr(13) & Chr(10) + _
"bDecriptorType: 0x" + Hex(ReData(10)) + _
Chr(13) & Chr(10) + _
"bInterfaceNumber: 0x" + Hex(ReData(11)) + _
Chr(13) & Chr(10) + _
"bAlternateSetting: 0x" + Hex(ReData(12)) + _
Chr(13) & Chr(10) + _
"bNumEndpoints: 0x" + Hex(ReData(13)) + _
Chr(13) & Chr(10) + _
"bInterfaceClass: 0x" + Hex(ReData(14)) + _
Chr(13) & Chr(10) + _
"bInterfaceSubClass: 0x" + Hex(ReData(15)) + _
Chr(13) & Chr(10) + _
"bInterfaceProtocol: 0x" + Hex(ReData(16)) + _
Chr(13) & Chr(10) + _
"iInterface: 0x" + Hex(ReData(17)), , "USB"
CloseHandle (HidDevice)
Else
MsgBox " 与USB设备通信失败！" + _
Chr(13) & Chr(10) + _
"USB数据传输错误，请重新启动硬件！", _
16, "Interface错误"
CloseHandle (HidDevice)
Unload Form1
End
End If
End If
End Sub
Private Sub Command12_Click()
Dim bResult As Boolean
Dim ReData(32) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String
Dim DataInput As GET_STRING_DESCRIPTOR_IN
DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
DataInput.Index = 1
DataInput.LanguageId = 0
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_GET_STRING_DESCRIPTOR, _
DataInput, _
3, _
ReData(0), _
8, _
nBytes, _
OverLap)
If (bResult = False) Then
MsgBox " 与USB设备通信失败！" + _
Chr(13) & Chr(10) + _
"USB数据传输错误，请重新启动硬件！", _
16, "String1错误"
CloseHandle (HidDevice)
Unload Form1
End
End If
DataInput.Index = 2
DataInput.LanguageId = 0
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_GET_STRING_DESCRIPTOR, _
DataInput, _
3, _
ReData(8), _
24, _
nBytes, _
OverLap)
If (bResult = False) Then
MsgBox " 与USB设备通信失败！" + _
Chr(13) & Chr(10) + _
"USB数据传输错误，请重新启动硬件！", _
16, "String2错误"
CloseHandle (HidDevice)
Unload Form1
End
End If
MsgBox "字符串描述符 1" + _
Chr(13) & Chr(10) + _
"bLength: 0x" + Hex(ReData(0)) + _
Chr(13) & Chr(10) + _
"bDecriptorType: 0x" + Hex(ReData(1)) + _
Chr(13) & Chr(10) + _
"bString: " + Chr(ReData(2)) + Chr(ReData(4)) + Chr(ReData(6)) + _
Chr(13) & Chr(10) + Chr(13) & Chr(10) + _
"字符串描述符 2" + _
Chr(13) & Chr(10) + _
"bLength: 0x" + Hex(ReData(8)) + _
Chr(13) & Chr(10) + _
"bDecriptorType: 0x" + Hex(ReData(9)) + _
Chr(13) & Chr(10) + _
"bString: " + Chr(ReData(10)) + Chr(ReData(12)) + Chr(ReData(14)) + _
Chr(ReData(16)) + Chr(ReData(18)) + Chr(ReData(20)) + Chr(ReData(22)) + _
Chr(ReData(24)) + Chr(ReData(26)) + Chr(ReData(28)) + Chr(ReData(30)) _
, , "USB"
CloseHandle (HidDevice)
End If
End Sub
Private Sub Command13_Click()
Dim bResult As Boolean
Dim ReData(9) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String
DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_GET_CONFIGURATION_DESCRIPTOR, _
0, _
0, _
ReData(0), _
9, _
nBytes, _
OverLap)
If (bResult = True) Then
MsgBox " 配置描述符" + _
Chr(13) & Chr(10) + _
Chr(13) & Chr(10) + _
"bLength: 0x" + Hex(ReData(0)) + _
Chr(13) & Chr(10) + _
"bDecriptorType: 0x" + Hex(ReData(1)) + _
Chr(13) & Chr(10) + _
"wTotalLength: 0x" + Hex(ReData(3) * 256 + ReData(2)) + _
Chr(13) & Chr(10) + _
"bnumInterfaces: 0x" + Hex(ReData(4)) + _
Chr(13) & Chr(10) + _
"bConfigurationValue: 0x" + Hex(ReData(5)) + _
Chr(13) & Chr(10) + _
"iConfiguration: 0x" + Hex(ReData(6)) + _
Chr(13) & Chr(10) + _
"bmAttributes: 0x" + Hex(ReData(7)) + _
Chr(13) & Chr(10) + _
"MaxPower: 0x" + Hex(ReData(8)), , "USB"
CloseHandle (HidDevice)
Else
MsgBox " 与USB设备通信失败！" + _
Chr(13) & Chr(10) + _
"USB数据传输错误，请重新启动硬件！", _
16, "Config错误"
CloseHandle (HidDevice)
Unload Form1
End
End If
End If
End Sub
Private Sub Command14_Click()
Dim bResult As Boolean
Dim ReData(18) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String
DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
bResult = DeviceIoControl _
(HidDevice, _
IOCTL_Cyusb_GET_DEVICE_DESCRIPTOR, _
0, _
0, _
ReData(0), _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -