📄 main.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form main
BorderStyle = 1 'Fixed Single
Caption = " "
ClientHeight = 2820
ClientLeft = 45
ClientTop = 435
ClientWidth = 5520
Icon = "main.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2820
ScaleWidth = 5520
StartUpPosition = 2 '屏幕中心
Begin MSCommLib.MSComm MSComm1
Left = 120
Top = 2160
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
ParitySetting = 1
End
Begin VB.CommandButton Command1
Caption = "关闭(&C)"
Height = 375
Index = 1
Left = 4200
TabIndex = 3
Top = 2160
Width = 855
End
Begin VB.CommandButton Command1
Caption = "发送(&S)"
Enabled = 0 'False
Height = 375
Index = 0
Left = 3270
TabIndex = 2
Top = 2160
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Index = 1
Left = 1080
TabIndex = 1
Top = 1680
Width = 3975
End
Begin VB.TextBox Text1
Height = 270
Index = 0
Left = 1080
TabIndex = 0
Top = 1320
Width = 3975
End
Begin VB.ComboBox Combo1
DataField = "cp1"
DataSource = "Adodc1"
Height = 300
Index = 2
ItemData = "main.frx":1E72
Left = 1080
List = "main.frx":1E74
Style = 2 'Dropdown List
TabIndex = 6
Top = 480
Width = 1455
End
Begin VB.ComboBox Combo1
DataSource = "Adodc1"
Height = 300
Index = 0
ItemData = "main.frx":1E76
Left = 1080
List = "main.frx":1E8F
Style = 2 'Dropdown List
TabIndex = 4
Top = 120
Width = 1455
End
Begin VB.ComboBox Combo1
DataField = "cp1"
DataSource = "Adodc1"
Height = 300
Index = 1
ItemData = "main.frx":1ECA
Left = 3600
List = "main.frx":1EE9
Style = 2 'Dropdown List
TabIndex = 5
Top = 120
Width = 1455
End
Begin VB.ComboBox Combo1
DataField = "ps1"
DataSource = "Adodc1"
Height = 300
Index = 3
ItemData = "main.frx":1F23
Left = 3600
List = "main.frx":1F3F
Style = 2 'Dropdown List
TabIndex = 7
Top = 480
Width = 1455
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "返回字符"
Height = 255
Index = 5
Left = 240
TabIndex = 13
Top = 1800
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "发送字符"
Height = 255
Index = 4
Left = 240
TabIndex = 12
Top = 1440
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "通讯设备"
Height = 255
Index = 3
Left = 240
TabIndex = 11
Top = 240
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "通讯地址"
Height = 255
Index = 2
Left = 240
TabIndex = 10
Top = 600
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "端口设置"
Height = 255
Index = 1
Left = 2760
TabIndex = 9
Top = 600
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "通讯端口"
Height = 255
Index = 0
Left = 2760
TabIndex = 8
Top = 240
Width = 855
End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
On Error GoTo errd
Dim ComAdd As String
If Index = 0 Then
Command1(0).Enabled = False
Text1(1).Text = ""
If MSComm1.PortOpen Then MSComm1.PortOpen = False
MSComm1.CommPort = Mid(Combo1(1).Text, 4, 1) ' 1
MSComm1.Settings = "9600,O,8,1" 'Combo1(3).Text
MSComm1.PortOpen = True
Select Case Combo1(0).Text
Case "SR93"
ComAdd = Hex(Val(Combo1(2).Text)) '计算通讯地址
MSComm1.InBufferCount = 0
MSComm1.Output = Sr93(ComAdd, "W018C0", "0001") '打开远程通讯
Delay (0.2)
For k = 1 To 3
MSComm1.InBufferCount = 0
MSComm1.Output = Sr93(ComAdd, "R01000", "") '读数
Delay (0.2)
temp = MSComm1.Input ' "+25+0000040312A70"
If Len(temp) > 0 And SR93bcc(temp) Then Exit For
Next
If Len(temp) = 0 Then
Text1(1).Text = "通讯失败"
Else
Text1(1).Text = temp
End If
MSComm1.InBufferCount = 0
MSComm1.Output = Sr93(ComAdd, "W018C0", "0000") '关闭远程通讯
Delay (0.2)
Case "欧陆818"
ComAdd = Combo1(2).Text '计算通讯地址
For k = 1 To 5
MSComm1.InBufferCount = 0
MSComm1.Output = Eur818(ComAdd, "PV", "") '读数
Delay (0.2)
temp = MSComm1.Input ' "000008500.aa#"
If Len(temp) > 0 And Eur818bcc(temp) Then Exit For
Next
If Len(temp) = 0 Then
Text1(1).Text = "通讯失败"
Else
Text1(1).Text = temp
End If
Case "欧陆903"
ComAdd = Combo1(2).Text '计算通讯地址
For k = 1 To 5
MSComm1.InBufferCount = 0
MSComm1.Output = Eur818(ComAdd, "PV", "") '读数
Delay (0.2)
temp = MSComm1.Input ' "000008500.aa#"
If Len(temp) > 0 And Eur818bcc(temp) Then Exit For
Next
If Len(temp) = 0 Then
Text1(1).Text = "通讯失败"
Else
Text1(1).Text = temp
End If
Case "欧陆2604"
Case "Fp21"
Case "SR73"
ComAdd = Hex(Val(Combo1(2).Text)) '计算通讯地址
MSComm1.InBufferCount = 0
MSComm1.Output = SR73(ComAdd, "F71", "") '打开远程通讯
Delay (0.3)
For k = 1 To 3
MSComm1.InBufferCount = 0
MSComm1.Output = SR73(ComAdd, "D1", "") '读数
Delay (0.3)
temp = MSComm1.Input
If Len(temp) > 0 And SR73bcc(temp) Then Exit For
Next
If Len(temp) = 0 Then
Text1(1).Text = "通讯失败"
Else
Text1(1).Text = temp
End If
MSComm1.InBufferCount = 0
MSComm1.Output = SR73(ComAdd, "F70", "") '关闭远程通讯
Delay (0.3)
Case "松下FP0" '%EE#WCSR00011
comm = Mid(Text1(0).Text, 1)
bcc = 0
For i = 1 To Len(comm)
bcc = bcc Xor Asc(Mid(comm, i, 1))
Next
bcc = bcc Mod 256
If bcc < 16 Then
bcc = "0" & Hex(bcc)
Else
bcc = Hex(bcc)
End If
comm = Text1(0).Text + bcc + Chr(13)
MSComm1.InBufferCount = 0
MSComm1.Output = comm
Delay (1)
temp = MSComm1.Input
If Len(temp) = 0 Then
Text1(1).Text = "通讯失败"
Else
Text1(1).Text = temp
End If
MSComm1.InBufferCount = 0
End Select
MSComm1.PortOpen = False
Command1(0).Enabled = True
Else
End
End If
Exit Sub
errd:
Text1(1).Text = "错误代码" & Err & "," & Error
End Sub
Private Sub Form_Load()
For i = 1 To 99
Combo1(2).AddItem i
Next
For i = 0 To 3
Combo1(i).ListIndex = 0
Next
End Sub
Private Sub Text1_Change(Index As Integer)
If Len(Text1(0)) = 0 Then
Command1(0).Enabled = False
Else
Command1(0).Enabled = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -