谁想要VB写的PC和PLC的通讯程序-专业自动化论坛-中国工控网论坛

谁想要VB写的PC和PLC的通讯程序点击：5902 | 回复：98

精华：0帖
求助：0帖
帖子：25帖 | 330回
年度积分：0
历史总积分：852
注册：2003年10月23日

发表于：2006-08-16 11:52:00

楼主

写这个程序只是为了在没有软件的情况下，用PC和三菱PLC通讯，可以进行监控输入，输出也可以进行单点，批量写入读出操作，支持FX全系列，Q系列的Q02到Q06H，可以使用COM，ETHERNET，USB通讯协议。如果有特别需要的话，本人愿代写此类工程程序。请大家多多指教！

分享到：

邀请回答

回复楼主

StoneChen

精华：0帖
求助：0帖
帖子：25帖 | 330回
年度积分：0
历史总积分：852
注册：2003年10月23日

发表于：2006-08-18 12:36:00

21楼

花的时间较少，可能搞的不是很完善，希望能给点意见！量不胜感激！

回复引用举报

依凡

精华：0帖
求助：0帖
帖子：30帖 | 312回
年度积分：0
历史总积分：741
注册：2002年11月16日

发表于：2006-08-18 21:37:00

22楼

我要啊！
roger4867@sina.com　　多谢，多谢

回复引用举报

StoneChen

精华：0帖
求助：0帖
帖子：25帖 | 330回
年度积分：0
历史总积分：852
注册：2003年10月23日

发表于：2006-08-19 13:02:00

23楼

想要的同仁到资料库下载吧

回复引用举报

中国人老A

精华：0帖
求助：0帖
帖子：9帖 | 8回
年度积分：0
历史总积分：46
注册：2005年5月30日

发表于：2006-08-19 13:53:00

24楼

给俺一份吧，俺想学学！
jijun2005000@sina.com

回复引用举报

0817

精华：0帖
求助：0帖
帖子：1帖 | 18回
年度积分：0
历史总积分：21
注册：2005年1月19日

发表于：2006-09-03 14:52:00

25楼

拜托了，请给我也发一份，我先谢谢了！
E-：3230JJ@163.com
QQ :630360876

回复引用举报

曾文

精华：0帖
求助：0帖
帖子：0帖 | 4回
年度积分：0
历史总积分：57
注册：2006年8月12日

发表于：2006-09-03 15:04:00

26楼

回复引用举报

曾文

精华：0帖
求助：0帖
帖子：0帖 | 4回
年度积分：0
历史总积分：57
注册：2006年8月12日

发表于：2006-09-03 15:06:00

27楼

能给我一份吗?谢谢!我用的是VB与FX系列的PLC通信,用SC-09连接.
zenwenbin@163.com

回复引用举报

好阿

精华：0帖
求助：0帖
帖子：0帖 | 9回
年度积分：0
历史总积分：21
注册：2006年9月03日

发表于：2006-09-05 20:08:00

28楼

楼主我想要你程序的源代码来学习一下可以吗？先谢谢！
lksn9@sina.com

回复引用举报

StoneChen

精华：0帖
求助：0帖
帖子：25帖 | 330回
年度积分：0
历史总积分：852
注册：2003年10月23日

发表于：2006-09-09 19:43:00

29楼

Private Sub Form_Load()
Doubleponit.Checked = False
Oneponit.Checked = True
Com1.Checked = True
Com2.Checked = False
Com3.Checked = False
Com4.Checked = False
Run.Checked = False
OFF.Checked = True
Msg.Caption = "COM" & ActQJ71.ActPortNumber & "未连线..."
Tras.BackColor = vbGreen
Tras1.Visible = False
Timer1.Enabled = False
Timer2.Enabled = False
Msg.BackColor = vbGreen

End Sub

Private Sub Help_Click()
Path.Text = App.Path & "\Help.dll"

Shell "C:\windows\notepad.exe " & Path.Text, vbNormalFocus
End Sub
Private Sub Monit_Click()

