frmfx.frm

FX1N三菱plc与pc通信的一个很好的例子

            CommFX.Output = Chr(5) + DevDat + SumChk(DevDat)
            Tim = Timer
            If DevType = "XYM" Then '监控类型为位元件
                Do
                    If Timer > Tim + 1 Then: GoTo FirstLoop
                Loop Until CommFX.InBufferCount > 8
                SetIn = CommFX.Input
                If Left$(SetIn, 7) = Chr(2) + cboStation.Text + "FF0" + Chr(3) Then
                    SETRST.Caption = "SET"
                ElseIf Left$(SetIn, 7) = Chr(2) + cboStation.Text + "FF1" + Chr(3) Then
                    SETRST.Caption = "RESET"
                Else
                    Text2.Text = "ONLINE ERROR"
                End If
            
            ElseIf DevType = "D" Then '监控类型为单字节D,T,C(16BIT)
                Do
                    If Timer > Tim + 1 Then: GoTo FirstLoop
                Loop Until CommFX.InBufferCount = 12
                SetIn = CommFX.Input
                If OptionD.Value Then
                    DevDData = Val("&H" + Mid(SetIn, 6, 4))
                    Text2.Text = CStr(DevDData)
                Else
                    Text2.Text = Mid(SetIn, 6, 4)
                End If
            ElseIf DevType = "2D" Then '监控类型为双字节D,C(32BIT)
                Do
                    If Timer > Tim + 1 Then: GoTo FirstLoop
                Loop Until CommFX.InBufferCount = 16
                SetIn = CommFX.Input
                If Device = "C" Then
                    DevDataStr = Mid(SetIn, 6, 8)
                Else
                    DevDataStr = Mid(SetIn, 10, 4) + Mid(SetIn, 6, 4)
                End If
                If OptionD.Value Then
                    If Left(DevDataStr, 4) = "0000" And Mid(DevDataStr, 5, 1) <> "0" Then
                        Text2.Text = CStr(Val("&H" + DevDataStr + "0") / 16)
                    Else
                        Text2.Text = CStr(Val("&H" + DevDataStr))
                    End If
                Else
                    Text2.Text = DevDataStr
                End If
            End If
            
            If Device = "C" Or Device = "T" Then '是计数器或计时器线圈
                CommFX.InBufferCount = 0
                CommFX.OutBufferCount = 0
                CommFX.Output = Chr(5) + DevDatTC + SumChk(DevDatTC)
                Tim = Timer
                Do
                    If Timer > Tim + 1 Then: GoTo FirstLoop
                Loop Until CommFX.InBufferCount > 8
                SetIn = CommFX.Input
                If Left$(SetIn, 7) = Chr(2) & cboStation.Text & "FF0" & Chr(3) Then
                    SETRST.Caption = "SET"
                ElseIf Left$(SetIn, 7) = Chr(2) & cboStation.Text & "FF1" & Chr(3) Then
                    SETRST.Caption = "RESET"
                Else
                    Text2.Text = "ONLINE ERROR"
                End If
            End If
        End If
    Loop
End Sub



Private Sub Form_Unload(Cancel As Integer)
    start = False
    blnExit = True
    Set frmfx = Nothing
End Sub


Private Sub fraComm2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "设置连接PLC的通信端口以及PLC的站号(应与D8121相同)"
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "实时监控/设置PLC的XYMTCD设备值"
End Sub

Private Sub OptionD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "数据以十进制方式返回或设置"
End Sub

Private Sub OptionH_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "数据以十六进制方式返回或设置"
End Sub

Private Sub SETRST_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "对位元件(X,Y,M,T,C)线圈置位与复位"
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    SETRST.Enabled = False
    start = False
    fraComm1.Visible = True
    fraComm2.Visible = True
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    char = Chr(KeyAscii)
    setaddr = Text1.Text
    If Len(setaddr) > 1 Then: setad = Right(setaddr, Len(setaddr) - 1)
    KeyAscii = Asc(UCase(char)) '转换为大写
    
    If KeyAscii = 13 Then '按回车键
        Device = Left(setaddr, 1)
        Text1.SelStart = 0
        Text1.SelLength = Len(setaddr)
        Text2.Enabled = True
        If (Device = "X" Or Device = "Y" And Oct(Val("&o" + setad)) = setad And Val(setad) < 178) Or (Device = "M" And CStr(Val(setad)) = setad And (Val(setad) < 1536 Or Val(setad) > 7999 And Val(setad) < 8256)) Then
            DevAdd = Right(("0000" + setad), 4)
            DevDat = cboStation.Text + "FFBR0" + Device + DevAdd + "01"
            DevType = "XYM"
            Text2.Enabled = False
            SETRST.Enabled = True
            start = True
        End If
        If Device = "D" And CStr(Val(setad)) = setad And (Val(setad) < 1000 Or Val(setad) > 7999 And Val(setad) < 8256) Then
            DevAdd = Right(("0000" + setad), 4)
            If Check1.Value = 0 Then
                DevDat = cboStation.Text + "FFWR0" + Device + DevAdd + "01" '使用WR命令读16bit数据
                DevType = "D"
            Else
                DevDat = cboStation.Text + "FFWR0" + Device + DevAdd + "02" '使用WR命令读32bit数据
                DevType = "2D"
            End If
            SETRST.Enabled = False
            start = True
        End If
        If Device = "T" And CStr(Val(setad)) = setad And Val(setad) < 256 Then
            DevAdd = Right(("000" + setad), 3)
            DevDatTC = cboStation.Text + "FFBR0" + Device + "S" + DevAdd + "01" 'T的线圈状态
            DevDat = cboStation.Text + "FFWR0" + Device + "N" + DevAdd + "01" 'T的数据值
            DevType = "D"
            SETRST.Enabled = True
            start = True
        End If
        If Device = "C" And CStr(Val(setad)) = setad And Val(setad) < 256 Then
            DevAdd = Right(("000" + setad), 3)
            DevDatTC = cboStation.Text + "FFBR0" + Device + "S" + DevAdd + "01" 'C的线圈状态
            If Val(setad) > 199 Then
                DevDat = cboStation.Text + "FFWR0" + Device + "N" + DevAdd + "01" 'C200以上的数据值
                DevType = "2D"
            Else
                DevDat = cboStation.Text + "FFWR0" + Device + "N" + DevAdd + "01" 'C200以下的数据值
                DevType = "D"
            End If
            SETRST.Enabled = True
            start = True
        End If
        fraComm1.Visible = False
        fraComm2.Visible = False
    Else
        start = False
        fraComm1.Visible = True
        fraComm2.Visible = True

    End If
End Sub
    
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "输入要监控或设置的地址回车确定，如D0,T10,Y7等"
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
        If KeyCode <> 13 Then
            start = False
        End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    char = Chr(KeyAscii)
    KeyAscii = Asc(UCase(char))
    If Device = "D" And CStr(Val(setad)) = setad And Val(setad) < 1000 Then
        start = False
    End If
    If (Device = "T" Or Device = "C") And CStr(Val(setad)) = setad And Val(setad) < 256 Then
        start = False
    End If
    If KeyAscii = 13 Then
      If Val(DevAdd) > 7999 Then
         If MsgBox("改变系统参数可能对系统造成破坏，是否写入？", vbOKCancel + vbCritical) = vbCancel Then Exit Sub
      ElseIf MsgBox("改变当前值可能对运行造成危险，是否写入？", vbOKCancel + vbExclamation) = vbCancel Then Exit Sub
      End If
            If Device = "D" And Check1.Value = 0 Then
                DevAdd = Right(("0000" + setad), 4)
            ElseIf Device = "D" And Check1.Value = 1 Then
                DevAdd = Right(("0000" + setad), 4)
            Else
                DevAdd = Right(("000" + setad), 3)
            End If
            If OptionD.Value Then '十进制方式
                If Device = "C" And Val(setad) > 199 Then 'C200以上写入
                    If Val(Text2.Text) > 2847483647# Then: GoTo this
                    DevDat1 = cboStation.Text + "FFWW0" + Device + "N" + DevAdd + "01" + Right("00000000" + Hex(Val(Text2.Text)), 8)
                ElseIf Device = "D" And Check1.Value = 1 Then '双字节D写入
                    If Val(Text2.Text) > 2847483647# Then: GoTo this
                    DevDat1 = Right("00000000" + Hex(Val(Text2.Text)), 8)
                    DevDat1 = Right(DevDat1, 4) + Left(DevDat1, 4)
                    DevDat1 = cboStation.Text + "FFWW0" + Device + DevAdd + "02" + DevDat1
                Else
                    If Val(Text2.Text) > 32767 Then: GoTo this
                    If Device = "D" Then '单字节D写入
                        DevDat1 = cboStation.Text + "FFWW0" + Device + DevAdd + "01" + Right("0000" + Hex(Val(Text2.Text)), 4)
                    Else 'C200以下写入
                        DevDat1 = cboStation.Text + "FFWW0" + Device + "N" + DevAdd + "01" + Right("0000" + Hex(Val(Text2.Text)), 4)
                    End If
                End If
            Else '十六进制方式
                If Device = "C" And Val(setad) > 199 Then 'C200以上写入
                    If Val("&H" + Text2.Text) > 2847483647# Then: GoTo this
                    DevDat1 = cboStation.Text + "FFWW0" + Device + "N" + DevAdd + "01" + Right("00000000" + Text2.Text, 8)
                ElseIf Device = "D" And Check1.Value = 1 Then '双字节D写入
                    If Val("&H" + Text2.Text) > 2847483647# Then: GoTo this
                    DevDat1 = Right("00000000" + Text2.Text, 8)
                    DevDat1 = Right(DevDat1, 4) + Left(DevDat1, 4)
                    DevDat1 = cboStation.Text + "FFWW0" + Device + DevAdd + "02" + DevDat1
                Else
                    If Val("&H" + Text2.Text) > 32767 Then: GoTo this
                    If Device = "D" Then '单字节D写入
                        DevDat1 = cboStation.Text + "FFWW0" + Device + DevAdd + "01" + Right("0000" + Text2.Text, 4)
                    Else 'C200以下写入
                        DevDat1 = cboStation.Text + "FFWW0" + Device + "N" + DevAdd + "01" + Right("0000" + Text2.Text, 4)
                    End If
                End If
            End If
            
            CommFX.Output = Chr(5) + DevDat1 + SumChk(DevDat1)
            Tim = Timer
            Do
                If Timer > Tim + 1 Then: Exit Do
            Loop Until CommFX.InBufferCount = 5
