OMRON PLC与VB6.0组成上位机系统

'=========================================此代码为PLC通信模块代码===================================== '===================================================================================================== Private Sub Command1_Click() On Error GoTo err1 Call scfun_00(MSComm1) Exit Sub err1: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command10_Click() Dim OutString As String Dim OurData As String Dim instrr As String Dim i As Integer On Error GoTo err1 If Text9 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text10 = "" Then MsgBox "请输入写入值", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text9.Text) OutString = OutString & "0" Next OurData = BcdtoHex_2W_S(Text10.Text) Call writeomron_H(OutString & Text9.Text, OurData, instrr, MSComm1) Exit Sub err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command11_Click() Dim OutString As String Dim OurLens As String Dim stromron As String Dim i As Integer On Error GoTo err1 If Text9 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text12 = "" Then MsgBox "请输入字节数", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text9.Text) OutString = OutString & "0" Next For i = 1 To 4 - Len(Text12.Text) OurLens = OurLens & "0" Next Text11.Text = readomron_H(OutString & Text9.Text, OurLens & Text12.Text, stromron, MSComm1) Exit Sub err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command12_Click() Dim OutString As String Dim FrontZero As String Dim OutData As String Dim EndZero As String On Error GoTo error If Text15 = "" Then MsgBox "请输入字地址", vbExclamation, "警告" Exit Sub End If If Val(Text16.Text) > 15 Or Val(Text16.Text) < 0 Then MsgBox "请输入正确位地址", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text15.Text) OutString = OutString & "0" Next OutData = 2 ^ (Val(Text16.Text) Mod 4) For i = 1 To (Val(Text16.Text) \ 4) EndZero = EndZero & "0" Next For i = 1 To 4 - Len(OutData & EndZero) FrontZero = FrontZero & "0" Next Call sendPLC_set(OutString & Text15.Text, FrontZero & OutData & EndZero, MSComm1) Exit Sub error: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command13_Click() Dim OutString As String Dim FrontZero As String Dim OutData As String Dim EndZero As String On Error GoTo error If Text15 = "" Then MsgBox "请输入字地址", vbExclamation, "警告" Exit Sub End If If Val(Text16.Text) > 15 Or Val(Text16.Text) < 0 Then MsgBox "请输入正确位地址", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text15.Text) OutString = OutString & "0" Next OutData = 2 ^ (Val(Text16.Text) Mod 4) For i = 1 To (Val(Text16.Text) \ 4) EndZero = EndZero & "0" Next For i = 1 To 4 - Len(OutData & EndZero) FrontZero = FrontZero & "0" Next Call sendPLC_Rset(OutString & Text15.Text, FrontZero & OutData & EndZero, MSComm1) Exit Sub error: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command2_Click() On Error GoTo err1 Call scfun_02(MSComm1) Exit Sub err1: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command3_Click() On Error GoTo err1 Call scfun_03(MSComm1) Exit Sub err1: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command4_Click() On Error GoTo err1 Call imadacommOmron(MSComm1, Combo1.ListIndex + 1) Label17.Caption = "已连接" Label17.ForeColor = vbGreen Exit Sub err1: MsgBox "所选择端口不存在，请重新选择", vbExclamation, "提示" End Sub Private Sub Command5_Click() Dim OutString As String Dim OurData As String Dim instrr As String Dim i As Integer On Error GoTo err1 If Text1 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text2 = "" Then MsgBox "请输入写入值", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text1.Text) OutString = OutString & "0" Next OurData = BcdtoHex_2W_S(Text2.Text) Call writeomron_D(OutString & Text1.Text, OurData, instrr, MSComm1) Exit Sub err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command6_Click() Dim OutString As String Dim OurLens As String Dim stromron As String Dim i As Integer On Error GoTo err1 If Text1 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text4 = "" Then MsgBox "请输入字节数", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text1.Text) OutString = OutString & "0" Next For i = 1 To 4 - Len(Text4.Text) OurLens = OurLens & "0" Next Text3.Text = readomron_D(OutString & Text1.Text, OurLens & Text4.Text, stromron, MSComm1) Exit Sub err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command7_Click() Dim OutString As String Dim OurLens As String Dim stromron As String Dim i As Integer On Error GoTo err1 If Text8 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text5 = "" Then MsgBox "请输入字节数", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text8.Text) OutString = OutString & "0" Next For i = 1 To 4 - Len(Text5.Text) OurLens = OurLens & "0" Next Text6 = readomron_R(OutString & Text8.Text, OurLens & Text5.Text, stromron, MSComm1) err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command8_Click() Dim OutString As String Dim OurData As String Dim instrr As String Dim i As Integer On Error GoTo err1 If Text8 = "" Then MsgBox "请输入寄存器编号", vbExclamation, "警告" Exit Sub End If If Text7 = "" Then MsgBox "请输入写入值", vbExclamation, "警告" Exit Sub End If For i = 1 To 4 - Len(Text8.Text) OutString = OutString & "0" Next OurData = BcdtoHex_2W_S(Text7.Text) Call writeomron_R(OutString & Text8.Text, OurData, instrr, MSComm1) Exit Sub err1: MsgBox "参数输入有误或端口未打开", vbExclamation, "警告" End Sub Private Sub Command9_Click() On Error GoTo err1 If Text13 = "" Then MsgBox "请输入原始数据", vbExclamation, "警告" Exit Sub End If Text14 = BcdtoHex_2W_S(Text13.Text) Exit Sub err1: MsgBox "请按规范输入原始数据，请重新输入", vbExclamation, "提示" End Sub Private Sub Form_Load() With Combo1 For i = 1 To 20 .AddItem "Comm" & CStr(i) Next .ListIndex = 0 End With End Sub Private Sub Text16_LostFocus() If Val(Text16.Text) > 15 Or Val(Text16.Text) < 0 Then MsgBox "请输入正确位地址", vbExclamation, "警告" Text16.SetFocus Exit Sub End If End Sub Option Explicit Declare Sub mSecSleep Lib "kernel32" Alias "Sleep" (ByVal lngmSec As Long) '==========延时函数 '===================================前导零，零位4=========================== Public Function add_0(ByVal addstr As String) If Len(addstr) < 4 Then If 4 - Len(addstr) = 1 Then add_0 = "0" & addstr ElseIf 4 - Len(addstr) = 2 Then add_0 = "0" & "0" & addstr ElseIf 4 - Len(addstr) = 3 Then add_0 = "0" & "0" & "0" & addstr End If Else add_0 = addstr End If End Function '===================================前导零，零位8=========================== Public Function add_0_8(ByVal addstr As String) Dim n, m, j As Byte n = Len(addstr) m = 8 - n If m = 0 Then add_0_8 = addstr Exit Function End If add_0_8 = addstr For j = 1 To m add_0_8 = "0" & add_0_8 Next End Function '===================================前导零，零位可调=========================== Public Function add_0_N(ByVal addstr As String, ByVal number As String) Dim n, m, j, i As Byte n = Len(addstr) i = number m = i - n If m = 0 Then add_0_N = addstr Exit Function End If add_0_N =