Timer1.Enabled = True
Msg.Caption = "COM" & ActQJ71.ActPortNumber & "连线监控中..."

End Sub

Private Sub OFF_Click()
Run.Checked = False
OFF.Checked = True
ActQJ71.Close
Msg.Caption = "COM" & ActQJ71.ActPortNumber & "离线中...."

End Sub

Private Sub Oneponit_Click()
Doubleponit.Checked = False
Oneponit.Checked = True
Dob = 2
Sig = 1

End Sub

Private Sub Read_Click()

Dim Devic As String
Dim dev As Integer
Dim de As Integer
Dim Nm As String
Dim Nb As Integer

Adress.Text = UCase(Adress.Text)

dev = Int(Right(Adress.Text, Len(Adress.Text) - 1))

Devic = Left(Adress.Text, 1)
Nm = Right(Adress.Text, Len(Adress.Text) - 1)

If Devic = "M" Then

  If dev Mod 16 > 0 Then

    Dim C As Integer

    C = MsgBox("输入错误！必须为16的倍数！", vbOKOnly + vbInformation, _
         "System Error")
      If C = 1 Then
      Adress.Text = "M" & (Int(dev / 16)) * 16
      Adress.SetFocus
      End If
  End If

End If

'定义变量
Dim Adds As String  '取写入地址
Dim Siz, ReadData As Long  '取写入大小与写入数值
'取数值
Adds = Adress.Text
Siz = Int(Size.Text)
'开始读取/读取格式
ActQJ71.ReadDeviceBlock Adds, Siz, ReadData
'显示返回值
Read_data.Text = ReadData
Msg.Caption = "接收完成...."

End Sub

Private Sub Run_Click()
Run.Checked = True
OFF.Checked = False
Timer2.Enabled = False
ActQJ71.Open '打开EtherNet通讯
Call Labe
Call ErrorExcu

End Sub

Private Sub Stop_Click()

Read_data.Text = "0"
Timer1.Enabled = False
Call lampe
Call delay(1000)
Msg.Caption = "COM" & ActQJ71.ActPortNumber & "监控停止...."

End Sub

Private Sub Timer1_Timer()

'定义变量
Dim Adds As String  '取写入地址
Dim Siz, ReadData As Long  '取写入大小与写入数值
'取数值
Adds = Adress.Text
Siz = Int(Size.Text)
'开始读取/读取格式

If Dob = 1 And Sig = 2 Then '///多点监控

   ActQJ71.ReadDeviceBlock Adds, Siz, ReadData

Else
    '///单点监控
    ActQJ71.ReadDeviceRandom Adds, Siz, ReadData

End If
'显示返回值
Read_data.Text = ReadData

Call lampe
End Sub

Private Sub Timer2_Timer()

ActQJ71.Close
Call delay(1)
ActQJ71.Open
Call ErrorExcu

End Sub

Private Sub Tras_Click()

Dim a1 As Long

a1 = Int(Size1.Text)
Adress1.Text = Hex(a1)
Tras.Visible = False
Tras1.Visible = True
Call delay(20)
Tras1.BackColor = vbRed

End Sub

Private Sub Tras1_Click()

Tras.Visible = True
Tras1.Visible = False
Call delay(10)
Tras.BackColor = vbGreen

End Sub

Private Sub USB_Click()
Monit_FX2N.Visible = False
Monit_USB.Visible = True
End Sub

Private Sub Write_Click()

Dim Devic As String
Dim dev As Integer
Dim de As Integer
Dim Nm As String
Dim Nb As Integer
Adress.Text = UCase(Adress.Text)

dev = Int(Right(Adress.Text, Len(Adress.Text) - 1))

Devic = Left(Adress.Text, 1)
Nm = Right(Adress.Text, Len(Adress.Text) - 1)

If Devic = "M" Or Devic = "Y" Or Devic = "X" Or Devic = "S" Then

  If dev Mod 16 > 0 Then

    Dim C As Integer

    C = MsgBox("输入错误！必须为16的倍数！", vbOKOnly + vbInformation, _
         "System Error")
      If C = 1 Then
      Adress.Text = Devic & (Int(dev / 16)) * 16
      Adress.SetFocus
      End If
  End If

End If

'定义变量
Dim Adds As String  '取写入地址
Dim Siz, WriteData As Long  '取写入大小与写入数值
'取数值
Adds = Adress.Text
Siz = Int(Size.Text)
WriteData = Int(Write_data)
'开始写入/写入格式
ActQJ71.WriteDeviceBlock Adds, Siz, WriteData

Msg.Caption = "COM" & ActQJ71.ActPortNumber & "发送完成...."

End Sub

Function lampe()
'设定变量，以用于十进制转化成二进制
Dim d0, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15, d16 As Integer
Dim O, O1, O2, O3, O4, O5, O6, O7, O8, O9, O10, O11, O12, O13, O14, O15, O16 As Integer
Dim Outp As String

d0 = Int(Read_data.Text)
d1 = Int(d0 / 2)
d2 = Int(d1 / 2)
d3 = Int(d2 / 2)
d4 = Int(d3 / 2)
d5 = Int(d4 / 2)
d6 = Int(d5 / 2)
d7 = Int(d6 / 2)
d8 = Int(d7 / 2)
d9 = Int(d8 / 2)
d10 = Int(d9 / 2)
d11 = Int(d10 / 2)
d12 = Int(d11 / 2)
d13 = Int(d12 / 2)
d14 = Int(d13 / 2)
d15 = Int(d14 / 2)
d16 = Int(d15 / 2)
'求余数运算
O = d0 Mod 2
O1 = d1 Mod 2
O2 = d2 Mod 2
O3 = d3 Mod 2
O4 = d4 Mod 2
O5 = d5 Mod 2
O6 = d6 Mod 2
O7 = d7 Mod 2
O8 = d8 Mod 2
O9 = d9 Mod 2
O10 = d10 Mod 2
O11 = d11 Mod 2
O12 = d12 Mod 2
O13 = d13 Mod 2
O14 = d14 Mod 2
O15 = d15 Mod 2
'将十进制转化成二进制，用来显示状态
Outp = O15 & O14 & O13 & O12 & O11 & O10 & O9 & O8 & _
O7 & O6 & O5 & O4 & O3 & O2 & O1 & O

Tex.Text = InStr(1, Outp, 1)  '显示ＯＮ/ＯＦＦ状态

'If Outp > 0 Then Bito.Text = Mid(Outp, InStr(1, Outp, 1))

If O = 1 Then
     Lamp0.BackColor = vbRed    '状态ON
Else
     Lamp0.BackColor = vbGreen  '状态OFF
End If

If O1 = 1 Then
     Lamp1.BackColor = vbRed
Else
     Lamp1.BackColor = vbGreen
End If

If O2 = 1 Then
     Lamp2.BackColor = vbRed
Else
     Lamp2.BackColor = vbGreen
End If

If O3 = 1 Then
     Lamp3.BackColor = vbRed
Else
     Lamp3.BackColor = vbGreen
End If

If O4 = 1 Then
     Lamp4.BackColor = vbRed
Else
     Lamp4.BackColor = vbGreen
End If

If O5 = 1 Then
     Lamp5.BackColor = vbRed
Else
     Lamp5.BackColor = vbGreen
End If

If O6 = 1 Then
     Lamp6.BackColor = vbRed
Else
     Lamp6.BackColor = vbGreen
End If

If O7 = 1 Then
     Lamp7.BackColor = vbRed
Else
     Lamp7.BackColor = vbGreen
End If

If O8 = 1 Then
     Lamp8.BackColor = vbRed
Else
     Lamp8.BackColor = vbGreen
End If

If O9 = 1 Then
     Lamp9.BackColor = vbRed
Else
     Lamp9.BackColor = vbGreen
End If

If O10 = 1 Then
     Lamp10.BackColor = vbRed
Else
     Lamp10.BackColor = vbGreen
End If

If O11 = 1 Then
     Lamp11.BackColor = vbRed
Else
     Lamp11.BackColor = vbGreen
End If

If O12 = 1 Then
     Lamp12.BackColor = vbRed
Else
     Lamp12.BackColor = vbGreen
End If

If O13 = 1 Then
     Lamp13.BackColor = vbRed
Else
     Lamp13.BackColor = vbGreen
End If

If O14 = 1 Then
     Lamp14.BackColor = vbRed
Else
     Lamp14.BackColor = vbGreen
End If

If O15 = 1 Then
     Lamp15.BackColor = vbRed
Else
     Lamp15.BackColor = vbGreen
End If

End Function

Function ErrorExcu()

Dim Error_code As String

Ercd.Text = Hex(Int(ActQJ71.Open))

Error_code = Ercd.Text

If Error_code = "1808009" Then

   Run.Checked = False
   OFF.Checked = True

  Msg.Caption = "COM" & ActQJ71.ActPortNumber & "连线失败..."
   Dim rtc As Integer

   rtc = MsgBox("无法打开串口,可能有以下几种原因：" & vbCrLf & _
        "1.通讯电线问题;" & vbCrLf & "2.PLC无电源;" & vbCrLf & _
        "3.COM 设置错误;", _
        vbAbortRetryIgnore + vbInformation, "Commucation Errors")

   If rtc = 3 Then End
   If rtc = 4 Then Timer2.Enabled = True
   If rtc = 5 Then
      ActQJ71.Close
      Timer1.Enabled = False
      Timer2.Enabled = False
      Read_data.Text = "0"
      Call delay(2)
      Call lampe
    End If

End If

If Error_code = "180840B" Then
    Run.Checked = False
    OFF.Checked = True

  Msg.Caption = "COM" & ActQJ71.ActPortNumber & "连线失败..."
   rtc = MsgBox("通讯时间超出,可能有以下几种原因：" & vbCrLf & _
        "1.通讯电线问题;" & vbCrLf & "2.PLC无电源;" & vbCrLf & _
        "3.COM 设置错误;", _
        vbAbortRetryIgnore + vbInformation, "Commucation Errors")

   If rtc = 3 Then End
   If rtc = 4 Then Timer2.Enabled = True
   If rtc = 5 Then
      ActQJ71.Close
      Timer1.Enabled = False
      Timer2.Enabled = False
      Read_data.Text = "0"
      Call delay(2)
      Call lampe
   End If

End If
End Function

Function delay(t)

Dim j, i, Sum As Integer

For i = 1 To t
For j = 1 To 30
  Sum = 10 * sIn(10 * j / 20)
Next j
Next i

End Function

Function Labe()

Dim Devic As String
Dim dev As Integer
Dim de As Integer
Dim Nm As String
Dim Nb As Integer

dev = Int(Right(Adress.Text, Len(Adress.Text) - 1))

Devic = Left(Adress.Text, 1)
Nm = Right(Adress.Text, Len(Adress.Text) - 1)

'地址标签
Nb = Int(Nm)

If Devic = "X" Or Devic = "Y" Then
  Label00.Caption = Devic + Right(Str(Nb), Len(Str(Nb)) - 1)
  Label01.Caption = Devic + Right(Str(Oct(Nb + 1)), Len(Str(Nb + 1)) - 1)
  Label02.Caption = Devic + Right(Str(Oct(Nb + 2)), Len(Str(Nb + 2)) - 1)
  Label03.Caption = Devic + Right(Str(Oct(Nb + 3)), Len(Str(Nb + 3)) - 1)
  Label04.Caption = Devic + Right(Str(Oct(Nb + 4)), Len(Str(Nb + 4)) - 1)
  Label05.Caption = Devic + Right(Str(Oct(Nb + 5)), Len(Str(Nb + 5)) - 1)
  Label06.Caption = Devic + Right(Str(Oct(Nb + 6)), Len(Str(Nb + 6)) - 1)
  Label07.Caption = Devic + Right(Str(Oct(Nb + 7)), Len(Str(Nb + 7)) - 1)
  Label08.Caption = Devic + Right(Str(Oct(Nb + 10)), Len(Str(Nb + 10)) - 1)
  Label09.Caption = Devic + Right(Str(Oct(Nb + 11)), Len(Str(Nb + 11)) - 1)
  Label10.Caption = Devic + Right(Str(Oct(Nb + 12)), Len(Str(Nb + 12)) - 1)
  Label11.Caption = Devic + Right(Str(Oct(Nb + 13)), Len(Str(Nb + 13)) - 1)
  Label12.Caption = Devic + Right(Str(Oct(Nb + 14)), Len(Str(Nb + 14)) - 1)
  Label13.Caption = Devic + Right(Str(Oct(Nb + 15)), Len(Str(Nb + 15)) - 1)
  Label14.Caption = Devic + Right(Str(Oct(Nb + 16)), Len(Str(Nb + 16)) - 1)
  Label15.Caption = Devic + Right(Str(Oct(Nb + 17)), Len(Str(Nb + 17)) - 1)

End If

If Devic = "M" Or Devic = "S" Then
  Label00.Caption = Devic + Right(Str(Nb), Len(Str(Nb)) - 1)
  Label01.Caption = Devic + Right(Str(Nb + 1), Len(Str(Nb + 1)) - 1)
  Label02.Caption = Devic + Right(Str(Nb + 2), Len(Str(Nb + 2)) - 1)
  Label03.Caption = Devic + Right(Str(Nb + 3), Len(Str(Nb + 3)) - 1)
  Label04.Caption = Devic + Right(Str(Nb + 4), Len(Str(Nb + 4)) - 1)
  Label05.Caption = Devic + Right(Str(Nb + 5), Len(Str(Nb + 5)) - 1)
  Label06.Caption = Devic + Right(Str(Nb + 6), Len(Str(Nb + 6)) - 1)
  Label07.Caption = Devic + Right(Str(Nb + 7), Len(Str(Nb + 7)) - 1)
  Label08.Caption = Devic + Right(Str(Nb + 8), Len(Str(Nb + 8)) - 1)
  Label09.Caption = Devic + Right(Str(Nb + 9), Len(Str(Nb + 9)) - 1)
  Label10.Caption = Devic + Right(Str(Nb + 10), Len(Str(Nb + 10)) - 1)
  Label11.Caption = Devic + Right(Str(Nb + 11), Len(Str(Nb + 11)) - 1)
  Label12.Caption = Devic + Right(Str(Nb + 12), Len(Str(Nb + 12)) - 1)
  Label13.Caption = Devic + Right(Str(Nb + 13), Len(Str(Nb + 13)) - 1)
  Label14.Caption = Devic + Right(Str(Nb + 14), Len(Str(Nb + 14)) - 1)
  Label15.Caption = Devic + Right(Str(Nb + 15), Len(Str(Nb + 15)) - 1)

End If

If Devic = "D" Then
   Dim Capt As String

   Capt = Devic + "-"
     Label00.Caption = Capt + "." + "0"
     Label01.Caption = Capt + "." + "1"
     Label02.Caption = Capt + "." + "2"
     Label03.Caption = Capt + "." + "3"
     Label04.Caption = Capt + "." + "4"
     Label05.Caption = Capt + "." + "5"
     Label06.Caption = Capt + "." + "6"
     Label07.Caption = Capt + "." + "7"
     Label08.Caption = Capt + "." + "8"
     Label09.Caption = Capt + "." + "9"
     Label10.Caption = Capt + "." + "10"
     Label11.Caption = Capt + "." + "11"
     Label12.Caption = Capt + "." + "12"
     Label13.Caption = Capt + "." + "13"
     Label14.Caption = Capt + "." + "14"
     Label15.Caption = Capt + "." + "15"

End If

End Function

回复引用举报

StoneChen