📄 vb_ppi.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form VB_PPi
Caption = "PPI通讯程序"
ClientHeight = 5265
ClientLeft = 2670
ClientTop = 1695
ClientWidth = 9135
ControlBox = 0 'False
LinkTopic = "Form7"
ScaleHeight = 5265
ScaleWidth = 9135
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3570
Top = 9060
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command5
Caption = "Save"
Height = 405
Left = 6360
TabIndex = 18
Top = 9240
Width = 1185
End
Begin VB.CommandButton Command4
Caption = "Open"
Height = 375
Left = 1230
TabIndex = 17
Top = 9270
Width = 1305
End
Begin RichTextLib.RichTextBox RichTextBox1
Height = 3945
Left = 30
TabIndex = 16
Top = 5220
Width = 8685
_ExtentX = 15319
_ExtentY = 6959
_Version = 393217
Enabled = -1 'True
ScrollBars = 2
MousePointer = 1
AutoVerbMenu = -1 'True
TextRTF = $"VB_PPi.frx":0000
End
Begin MSCommLib.MSComm MSComm1
Left = 30
Top = 4770
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton Command3
Caption = "退 出"
Height = 405
Left = 6720
TabIndex = 13
Top = 4680
Width = 1815
End
Begin VB.CommandButton Command2
Caption = "PLC_stop"
Height = 405
Left = 4545
TabIndex = 12
Top = 4680
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "PLC_run"
Height = 405
Left = 2385
TabIndex = 11
Top = 4680
Width = 1815
End
Begin VB.CommandButton Command8
Caption = "stop"
Height = 885
Left = 12150
TabIndex = 10
Top = 7140
Width = 1095
End
Begin VB.CommandButton Command9
Caption = "run"
Height = 825
Left = 10800
TabIndex = 9
Top = 7200
Width = 1065
End
Begin VB.CommandButton Command12
Caption = "命令发送"
Height = 405
Left = 210
TabIndex = 8
Top = 4680
Width = 1815
End
Begin VB.Frame Frame4
Caption = "命令回应报文"
Height = 1065
Left = 90
TabIndex = 6
Top = 3420
Width = 8955
Begin VB.TextBox Text3
Height = 555
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 420
Width = 8685
End
Begin VB.Label Label4
BackColor = &H00E0E0E0&
Caption = "00 01 02 03 04 05 06 07 08 09 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"
ForeColor = &H00FF0000&
Height = 165
Left = 180
TabIndex = 21
Top = 210
Width = 8055
End
End
Begin VB.Frame Frame3
Caption = "命令响应码，计算机确认码"
Height = 1065
Left = 90
TabIndex = 4
Top = 2300
Width = 8955
Begin VB.CommandButton Command11
Caption = "wVB100=99"
Height = 525
Left = 150
TabIndex = 15
Top = 330
Width = 1335
End
Begin VB.CommandButton Command10
Caption = "rVB100"
Height = 585
Left = 7440
TabIndex = 14
Top = 330
Width = 1305
End
Begin VB.TextBox Text2
Height = 555
Left = 1740
TabIndex = 5
Top = 330
Width = 5445
End
End
Begin VB.Frame Frame2
Caption = "发送命令报文"
Height = 1065
Left = 90
TabIndex = 2
Top = 1180
Width = 8955
Begin VB.TextBox Text1
Height = 555
Left = 180
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 420
Width = 8655
End
Begin VB.Label Label2
BackColor = &H00E0E0E0&
Caption = "00 01 02 03 04 05 06 07 08 09 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"
ForeColor = &H00FF0000&
Height = 165
Left = 210
TabIndex = 20
Top = 210
Width = 8115
End
End
Begin VB.Frame Frame1
Caption = "命令编辑"
Height = 1065
Left = 90
TabIndex = 0
Top = 60
Width = 8955
Begin VB.TextBox Text4
ForeColor = &H00000000&
Height = 585
Left = 180
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "VB_PPi.frx":0098
Top = 390
Width = 8685
End
Begin VB.Label Label1
BackColor = &H00E0E0E0&
Caption = "00 01 02 03 04 05 06 07 08 09 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"
ForeColor = &H00FF0000&
Height = 165
Left = 240
TabIndex = 19
Top = 210
Width = 8115
End
End
End
Attribute VB_Name = "VB_PPi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click() 'PLC-run
'00 01 02 03 04 05 06 07 08 09 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
Dim o$
o$ = "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"
sendOrder (o$)
Exit Sub
Dim str_write(0 To 38) 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
'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
'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
'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
str_write(0) = &H68
str_write(1) = &H21
str_write(2) = &H21
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) = &H14
str_write(15) = &H0
str_write(16) = &H0
str_write(17) = &H28
str_write(18) = &H0
str_write(19) = &H0
str_write(20) = &H0
str_write(21) = &H0
str_write(22) = &H0
str_write(23) = &H0
str_write(24) = &HFD
str_write(25) = &H0
str_write(26) = &H0
str_write(27) = &H9
str_write(28) = &H50
str_write(29) = &H5F
str_write(30) = &H50
str_write(31) = &H52
str_write(32) = &H4F
str_write(33) = &H47
str_write(34) = &H52
str_write(35) = &H41
str_write(36) = &H4D
For i = 4 To 36
Temp_FCS = Temp_FCS + str_write(i)
Next
str_write(37) = Temp_FCS Mod 256
str_write(38) = &H16
Dim a$
For i = 0 To 38
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 = a$ 'str_val
End Sub
Private Sub Command10_Click() 'rVB100
'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
'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
Dim o$
o$ = "68 1B 1B 68 02 00 6C 32 01 00 00 00 00 00 0E 00 00 04 01 12 0A 10 02 00 01 00 01 84 00 03 20 8B 16"
sendOrder (o$)
Exit Sub
Dim str_write(0 To 32) 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) = &H1B
str_write(2) = &H1B
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) = &HE
str_write(15) = &H0
str_write(16) = &H0
str_write(17) = &H4
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) = &H8B
For i = 4 To 30
Temp_FCS = Temp_FCS + str_write(i)
Next
str_write(31) = Temp_FCS Mod 256
str_write(32) = &H16
Dim a$
For i = 0 To 32
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$
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))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -