-
-
-
Chennousstar | 当前状态：离线
总积分：304 2024年可用积分：0
注册时间： 2006-12-01
最后登录时间： 2016-05-24
-
-
VB与台达PLC监控通讯软件
Chennousstar 发表于 2007/11/11 20:14:39 2129 查看 1 回复 [上一主题] [下一主题]
手机阅读
今天恰好开博一个月,承蒙各位技术界网友的厚爱,访问量已过千.
为答谢各位网友的支持,也算是一个小小的礼物吧,特将我以VB写的
一个工控通讯程序源码奉上,以资感谢.
这个程序是VB同台达PLC的通讯调试程序,其于台达系列PLC的
MODBUS ASCII协议,涉及IO及寄存器的读写,稍加改动即可用于工
控项目中.我在写这个程序时,也参考了<<基于VB 的台达PLC和监控
计算机的串口通讯>>一文,在此也向作者表示感谢.
Dim plc As Byte
Dim y0flag As Byte
Dim y1flag As Byte
Dim str As String
Dim n, S
Private Sub Command1_Click()
Dim strout As String
Dim QQ As String
Timer1.Enabled = False
QQ = Text1.Text
If Len(QQ) = 3 Then
QQ = "0" & QQ
ElseIf Len(QQ) = 2 Then
QQ = "00" & QQ
ElseIf Len(QQ) = 1 Then
QQ = "000" & QQ
End If
str = "01061000" + QQ
LRCC = LRC(str) '计算 str的lrc校验码。
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Form_Load()
Dim s1 As String
Dim s2 As String
Dim s22 As String
Dim s3 As String
Dim s4 As String
Picture1.Move 0, 0, 5600, 280 '长度可随意改
Timer1.Enabled = True
n = -(Me.TextWidth(Now)) - 10
MSComm1.PortOpen = True
Timer1.Enabled = True
s2 = "01010C300001"
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
TimeDelay (500)
s3 = MSComm1.Input
s4 = Mid$(s3, 8, 2)
If s4 = "31" Then
plc = 1
Else: If s4 = "30" Then plc = 0
End If
If plc = 1 Then
Label2.Caption = "PLC Running"
Shape1.FillColor = RGB(0, 255, 0) 'green
Else
Label2.Caption = "PLC Stopped!"
Shape1.FillColor = RGB(255, 0, 0) 'red
End If
End Sub
Public Function LRC(str As String) As String
c = 0
l = Len(str)
For c = c + 1 To l
c_data = Mid$(str, c, 2)
d_lrc = d_lrc + Val("&H" + c_data)
c = c + 1
Next c
If d_lrc > &HFF Then
d_lrc = d_lrc Mod &H100
End If
h_lrc = Hex(&HFF - d_lrc + 1)
If Len(h_lrc) > 2 Then
h_lrc = Mid(h_lrc, Len(h_lrc) - 1, 2)
End If
LRC = h_lrc
End Function
Private Sub start_Click()
Dim strout As String
Timer1.Enabled = False
str = "01050C30FF00" 'M1072 为PLC起动停止标志位。查地址表，M1072为OC30.FF00为置
' ON,0000为置OFF。
LRCC = LRC(str) '计算 str的lrc校验码。
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub
Private Sub stop_Click()
Dim strout As String
Timer1.Enabled = False
str = "01050C300000"
LRCC = LRC(str)
strout = ":" + str + LRCC + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'判断输入的是否为数字或是 Enter
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 13 Or (KeyAscii >= 65 And KeyAscii <= 70) Then
Else
KeyAscii = 0
Exit Sub
End If
End Sub
Private Sub Timer1_Timer()
Dim s1, s22, s3, s4, s5 As String
Dim s2 As String
Dim counter As Integer
Picture1.AutoRedraw = True
Picture1.Cls
n = n + 10
If Picture1.ScaleWidth <= S Then
n = -(Me.TextWidth(Now)) - 10
End If
Picture1.CurrentX = n
S = n
Picture1.CurrentY = 0
Picture1.Print Now & " Chennousstar@sina.com"
Picture1.AutoRedraw = False
s2 = "01010C300001" 'M1072 Start/Stop Flag
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)
s3 = WaitRS(MSComm1, vbCrLf, 200)
s4 = Mid$(s3, 8, 2)
If s4 = "31" Then
plc = 1
Else: If s4 = "30" Then plc = 0
End If
If plc = 1 Then
Label2.Caption = "PLC Running"
Shape1.FillColor = RGB(0, 255, 0) 'green
Else
Label2.Caption = "PLC Stopped!"
Shape1.FillColor = RGB(255, 0, 0) 'red
End If
s2 = "010108000002" 'Read Y0 Flag
s3 = ""
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)
s3 = WaitRS(MSComm1, vbCrLf, 200)
If s3 = "" Then Exit Sub
s4 = Mid$(s3, 8, 2) And &H1
s5 = Mid$(s3, 8, 2) And &H2
If s4 = "1" Then
y0flag = 1
Else: If s4 = "0" Then y0flag = 0
End If
If y0flag = 1 Then
Shape2.FillColor = RGB(0, 255, 0) 'green
Else
Shape2.FillColor = RGB(255, 0, 0) 'red
End If
If s5 = "2" Then
y1flag = 1
Else: If s5 = "0" Then y1flag = 0
End If
If y1flag = 1 Then
Shape3.FillColor = RGB(0, 255, 0) 'green
Else
Shape3.FillColor = RGB(255, 0, 0) 'red
End If
's2 = "010310000001" 'Read D512 value
's3 = ""
's22 = LRC(s2)
's1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
'MSComm1.InBufferCount = 0
'MSComm1.Output = s1
'TimeDelay (200)
's3 = WaitRS(MSComm1, vbCrLf, 200)
's4 = Mid$(s3, 8, 4)
'Text1.Text = s4
s2 = "010310000001" 'Read D0 value
s3 = ""
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)
s3 = WaitRS(MSComm1, vbCrLf, 200)
s4 = Mid$(s3, 8, 4)
Text2.Text = s4
End Sub
Private Sub Y1_Click()
Dim strout As String
If y1flag = 0 Then
str = "01050801FF00"
LRCC = LRC(str) '计算 str的lrc校验码。
Timer1.Enabled = False
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
Else
str = "010508010000"
LRCC = LRC(str) '计算 str的lrc校验码。
Timer1.Enabled = False
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End If
End Sub
Private Sub YO_Click()
Dim strout As String
If y0flag = 0 Then
str = "01050800FF00"
LRCC = LRC(str) '计算 str的lrc校验码。
Timer1.Enabled = False
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
Else
str = "010508000000"
LRCC = LRC(str) '计算 str的lrc校验码。
Timer1.Enabled = False
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End If
End Sub
源代码压缩档