form1.frm

台达PLC通讯测试软件

    ComObj.AddItem "S"
    ComObj.AddItem "Y"
    ComObj.AddItem "M"
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    ComObj.Text = "S"
    Text7.Enabled = False
    Text2.Enabled = True
    End If
    
    If Combo2.Text = "02" Then
    ComObj.AddItem "S"
    ComObj.AddItem "X"
    ComObj.AddItem "Y"
    ComObj.AddItem "M"
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    Label7 = "Read Input Status"
    ComObj.Text = "S"
    Text7.Enabled = False
    Text2.Enabled = True
    End If
    
    If Combo2.Text = "03" Then
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    ComObj.AddItem "D"
    Label7 = "Read Holding Registers"
    ComObj.Text = "T"
    Text7.Enabled = False
    Text2.Enabled = True
    End If
    
    If Combo2.Text = "05" Then
    ComObj.AddItem "S"
    ComObj.AddItem "Y"
    ComObj.AddItem "M"
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    Label7 = "Force Single Coil"
    ComObj.Text = "S"
    Text7.Enabled = True
    Text2.Enabled = False
    End If
    
    If Combo2.Text = "06" Then
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    ComObj.AddItem "D"
    Label7 = "Preset Single Register"
    ComObj.Text = "T"
    Text7.Enabled = True
    End If
    
    If Combo2.Text = "15" Then
    ComObj.AddItem "S"
    ComObj.AddItem "Y"
    ComObj.AddItem "M"
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    Label7 = "Force Muliple Coils"
    ComObj.Text = "S"
    Text2.Enabled = False
    End If
    
    If Combo2.Text = "16" Then
    ComObj.AddItem "T"
    ComObj.AddItem "C"
    ComObj.AddItem "D"
    Label7 = "Report Slave ID"
    ComObj.Text = "T"
    Text2.Enabled = False
    End If
    
End Sub

Private Sub COMM_OnComm()
    Dim i As Integer
    Select Case COMM.CommEvent
        Case comEvReceive
        getstr = COMM.Input
        SendTime = Timer
        If blnTest = True Then
            SendBao = SendBao + 1
            If SendTime - SendTime1 > 1 Then
                SendSpeed = FormatNumber(SendBao / (SendTime - SendTime1), 0)
                SendTime1 = Timer
                SendBao = 0
            End If
            COMM.Output = ":010306000001F5" + Chr(13) + Chr(10)
        End If
    End Select

End Sub
'
Private Sub Command1_Click()
    blnTest = False
    On Error GoTo err
    Dim str_vData As String
    str_Com = Make_Com(Combo2.Text)
    str_Data = Make_Data(Text1)
    If Combo2.Text = "05" Or Combo2.Text = "06" Then
        str_vData = Make_aData(Text7)
        str_Temp = str_Com & str_Data & str_vData
    Else
        str_Temp = str_Com & str_Data & Text2
    End If
    Text4 = "01" & str_Temp
    str_SumData = Chr_lrc(Text4)
    
    Text5 = str_SumData
    Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"

End Sub

Private Sub Command2_Click()
    On Error GoTo err
        str = "00050C30FF00"
        str_out = ":" + str + "C0" + Chr$(13) + Chr$(10)
    
       COMM.Output = str_out
       Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"
End Sub

Private Sub Command3_Click()
    On Error GoTo err
         str = "00050C300000"
        str_out = ":" + str + "BF" + Chr$(13) + Chr$(10)
       COMM.Output = str_out
    Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"
End Sub

Private Sub Command4_Click()
     List1.Clear
End Sub

Function Chr_lrc(str As String) As String 'modbus 协议的数据校验函数,采用求2的补数,方法是求补加1的
'方法,采用如下函数可以进行计算,函数返回值Chr_lrc为返回的校验码
    Dim c As Integer
    Dim l As Integer
    Dim c_data As String
    Dim d_lrc As Long
    Dim h_lrc As Variant
    
    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
    Chr_lrc = h_lrc
End Function
Function Make_Com(str As String) As String
    If CInt(str) <= 15 Then
        Make_Com = "0" & Hex(CInt(str))
    Else
        Make_Com = Hex(CInt(str))
    End If
End Function
Function Make_Data(str As String) As String

    If ComObj.Text = "S" Then
        If str <= 255 Then
            If CInt(Text1) <= 15 Then
                Make_Data = "000" & Hex(CInt(str))
            Else
                Make_Data = "00" & Hex(CInt(str))
            End If
        End If
        If str >= 256 And str <= 511 Then
            If CInt(str - 256) <= 15 Then
                Make_Data = "010" & Hex(CInt(str) - 256)
            Else
                Make_Data = "01" & Hex(CInt(str) - 256)
            End If
        End If
         If str >= 512 And str <= 767 Then
            If CInt(str - 512) <= 15 Then
                Make_Data = "020" & Hex(CInt(str) - 512)
            Else
                Make_Data = "02" & Hex(CInt(str) - 512)
            End If
        End If
         If str >= 768 And str <= 1023 Then
            If CInt(str - 768) <= 15 Then
                Make_Data = "030" & Hex(CInt(str) - 768)
            Else
                Make_Data = "03" & Hex(CInt(str) - 768)
            End If
        End If
        
    End If
    
    If ComObj.Text = "X" Then
        If str <= 15 Then
            Make_Data = "040" & Hex(CInt(str))
        Else
            Make_Data = "04" & Hex(CInt(str))
        End If
    End If
     If ComObj.Text = "Y" Then
        If str <= 15 Then
            Make_Data = "050" & Hex(CInt(str))
        Else
            Make_Data = "05" & Hex(CInt(str))
        End If
    End If
    If ComObj.Text = "T" Then
        If str <= 15 Then
            Make_Data = "060" & Hex(CInt(str))
        Else
            Make_Data = "06" & Hex(CInt(str))
        End If
    End If
    
     If ComObj.Text = "M" Then
        If str <= 255 Then
            If CInt(str) <= 15 Then
                Make_Data = "080" & Hex(CInt(str))
            Else
                Make_Data = "08" & Hex(CInt(str))
            End If
        End If
        If str >= 256 And str <= 511 Then
            If CInt(str - 256) <= 15 Then
                Make_Data = "090" & Hex(CInt(str) - 256)
            Else
                Make_Data = "09" & Hex(CInt(str) - 256)
            End If
        End If
         If str >= 512 And str <= 767 Then
            If CInt(str - 512) <= 15 Then
                Make_Data = "0A0" & Hex(CInt(str) - 512)
            Else
                Make_Data = "0A" & Hex(CInt(str) - 512)
            End If
        End If
         If str >= 768 And str <= 1023 Then
            If CInt(str - 768) <= 15 Then
                Make_Data = "0B0" & Hex(CInt(str) - 768)
            Else
                Make_Data = "0B" & Hex(CInt(str) - 768)
            End If
        End If
         If str >= 1024 And str <= 1279 Then
            If CInt(str - 1024) <= 15 Then
                Make_Data = "0C0" & Hex(CInt(str) - 1024)
            Else
                Make_Data = "0C" & Hex(CInt(str) - 1024)
            End If
        End If
    End If
    
     If ComObj.Text = "C" Then
        If str <= 15 Then
            Make_Data = "0E0" & Hex(CInt(str))
        Else
            Make_Data = "0E" & Hex(CInt(str))
        End If
    End If
    
    If ComObj.Text = "D" Then
        If str <= 255 Then
            If CInt(str) <= 15 Then
                Make_Data = "100" & Hex(CInt(str))
            Else
                Make_Data = "10" & Hex(CInt(str))
            End If
        End If
        If str >= 256 And str <= 511 Then
            If CInt(str - 256) <= 15 Then
                Make_Data = "110" & Hex(CInt(str) - 256)
            Else
                Make_Data = "11" & Hex(CInt(str) - 256)
            End If
        End If
         If str >= 512 And str <= 767 Then
            If CInt(str - 512) <= 15 Then
                Make_Data = "120" & Hex(CInt(str) - 512)
            Else
                Make_Data = "12" & Hex(CInt(str) - 512)
            End If
        End If
         If str >= 768 And str <= 1023 Then
            If CInt(str - 768) <= 15 Then
                Make_Data = "130" & Hex(CInt(str) - 768)
            Else
                Make_Data = "13" & Hex(CInt(str) - 768)
            End If
        End If
         If str >= 1024 And str <= 1279 Then
            If CInt(str - 1024) <= 15 Then
                Make_Data = "140" & Hex(CInt(str) - 1024)
            Else
                Make_Data = "14" & Hex(CInt(str) - 1024)
            End If
        End If
    End If
End Function
Private Sub Command5_Click()
    Dim i As Integer
    On Error GoTo err
    COMM.Output = CStr(Text3) & CStr(Text4) & Text5 + Chr(13) + Chr(10)
    For i = 0 To 50
        Debug.Print i
    Next i
    List_Data
    Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"
  
End Sub

Private Sub Command6_Click()
    On Error GoTo err
    COMM.PortOpen = False
     Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"
End Sub
Private Sub Command8_Click()
    On Error GoTo err
    blnTest = True
    COMM.Output = ":010306000001F5" + Chr(13) + Chr(10)
    SendTime1 = Timer
     Exit Sub
err:
    MsgBox "操作错误!", vbOKOnly, "错误"

End Sub

Private Sub Timer1_Timer()
    
    StatusBar1.Panels(1).Text = "DVP TEST PC---->PLC(V1.0)    Communication rate is " & SendSpeed
    StatusBar1.Panels(2).Text = Time
    
End Sub
Function Make_aData(str As String) As String
    If CInt(str) <= 15 Then
        Make_aData = "000" & Hex(CInt(str))
    End If
    If CInt(str) >= 16 And CInt(str) <= 255 Then
        Make_aData = "00" & Hex(CInt(str))
    End If
    If CInt(str) >= 256 And CInt(str) <= 4095 Then
        Make_aData = "0" & Hex(CInt(str))
    End If
    If CInt(str) >= 4096 And CInt(str) <= 65535 Then
        Make_aData = Hex(CInt(str))
    End If
    
End Function
Function List_Data() As String
     getstr = COMM.Input
      List1.AddItem Trim(getstr) & vbCrLf  '回车换行
End Function