this:
            start = True
            Exit Sub
    Else
        start = False
    End If
    If Not (KeyAscii = 8) And (KeyAscii > 57 Or KeyAscii < 48) Then: KeyAscii = 0
End Sub


'位元件置位或者复位
Private Sub SETRST_Click()
    If Val(DevAdd) > 7999 Then 'M8000以上是重要系统参数，小心！
        If MsgBox("改变系统参数可能对系统造成破坏，是否写入？", vbOKCancel + vbCritical) = vbCancel Then Exit Sub
    ElseIf MsgBox("改变当前值可能对运行造成危险，是否写入？", vbOKCancel + vbExclamation) = vbCancel Then Exit Sub
    End If
    If start Then
        start = False
        CommFX.OutBufferCount = 0
        CommFX.InBufferCount = 0
        If (Device = "T" Or Device = "C") And SETRST.Caption = "SET" Then
             DevDat1 = cboStation.Text + "FFBW0" + Device + "S" + DevAdd + "011"
        ElseIf (Device = "T" Or Device = "C") And SETRST.Caption = "RESET" Then
            DevDat1 = cboStation.Text + "FFBW0" + Device + "S" + DevAdd + "010"
        ElseIf DevType = "XYM" And SETRST.Caption = "SET" Then
            DevDat1 = cboStation.Text + "FFBW0" + Device + DevAdd + "011"
        ElseIf DevType = "XYM" And SETRST.Caption = "RESET" Then
            DevDat1 = cboStation.Text + "FFBW0" + Device + DevAdd + "010"
        End If
        CommFX.Output = Chr(5) + DevDat1 + SumChk(DevDat1)
        Tim = Timer
        Do
            If Timer > Tim + 1 Then: Exit Do
        Loop Until CommFX.InBufferCount = 5
        start = True
    End If
End Sub


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub CommOpen()
    If CommFX.PortOpen = False Then
        CommFX.PortOpen = True
    End If
End Sub


Private Sub CommClose()
    If CommFX.PortOpen = True Then
        CommFX.PortOpen = False
    End If
End Sub


'设置电脑通信参数
Private Sub CommSet()
    On Error GoTo err1
    If CommFX.PortOpen = True Then
        CommFX.PortOpen = False
    End If
    If Not CommFX.PortOpen Then
        CommFX.CommPort = cboPort.ListIndex + 1 '通信口
        CommFX.Settings = "9600,N,8,1" '固定值即可
        CommFX.Handshaking = 0
        CommFX.InputLen = 0
        CommFX.OutBufferCount = 0
        CommFX.InBufferCount = 0
        CommFX.PortOpen = True
    End If
    Exit Sub
err1:
    MsgBox Err.Description
End Sub

Private Function SumChk(Dats$) As String
    Dim i&
    Dim CHK&
    For i = 1 To Len(Dats)
        CHK = CHK + Asc(Mid(Dats, i, 1))
    Next i
    'SumChk = Right(Hex$(CHK + 3), 2)
    SumChk = Right(Hex$(CHK), 2)
End Function

Private Sub Text2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        lblTopic = "实时显示监控到的数据，或改变数据后回车确定"
End Sub