Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4095
ClientLeft = 60
ClientTop = 345
ClientWidth = 4275
LinkTopic = "Form1"
ScaleHeight = 4095
ScaleWidth = 4275
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command6
Caption = "运行状态"
Height = 495
Left = 720
TabIndex = 7
Top = 480
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "编程状态"
Height = 495
Left = 2280
TabIndex = 6
Top = 480
Width = 1455
End
Begin VB.TextBox Text3
Height = 495
Left = 2280
TabIndex = 5
Text = "Text3"
Top = 3000
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "写入DM0"
Height = 495
Left = 600
TabIndex = 4
Top = 3000
Width = 1335
End
Begin VB.TextBox Text2
Height = 495
Left = 2280
TabIndex = 3
Text = "Text2"
Top = 2160
Width = 1455
End
Begin VB.CommandButton Command3
Caption = "读出DM0"
Height = 495
Left = 600
TabIndex = 2
Top = 2160
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "监视状态"
Height = 495
Left = 600
TabIndex = 1
Top = 1320
Width = 1335
End
Begin VB.Timer Timer2
Interval = 1000
Left = 1080
Top = 4680
End
Begin VB.CommandButton Command1
Caption = "01000置位"
Height = 495
Left = 2280
TabIndex = 0
Top = 1320
Width = 1455
End
Begin MSCommLib.MSComm MSComm1
Left = 240
Top = 4560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tim As Integer
01000强制置位
Private Sub Command1_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "KS" + "CIO" + Chr$(32) + "001000"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到监视状态
Private Sub Command2_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "02"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
读出DM0
Private Sub Command3_Click()
Dim outstring As String
MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0000" + "0001"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
'判断通讯错误
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
Instring = MSComm1.Input
order1 = Mid(Instring, 6, 2) '结束码
Call ErrMessage(order1)
Text2.Text = Mid(Instring, 8, 4) '取出数据位
End Sub
写入DM0
Private Sub Command4_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "WD" + "0000" + Text3.Text
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到编辑状态
Private Sub Command5_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "00"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到运行状态
Private Sub Command6_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "03"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
Private Sub Form_Load() '初始化
tim = 0
Call INIT_comm
End Sub
COMM初始化
Public Sub INIT_comm()
'Buffer to hold input string
Dim Instring, outstring As String
MSComm1.CommPort = 1 'Use COM1.
MSComm1.Settings = "9600,e,7,2" '9600 baud, e parity, 7 data, and 2 stop bit.
MSComm1.InputLen = 0 'Tell the control to read entire buffer when Input
MSComm1.PortOpen = True 'Open the port.
End SubPrivate Sub Timer2_Timer()
tim = tim + 1
End Sub
通讯错误检测
Public Function ErrMessage(ByVal X As String)
Select Case X
Case "13"
MsgBox "校验错误"
Case "14"
MsgBox "格式错误"
Case "15"
MsgBox "入口码错误"
Case "18"
MsgBox "帧长度错误"
Case "A3"
MsgBox "传送数据时因FCS错误引起终止"
Case "A8"
MsgBox "传送数据时因长度错误引起在终止"
End Select
End Function
FCS计算
Function XORR(ByVal STRI As String) As String '校验码的异或处理
Dim I, J, K As Integer
J = Len(STRI)
K = 0
For I = 1 To J
K = Asc(Mid$(STRI, I, 1)) Xor K
Next I
fcdd$ = Hex$(K)
If Len(fcdd$) = 1 Then
XORR = "0" & fcdd$
Else
XORR = fcdd$
End If
End Function
Caption = "Form1"
ClientHeight = 4095
ClientLeft = 60
ClientTop = 345
ClientWidth = 4275
LinkTopic = "Form1"
ScaleHeight = 4095
ScaleWidth = 4275
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command6
Caption = "运行状态"
Height = 495
Left = 720
TabIndex = 7
Top = 480
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "编程状态"
Height = 495
Left = 2280
TabIndex = 6
Top = 480
Width = 1455
End
Begin VB.TextBox Text3
Height = 495
Left = 2280
TabIndex = 5
Text = "Text3"
Top = 3000
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "写入DM0"
Height = 495
Left = 600
TabIndex = 4
Top = 3000
Width = 1335
End
Begin VB.TextBox Text2
Height = 495
Left = 2280
TabIndex = 3
Text = "Text2"
Top = 2160
Width = 1455
End
Begin VB.CommandButton Command3
Caption = "读出DM0"
Height = 495
Left = 600
TabIndex = 2
Top = 2160
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "监视状态"
Height = 495
Left = 600
TabIndex = 1
Top = 1320
Width = 1335
End
Begin VB.Timer Timer2
Interval = 1000
Left = 1080
Top = 4680
End
Begin VB.CommandButton Command1
Caption = "01000置位"
Height = 495
Left = 2280
TabIndex = 0
Top = 1320
Width = 1455
End
Begin MSCommLib.MSComm MSComm1
Left = 240
Top = 4560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tim As Integer
01000强制置位
Private Sub Command1_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "KS" + "CIO" + Chr$(32) + "001000"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到监视状态
Private Sub Command2_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "02"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
读出DM0
Private Sub Command3_Click()
Dim outstring As String
MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0000" + "0001"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
'判断通讯错误
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
Instring = MSComm1.Input
order1 = Mid(Instring, 6, 2) '结束码
Call ErrMessage(order1)
Text2.Text = Mid(Instring, 8, 4) '取出数据位
End Sub
写入DM0
Private Sub Command4_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "WD" + "0000" + Text3.Text
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到编辑状态
Private Sub Command5_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "00"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
转换到运行状态
Private Sub Command6_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "03"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
Private Sub Form_Load() '初始化
tim = 0
Call INIT_comm
End Sub
COMM初始化
Public Sub INIT_comm()
'Buffer to hold input string
Dim Instring, outstring As String
MSComm1.CommPort = 1 'Use COM1.
MSComm1.Settings = "9600,e,7,2" '9600 baud, e parity, 7 data, and 2 stop bit.
MSComm1.InputLen = 0 'Tell the control to read entire buffer when Input
MSComm1.PortOpen = True 'Open the port.
End SubPrivate Sub Timer2_Timer()
tim = tim + 1
End Sub
通讯错误检测
Public Function ErrMessage(ByVal X As String)
Select Case X
Case "13"
MsgBox "校验错误"
Case "14"
MsgBox "格式错误"
Case "15"
MsgBox "入口码错误"
Case "18"
MsgBox "帧长度错误"
Case "A3"
MsgBox "传送数据时因FCS错误引起终止"
Case "A8"
MsgBox "传送数据时因长度错误引起在终止"
End Select
End Function
FCS计算
Function XORR(ByVal STRI As String) As String '校验码的异或处理
Dim I, J, K As Integer
J = Len(STRI)
K = 0
For I = 1 To J
K = Asc(Mid$(STRI, I, 1)) Xor K
Next I
fcdd$ = Hex$(K)
If Len(fcdd$) = 1 Then
XORR = "0" & fcdd$
Else
XORR = fcdd$
End If
End Function
将Dim tim As Integer开始的行及以下所有代码复制到VB该窗体的代码编辑窗口,然后运行并一一纠错.
以下所有代码复制到VB该窗体的代码编辑窗口,完全可以运行且学习你想掌握的VB通信程序.Option Explicit
Dim tim As Integer
Dim fcdd$
Dim Time_out As String
Dim ERROR_COM As Boolean
Dim Instring As String
Dim endcode As String
'1000 强制置位
Private Sub Command1_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "KS" + "CIO" + Chr$(32) + "001000"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End Sub
'COMM初始化
Public Sub INIT_comm()
'Buffer to hold input string
Dim Instring, outstring As String
MSComm1.CommPort = 1 'Use COM1.
MSComm1.Settings = "9600,e,7,2" '9600 baud, e parity, 7 data, and 2 stop bit.
MSComm1.InputLen = 0 'Tell the control to read entire buffer when Input
MSComm1.PortOpen = True 'Open the port.
End Sub
'通讯错误检测
Public Function ErrMessage(ByVal X As String)
Select Case X
Case "13"
MsgBox "校验错误"
Case "14"
MsgBox "格式错误"
Case "15"
MsgBox "入口码错误"
Case "18"
MsgBox "帧长度错误"
Case "A3"
MsgBox "传送数据时因FCS错误引起终止"
Case "A8"
MsgBox "传送数据时因长度错误引起在终止"
End Select
End Function'FCS计算
Function XORR(ByVal STRI As String) As String '校验码的异或处理
Dim I, J, K As Integer
J = Len(STRI)
K = 0
For I = 1 To J
K = Asc(Mid$(STRI, I, 1)) Xor K
Next I
fcdd$ = Hex$(K)
If Len(fcdd$) = 1 Then
XORR = "0" & fcdd$
Else
XORR = fcdd$
End If
End Function
COMM初始化这样的注释去掉吧?
Option Explicit
Dim tim As Integer
Dim fcs$
Dim Time_out As String
Dim ERROR_COM As Boolean
Dim Instring As String
Dim endcode As String
Dim Lengh As Integer
Dim order1 As StringPublic Sub INIT_comm()
'Buffer to hold input string
Dim Instring, outstring As String
MSComm1.CommPort = 1
'使用COM1.
MSComm1.Settings = "9600,e,7,2"
'9600波特率, e 偶校验, 7 位, 2 停止位.
MSComm1.InputLen = 0
'读取整个缓存的数据
MSComm1.PortOpen = True '打开端口.
End SubPublic Function ErrMessage(ByVal X As String)
Select Case X
Case "13"
MsgBox "校验错误"
Case "14"
MsgBox "格式错误"
Case "15"
MsgBox "入口码错误"
Case "18"
MsgBox "帧长度错误"
Case "A3"
MsgBox "传送数据时因FCS错误引起终止"
Case "A8"
MsgBox "传送数据时因长度错误引起在终止"
End Select
End FunctionFunction XORR(ByVal STRI As String) As String '校验码的异或处理
Dim I, J, K As Integer
J = Len(STRI)
K = 0
For I = 1 To J
K = Asc(Mid$(STRI, I, 1)) Xor K
Next I
fcdd$ = Hex$(K)
If Len(fcdd$) = 1 Then
XORR = "0" & fcdd$
Else
XORR = fcdd$
End If
End FunctionPrivate Sub Command2_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "02"
fcs$ = XORR(outstring)
outstring = outstring + fcs$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End SubPrivate Sub Command3_Click()
Dim outstring As String
MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0000" + "0001"
fcs$ = XORR(outstring)
outstring = outstring + fcs$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
'判断通讯错误
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
Instring = MSComm1.Input
order1 = Mid(Instring, 6, 2) '结束码
Call ErrMessage(order1)
Text2.Text = Mid(Instring, 8, 4)
'取出数据位
End Sub
Private Sub Command4_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "WD" + "0000" + Text3.Text
fcs$ = XORR(outstring)
outstring = outstring + fcs$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End SubPrivate Sub Command5_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "00"
fcs$ = XORR(outstring)
outstring = outstring + fcs$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End SubPrivate Sub Command运行6_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "03"
fcs$ = XORR(outstring)
outstring = outstring + fcs$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim
Do
If tim > (Time_out + 1) Then
ERROR_COM = True
Else
ERROR_COM = False
End If
DoEvents
Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
Instring = MSComm1.Input
endcode = Mid(Instring, 6, 2)
Call ErrMessage(endcode)
End SubPrivate Sub Form_Load()
Dim tim As Date
tim = 0
Call INIT_comm
End Sub
LZ:既然你我修改后没错误了,但是只能读取和写入一个地址
那就核查你的PLC说明书所规约的通信协议于指令的格式来对照你能成功读取和写入一个地址的代码修改其它代码并调试.
你应该用定时器,定时逐个读取不同(地址)的数据.并将接收代码置于MsComm控件的OnComm事件中,按PLC规约的数据帧判断与处理数据.
教你怎么看吧:
你开头第一句:
Begin VB.Form Form1
就是“一个标准的Frm文件,窗口名称是Form1”的意思。
然后是窗体属性设置: Caption = "Form1"
ClientHeight = 4095
ClientLeft = 60
ClientTop = 345
ClientWidth = 4275
LinkTopic = "Form1"
ScaleHeight = 4095
ScaleWidth = 4275
StartUpPosition = 3 '窗口缺省紧接着是控件设置:Begin VB.CommandButton Command6
Caption = "运行状态"
Height = 495
Left = 720
TabIndex = 7
Top = 480
Width = 1215
End
……这里声明的是一个按钮控件,名称是Command6,标题是“运行状态”然后的是系统设置(未知其用途):Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
再后面的就是代码区,就是代码窗口里的代码。