📄 vb_ppi.frm
字号:
Else
a$ = a$ + Hex(aa(i))
End If
'a$ = a$ '+ "、"
Next i
a$ = a$ + ","
Text2.Text = a$
'10 2 0 5C 5E 16
str_val(0) = &H10
str_val(1) = &H2
str_val(2) = &H0
str_val(3) = &H5C
str_val(4) = &H5E
str_val(5) = &H16
For i = 0 To 5
If Len(Hex(str_val(i))) = 1 Then
a$ = a$ + "0" + Hex(str_val(i))
Else
a$ = a$ + Hex(str_val(i))
End If
' a$ = a$ + "、"
Next i
Text2.Text = a$
a$ = ""
For i = 0 To 5
a$ = a$ + Chr(str_val(i))
Next
MSComm1.RThreshold = 1
MSComm1.Output = str_val
End Sub
Private Sub Command11_Click() 'wVB100=99
'68 20 20 68 02 00 7C 32 01 00 00 00 00 00 0E 00 05 05 01 12 0A 10 02 00 01 00 01 84 00 03 20 00 04 00 08 99 46 16
Dim o$
o$ = "68 20 20 68 02 00 7C 32 01 00 00 00 00 00 0E 00 05 05 01 12 0A 10 02 00 01 00 01 84 00 03 20 00 04 00 08 99 46 16"
sendOrder (o$)
Exit Sub
Dim str_write(0 To 37) As Byte
Dim str_val(0 To 5) As Byte
Dim i As Integer
Dim Temp_FCS As Variant
str_write(0) = &H68
str_write(1) = &H20
str_write(2) = &H20
str_write(3) = &H68
str_write(4) = &H2
str_write(5) = &H0
'0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
'68 20 20 68 2 0 7C 32 1 0 0 0 0 0 E 0 5 5 1 12 A 10 2 0 1 0 1 84 0 3 20 0 4 0 8 C B9 16
str_write(6) = &H7C
str_write(7) = &H32
str_write(8) = &H1
str_write(9) = &H0
str_write(10) = &H0
str_write(11) = &H0
str_write(12) = &H0
str_write(13) = &H0
str_write(14) = &HE
str_write(15) = &H0
str_write(16) = &H5
str_write(17) = &H5
str_write(18) = &H1
str_write(19) = &H12
str_write(20) = &HA
str_write(21) = &H10
str_write(22) = &H2
str_write(23) = &H0
str_write(24) = &H1
str_write(25) = &H0
str_write(26) = &H1
str_write(27) = &H84
str_write(28) = &H0
str_write(29) = &H3
str_write(30) = &H20
str_write(31) = &H0
str_write(32) = &H4
str_write(33) = &H0
str_write(34) = &H8
str_write(35) = &H99
'str_write(36) = &HB9
For i = 4 To 35
Temp_FCS = Temp_FCS + str_write(i)
Next
str_write(36) = Temp_FCS Mod 256
str_write(37) = &H16
Dim a$
For i = 0 To 37
If Len(Hex(str_write(i))) = 1 Then
a$ = a$ + "0" + Hex(str_write(i))
Else
a$ = a$ + Hex(str_write(i))
End If
a$ = a$ + " "
Next i
Text1.Text = a$
Text3.Text = ""
MSComm1.Output = str_write
Text3.Text = ""
Dim xxx%
Do
xxx% = DoEvents()
Loop Until MSComm1.InBufferCount > 0
Dim ia As Variant
Dim aa() As Byte
ia = MSComm1.Input
aa = ia
Dim L As Integer
L = UBound(aa)
a$ = ""
For i = 0 To L
If Len(Hex(aa(i))) = 1 Then
a$ = a$ + "0" + Hex(aa(i))
Else
a$ = a$ + Hex(aa(i))
End If
'a$ = a$ '+ "、"
Next i
a$ = a$ + ","
Text2.Text = a$
'10 2 0 5C 5E 16
str_val(0) = &H10
str_val(1) = &H2
str_val(2) = &H0
str_val(3) = &H5C
str_val(4) = &H5E
str_val(5) = &H16
For i = 0 To 5
If Len(Hex(str_val(i))) = 1 Then
a$ = a$ + "0" + Hex(str_val(i))
Else
a$ = a$ + Hex(str_val(i))
End If
' a$ = a$ + "、"
Next i
Text2.Text = a$
a$ = ""
For i = 0 To 5
a$ = a$ + Chr(str_val(i))
Next
MSComm1.RThreshold = 1
MSComm1.Output = str_val
End Sub
Private Sub Command12_Click()
Dim o$
o$ = " 68 1B 1B 68 2 0 6C 32 1 0 0 0 0 0 E 0 0 4 1 12 A 10 2 0 1 0 1 84 0 3 20 8B 16 "
o$ = Text4.Text
sendOrder (o$)
End Sub
Private Sub Command2_Click()
'0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
'68 21 21 68 02 00 6C 32 01 00 00 00 00 00 14 00 00 28 00 00 00 00 00 00 FD 00 00 09 50 5F 50 52 4F 47 52 41 4D AA 16
'68 1D 1D 68 02 00 6C 32 01 00 00 00 00 00 10 00 00 29 00 00 00 00 00 09 50 5F 50 52 4F 47 52 41 4D AA 16
Dim o$
o$ = "68 1D 1D 68 02 00 6C 32 01 00 00 00 00 00 10 00 00 29 00 00 00 00 00 09 50 5F 50 52 4F 47 52 41 4D AA 16"
'o$ = Text4.Text
sendOrder (o$)
Exit Sub
Dim str_write(0 To 34) As Byte
Dim str_val(0 To 5) As Byte
Dim haha As Byte
'Dim i As Integer
Dim Temp_FCS As Variant
haha = q0 Xor &H80
'68 1D 1D 68 02 00 6C 32 01 00 00 00 00 00 10 00 00 29 00 00 00 00 00 09 50 5F 50 52 4F 47 52 41 4D 9A 16
str_write(0) = &H68
str_write(1) = &H1D
str_write(2) = &H1D
str_write(3) = &H68
str_write(4) = &H2
str_write(5) = &H0
str_write(6) = &H6C
str_write(7) = &H32
str_write(8) = &H1
str_write(9) = &H0
str_write(10) = &H0
str_write(11) = &H0
str_write(12) = &H0
str_write(13) = &H0
str_write(14) = &H10
str_write(15) = &H0
str_write(16) = &H0
str_write(17) = &H29
str_write(18) = &H0
str_write(19) = &H0
str_write(20) = &H0
str_write(21) = &H0
str_write(22) = &H0
str_write(23) = &H9
str_write(24) = &H50
str_write(25) = &H5F
str_write(26) = &H50
str_write(27) = &H52
str_write(28) = &H4F
str_write(29) = &H47
str_write(30) = &H52
str_write(31) = &H41
str_write(32) = &H4D
str_write(33) = &H9A
str_write(34) = &H16
For i = 4 To 32
Temp_FCS = Temp_FCS + str_write(i)
Next
str_write(33) = Temp_FCS Mod 256
str_write(34) = &H16
Dim a$
For i = 0 To 34
If Len(Hex(str_write(i))) = 1 Then
a$ = a$ + "0" + Hex(str_write(i))
Else
a$ = a$ + Hex(str_write(i))
End If
a$ = a$ + " "
Next i
Text1.Text = a$
a$ = ""
For i = 0 To 34
a$ = a$ + Chr(str_write(i))
Next
MSComm1.Output = str_write
Text3.Text = ""
Dim xxx%
Do
xxx% = DoEvents()
Loop Until MSComm1.InBufferCount > 0
Dim ia As Variant
Dim aa() As Byte
ia = MSComm1.Input
aa = ia
Dim L As Integer
L = UBound(aa)
a$ = ""
For i = 0 To L
If Len(Hex(aa(i))) = 1 Then
a$ = a$ + "0" + Hex(aa(i))
Else
a$ = a$ + Hex(aa(i))
End If
'a$ = a$ '+ "、"
Next i
a$ = a$ + ","
Text2.Text = a$
'10 2 0 5C 5E 16
str_val(0) = &H10
str_val(1) = &H2
str_val(2) = &H0
str_val(3) = &H5C
str_val(4) = &H5E
str_val(5) = &H16
For i = 0 To 5
If Len(Hex(str_val(i))) = 1 Then
a$ = a$ + "0" + Hex(str_val(i))
Else
a$ = a$ + Hex(str_val(i))
End If
' a$ = a$ + "、"
Next i
Text2.Text = a$
a$ = ""
For i = 0 To 5
a$ = a$ + Chr(str_val(i))
Next
MSComm1.RThreshold = 1
MSComm1.Output = a$ 'str_val
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub sendOrder(o$)
Dim Temp(0 To 220) As Byte '建立临时字节数组
Dim rOrder(0 To 5) As Byte '建立确认字节数组
Dim FCS, i, L, i1, i2 As Integer
o$ = Trim(o$)
L = Len(o$)
Do '清除非法字符
If Asc(Mid(o$, L, 1)) < 48 Then L = L - 1
Loop Until Asc(Mid(o$, L, 1)) > 47
o$ = Mid(o$, 1, L)
i1 = 1
Do '把字符转换为字节数组
i2 = InStr(i1, o$, " ")
If i2 > i1 Then Temp(i) = Val("&H" + Mid(o$, i1, i2 - i1)): i = i + 1
If i1 = i1 Then i1 = i2 + 1
Loop Until i2 = 0
Temp(1) = i - 5
Temp(2) = i - 5
For i1 = 4 To i - 2 '校验和计算
FCS = FCS + Temp(i1)
Next
Temp(i - 1) = FCS Mod 256
Temp(i) = &H16
ReDim sOrder(i) As Byte '建立发送字节数组
For i1 = 0 To i
sOrder(i1) = Temp(i1)
Next i1
Dim a$
For i1 = 0 To i '把字节数组还原为字符，以便检查
If Len(Hex(sOrder(i1))) = 1 Then
a$ = a$ + "0" + Hex(sOrder(i1))
Else
a$ = a$ + Hex(sOrder(i1))
End If
a$ = a$ + " "
Next i1
Text1.Text = a$
MSComm1.RThreshold = 0 '禁止接收中断
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '打开串口
MSComm1.Output = sOrder '发送通讯命令
Text3.Text = "" '接收数据显示清零
Text2.Text = "" '命令响应码，命令确认码显示清零
Dim xxx%
Do '等待命令响应码
xxx% = DoEvents()
Loop Until MSComm1.InBufferCount > 0
Dim ia As Variant
Dim aa() As Byte
ia = MSComm1.Input
aa = ia
L = UBound(aa)
a$ = ""
For i = 0 To L
If Len(Hex(aa(i))) = 1 Then
a$ = a$ + "0" + Hex(aa(i))
Else
a$ = a$ + Hex(aa(i))
End If
Next i
a$ = a$ + ","
Text2.Text = a$ '命令响应码显示
Dim queRen(5) As Byte
queRen(0) = &H10 '命令确认码赋值
queRen(1) = &H2
queRen(2) = &H0
queRen(3) = &H5C
queRen(4) = &H5E
queRen(5) = &H16
For i = 0 To 5
If Len(Hex(queRen(i))) = 1 Then
a$ = a$ + "0" + Hex(queRen(i))
Else
a$ = a$ + Hex(queRen(i))
End If
Next i
Text2.Text = a$ '命令响应码加命令确认码显示清零
MSComm1.RThreshold = 1 '启动接收中断
MSComm1.Output = queRen '命令确认码发送
End Sub
Private Sub Command4_Click()
CommonDialog1.Action = 1
a$ = CommonDialog1.FileName
RichTextBox1.LoadFile a$, 1
End Sub
Private Sub Command5_Click()
RichTextBox1.SaveFile "C:\TempFile", 1
End Sub
Private Sub Form_Load()
MSComm1.CommPort = 1 '指定用口1通讯
MSComm1.Settings = "9600,e,8,1" '指定通讯参数
' MSComm1.PortOpen = True '打开串口
MSComm1.InputMode = comInputModeBinary '指定输入为二进制模式
MSComm1.RThreshold = 0
End Sub
Private Sub MSComm1_OnComm()
If MSComm1.CommEvent = 2 Then
Dim ia As Variant
Dim Ra() As Byte
Dim i, L As Integer
Dim a, aa As String
ia = MSComm1.Input '读串口
Ra = ia
L = UBound(Ra)
a = ""
For i = 0 To L '把字节数组转换为字符
a = Hex(Ra(i))
If Len(a) = 1 Then a = "0" + a
aa = aa + a + " "
Next
Text3.Text = Text3.Text + aa '接收字符显示
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -