complc.bas

三菱PLC上位机程序详细例子

Attribute VB_Name = "ComPlc"

Private Declare Function GetTickCount Lib "kernel32" () As Long
    '*  函数目的  :  得到本记算机，从开机到现在的毫秒数
    
    
Public Function OpenPort(ByRef ComPort As Object, ByVal ComPortNum As Integer) As Boolean
    '*  函数目的  :  对PLC操作前调用本接口一次，对串口进行初始化与打开工作
    '*  参数意义  :  ComPort - 用来与PLC通信的串口对象
    '*              ComPortNum - 串口号
   
    '*  函数返回  :  OpenPort = True - 串口初始化成功
    '*              OpenPort = False - 串口初始化失败
    On Error GoTo 0
    
    OpenPort = False
    
    If ComPort.PortOpen = True Then ComPort.PortOpen = False
    
    ComPort.CommPort = ComPortNum
    ComPort.Settings = "9600,e,7,1"
    ComPort.InputMode = 1
    ComPort.PortOpen = True
    OpenPort = True
    
End Function


Public Function ClosePort(ByRef ComPort As Object) As Boolean
    '*  函数目的  :  关闭与PLC相连的串口
    '*  参数意义  :  ComPort - 用来与PLC通信的串口对象
   
    '*  函数返回  :  ClosePort = True - 串口关闭成功
    '*              ClosePort = False - 串口关闭失败
    On Error GoTo 0
    
    ClosePort = False
    ComPort.PortOpen = False
    ClosePort = True
    
End Function


Public Function BR(ByRef ComPort As Object, ByVal P_站号 As Integer, ByVal P_延时 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer) As Double
    '*  函数目的  :  得到一个由位软元件组成的二进制数相等的Double型的数据 （此二进制数从 "P_软元件编号" 开始到 "P_软元件个数" 结束)
    
    '*  参数意义  :  ComPort - 用来与PLC通信的串口对象
    '*           :  P_站号 - PLC地址
    '*           :  P_延时 - 0
    '*           :  P_软元件类型 - "X""Y""M"(大写的字符串)
    '*           :  P_软元件编号 - 想要取得的，位软元件的起始地址
    '*           :  P_软元件个数 - 想要取得的，位软元件的个数
   
    '*  函数返回  :  BR = 返回一个Double型的数据
    
    '*收信息前有一段时间的延时，此延时不小于25Ms
    Dim BYTEN() As Byte
    Dim NumS As String
    Dim i As Integer '循环变量
    Dim V As Double '临时变量
    
    ComPort.InBufferCount = 0
    NumS = BR_ENG(P_站号, P_延时, P_软元件类型, P_软元件编号, P_软元件个数)
    ComPort.Output = NumS
    
    Dim j, k As Long
    j = GetTickCount()
    Do
        DoEvents
        k = GetTickCount()
    Loop Until k - j >= 50 'ComPort.InBufferCount >= 8 + P_软元件个数
    
    If ComPort.InBufferCount >= 8 + P_软元件个数 Then
        BYTEN = ComPort.Input
        V = 0 '
        
        For i = (5 + P_软元件个数 - 1) To 5 Step -1
            V = V * 2 + (BYTEN(i) - 48) '求所有数的十进制
        Next
        
        BR = V
        
    Else
        ComPort.InBufferCount = 0
    End If
    
    NumS = ACK(P_站号)
    ComPort.Output = NumS
    
End Function


Private Function BR_ENG(ByVal P_站号 As Integer, ByVal P_延时 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer) As String
    '*  函数目的  :  根据参数组成一个命令，此命令使PLC返回一个从 "P_软元件编号" 开始到 "P_软元件个数" 结束二进制数
    
    '*  参数意义  :  P_站号 - PLC地址
    '*              P_延时 - 0
    '*              P_软元件类型 - "X""Y""M"(大写的字符串)
    '*              P_软元件编号 - 想要取得的，位软元件的起始地址
    '*              P_软元件个数 - 想要取得的，位软元件的个数
   
    '*  函数返回  :  BR_ENG = 返回一个String型的命令串
    
    '*本函数只用于BR
    
    Dim vp_站号, vP_值, vP_元件个数, NumS As String
    
    vp_站号 = IIf(P_站号 >= 0 And P_站号 < 16, "0" + Hex$(P_站号), "00")
    vp_延时 = Right("00" & Hex(P_延时), 1)
    vP_元件个数 = Right("00" & Hex(P_软元件个数), 2)
    NumS = vp_站号 & "FFBR" & vp_延时 & P_软元件类型 & Right("00000" & Right(Str(P_软元件编号), 1), 5 - Len(P_软元件类型)) & vP_元件个数
    BR_ENG = Chr(5) + NumS + Sun(NumS)
    
End Function


Public Sub BW(ByRef ComPort As Object, ByVal P_站号 As Integer, ByVal P_延时 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer, ByVal P_值 As Double)
    '*  函数目的  :  把"P_值"的二进制数形式设置从 "P_软元件编号" 开始到 "P_软元件个数" 结束的位软元件状态。
    
    '*  参数意义  :  ComPort - 用来与PLC通信的串口对象
    '*              P_站号 - PLC地址
    '*              P_延时 - 0
    '*              P_软元件类型 - "X""Y""M"(大写的字符串)
    '*              P_软元件编号 - 想要取得的，位软元件的起始地址
    '*              P_软元件个数 - 想要取得的，位软元件的个数
    '*              P_值 -  十进制整数
    
    '*收信息前有一段时间的延时，此延时不小于25Ms
    Dim BYTEN() As Byte
    Dim NumS As String
    
    ComPort.InBufferCount = 0
    NumS = BW_ENG(P_站号, P_延时, P_软元件类型, P_软元件编号, P_软元件个数, P_值)
    ComPort.Output = NumS

End Sub
Private Function BW_ENG(ByVal P_站号 As Integer, ByVal P_延时 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer, ByVal P_值 As Double) As String
    '*  函数目的  :  根据参数组成一个命令，此命令使PLC设置从 "P_软元件编号" 开始到 "P_软元件个数" 结束位软元件
    
    '*  参数意义  :  P_站号 - PLC地址
    '*              P_延时 - 0
    '*              P_软元件类型 - "X""Y""M"(大写的字符串)
    '*              P_软元件编号 - 想要取得的，位软元件的起始地址
    '*              P_软元件个数 - 想要取得的，位软元件的个数
    '*              P_值 -  十进制整数
    '*  函数返回  :  BW_ENG = 返回一个String型的命令串
    
    '*本函数只用于BW
    
    Dim vp_站号, vP_值, vP_元件个数, NumS As String
    
    vp_站号 = IIf(P_站号 >= 0 And P_站号 < 16, "0" + Hex$(P_站号), "00")
    vp_延时 = Right("00" & Hex(P_延时), 1)
    vP_元件个数 = Right("00" & Hex(P_软元件个数), 2)
    NumS = vp_站号 & "FFBW" & vp_延时 & P_软元件类型 & Right("00000" & Right(Str(P_软元件编号), 1), 5 - Len(P_软元件类型)) & vP_元件个数 & DeTo2(P_值, P_软元件个数)
    BW_ENG = Chr(5) & NumS & Sun(NumS)
    
End Function

Public Function WW(ByRef ComPort As Object, ByVal P_站号 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer, ByRef P_结果数组() As Double) As String
    
    Dim BYTEN() As Byte
    Dim NumS As String
    
    ComPort.InBufferCount = 0
    NumS = WW_ENG(P_站号, P_软元件类型, P_软元件编号, P_软元件个数, P_结果数组)
    ComPort.Output = NumS
    
End Function

Private Function WW_ENG(ByVal P_站号 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer, ByRef P_结果数组() As Double) As String
    
    Dim vp_站号, vP_值, NumS, vP_值Str As String
    
    vp_站号 = IIf(P_站号 >= 0 And P_站号 < 16, "0" + Hex$(P_站号), "00")
    vP_个数 = Right("00" & Hex(P_软元件个数), 2)
    For i = 1 To P_软元件个数
        vP_值 = Right("0000" & Hex$(P_结果数组(i)), 4)
        vP_值Str = vP_值Str + vP_值
    Next
    
    NumS = vp_站号 & "FFWW0" & P_软元件类型 & Right("00000" & Right(Str(P_软元件编号), 1), 5 - Len(P_软元件类型)) & vP_个数 & vP_值Str
    WW_ENG = Chr(5) + NumS + Sun(NumS)
    
End Function

Public Sub WR(ByRef ComPort As Object, ByVal P_站号 As Integer, ByVal P_延时 As Integer, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_软元件个数 As Integer, ByRef P_结果数组() As Double)
    
    Dim BYTEN() As Byte
    Dim NumS As String
    Dim H1, H16, H256, H4096 As Double
    Dim SZ(60)
    Dim j As Integer
    
    ComPort.InBufferCount = 0
    NumS = WR_ENG(P_站号, P_延时, P_软元件类型, P_软元件编号, P_软元件个数)
    ComPort.Output = NumS
    
    i = GetTickCount()
    Do
        DoEvents
    Loop Until GetTickCount() - i > 25 + P_软元件个数 * 5 ' ComPort.InBufferCount >= 8 + P_个数 * 4
    
    If ComPort.InBufferCount >= 8 + P_软元件个数 * 4 Then
        BYTEN = ComPort.Input
        For j = 1 To P_软元件个数
            H4096 = (BYTEN(j * 4 + 1) - IIf(BYTEN(j * 4 + 1) > 64, 55, 48)) * 4096
            H256 = (BYTEN(j * 4 + 2) - IIf(BYTEN(j * 4 + 2) > 64, 55, 48)) * 256
            H16 = (BYTEN(j * 4 + 3) - IIf(BYTEN(j * 4 + 3) > 64, 55, 48)) * 16
            H1 = BYTEN(j * 4 + 4) - IIf(BYTEN(j * 4 + 4) > 64, 55, 48)
            P_结果数组(j) = H1 + H16 + H256 + H4096
        Next
        NumS = ACK(P_站号)
        ComPort.Output = NumS
    Else
        ComPort.InBufferCount = 0
    End If
End Sub

Public Function WR_ENG(ByVal P_站号 As Integer, ByVal P_延时 As String, ByVal P_软元件类型 As String, ByVal P_软元件编号 As Integer, ByVal P_个数 As Integer) As String
    
    Dim vp_站号, vP_值, NumS, vP_个数 As String
    
    vp_站号 = IIf(P_站号 >= 0 And P_站号 < 16, "0" + Hex$(P_站号), "00")
    vp_延时 = Right("00" & Hex(P_延时), 1)
    vP_个数 = Right("00" & Hex(P_个数), 2)
    NumS = vp_站号 & "FFWR" & vp_延时 & P_软元件类型 & Right("00000" & Right(Str(P_软元件编号), 1), 5 - Len(P_软元件类型)) & vP_个数
    WR_ENG = Chr(5) + NumS + Sun(NumS)
    
End Function

Private Function ACK(ByVal P_站号 As Integer) As String
    
    Dim vp_站号, NumS As String
    vp_站号 = IIf(P_站号 >= 0 And P_站号 < 16, "0" + Hex$(P_站号), "00")
    ACK = Chr(5) & vp_站号 & "FF"
    
End Function

Private Function Sun(ByVal Str As String) As String
    '*  函数目的  :  根据参数Str生成一个较验和字符串
    
    Dim i, j As Integer
    For i = 1 To Len(Str)
        j = j + Asc(Mid$(Str, i, 1))
    Next
        Sun = Right("0" + Hex$(j), 2)
        
End Function

Private Function Hex2Dec(InputData As String) As Double
    '*  函数目的  :  把16进制数转换成10进制数.
    '*  参数意义  :  InputData - 16进制数组成的字符串
    '*  函数返回  :  Hex2Dec = 与16进制的InputData相等的10进制数
    
    Dim i As Integer
    Dim DecOut As Double
    Dim Lenhex As Integer
    Dim HexStep As Double
    
    DecOut = 0
    InputData = UCase(InputData)
    Lenhex = Len(InputData)
    For i = 1 To Lenhex
    If IsNumeric(Mid(InputData, i, 1)) Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "A" Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "B" Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "C" Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "D" Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "E" Then
      GoTo NumOk
    ElseIf Mid(InputData, i, 1) = "F" Then
      GoTo NumOk
    Else
      MsgBox "Number given is not in Hex format", vbCritical
      Exit Function
    End If
NumOk:
    Next i
    HexStep = 0
    For i = Lenhex To 1 Step -1
    HexStep = HexStep * 16
    If HexStep = 0 Then
      HexStep = 1
    End If
     If Mid(InputData, i, 1) = "0" Then
       DecOut = DecOut + (0 * HexStep)
     ElseIf Mid(InputData, i, 1) = "1" Then
       DecOut = DecOut + (1 * HexStep)
     ElseIf Mid(InputData, i, 1) = "2" Then
       DecOut = DecOut + (2 * HexStep)
     ElseIf Mid(InputData, i, 1) = "3" Then
       DecOut = DecOut + (3 * HexStep)
     ElseIf Mid(InputData, i, 1) = "4" Then
       DecOut = DecOut + (4 * HexStep)
     ElseIf Mid(InputData, i, 1) = "5" Then
       DecOut = DecOut + (5 * HexStep)
     ElseIf Mid(InputData, i, 1) = "6" Then
       DecOut = DecOut + (6 * HexStep)
     ElseIf Mid(InputData, i, 1) = "7" Then
       DecOut = DecOut + (7 * HexStep)
     ElseIf Mid(InputData, i, 1) = "8" Then
       DecOut = DecOut + (8 * HexStep)
     ElseIf Mid(InputData, i, 1) = "9" Then
       DecOut = DecOut + (9 * HexStep)
     ElseIf Mid(InputData, i, 1) = "A" Then
       DecOut = DecOut + (10 * HexStep)
     ElseIf Mid(InputData, i, 1) = "B" Then
       DecOut = DecOut + (11 * HexStep)
     ElseIf Mid(InputData, i, 1) = "C" Then
       DecOut = DecOut + (12 * HexStep)
     ElseIf Mid(InputData, i, 1) = "D" Then
       DecOut = DecOut + (13 * HexStep)
     ElseIf Mid(InputData, i, 1) = "E" Then
       DecOut = DecOut + (14 * HexStep)
     ElseIf Mid(InputData, i, 1) = "F" Then
       DecOut = DecOut + (15 * HexStep)
     Else
       Exit Function
     End If
    Next i
    Hex2Dec = DecOut
    
End Function
Private Function DeTo2(ByVal P_值 As Double, ByVal P_位数 As Integer) As String '10进制转2进制
    '*  函数目的  :  把10进制数转换成2进制数.
    '*  参数意义  :  P_值 - 要转换的10进制数
    '*              P_位数 - 转换后2进制数长度
    '*  函数返回  :  DeTo2 = 与10进制的P_值相等的2进制数(字符串)
    
    Dim S As String
    
    S = ""
    For i = 0 To P_位数 - 1
        S = S & IIf((P_值 And 2 ^ i) = 2 ^ i, "1", "0")
    Next
    DeTo2 = S
    
End Function