module_main.bas

日本富士仪表PXR的MODBUS通信测试

Attribute VB_Name = "Module_Main"
Option Explicit
    
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public lngX As Long
    Public clsUserPort As New Class_串口异步读写
    Public clsUserData As New Class_操作INI文件
    
    Public dblData04(10, 15) As Double
    Public dblData03(10, 113) As Double
    Public dbl小数系数(10) As Double
    Public str小数格式(10) As String

    Public strInputData As String  '输入数据
    Public intM As Integer
    Public intN As Integer

    Public str连接端口 As String
    Public str传输速率 As String
    Public str校验方式 As String
    Public int通讯地址(10) As Integer
    Public dbl曲线宽度(10) As Double
Sub Main()
    If App.PrevInstance Then '防止程序重复加载
        End
    Else
        clsUserData.INIFileName = App.Path & "\UserData.ini"
        If IIf(Dir(clsUserData.INIFileName) <> "", True, False) = False Then '函数：返回查找的文件是否存在
            clsUserData.WriteIniKey "通讯设置", "连接端口", "1"
            clsUserData.WriteIniKey "通讯设置", "传输速率", "9600"
            clsUserData.WriteIniKey "通讯设置", "校验方式", "E"
            For intM = 1 To 10
                clsUserData.WriteIniKey "通讯地址", "通讯地址" & CStr(intM), CStr(intM)
                clsUserData.WriteIniKey "曲线宽度", "曲线宽度" & CStr(intM), "600"
            Next intM
        End If
        str连接端口 = clsUserData.GetIniKey("通讯设置", "连接端口")
        str传输速率 = clsUserData.GetIniKey("通讯设置", "传输速率")
        str校验方式 = clsUserData.GetIniKey("通讯设置", "校验方式")
        For intM = 1 To 10
            int通讯地址(intM) = Val(clsUserData.GetIniKey("通讯地址", "通讯地址" & CStr(intM)))
            dbl曲线宽度(intM) = Val(clsUserData.GetIniKey("曲线宽度", "曲线宽度" & CStr(intM)))
        Next intM
        Call 打开通讯口
        Form_Logo.Show
    End If
End Sub

Public Sub 打开通讯口()
    lngX = clsUserPort.OpenPort(Val(str连接端口), str传输速率 & "," & str校验方式 & ",8,1", 1024, 512)
    If lngX <> 0 Then
        Call 关闭通讯口
    End If
End Sub

Public Sub 关闭通讯口()
    lngX = clsUserPort.ClosePort
    End
End Sub

Public Sub ReadData(仪表地址 As Integer, 功能指令 As Integer, 参数起始地址 As Integer, 参数连续长度 As Integer)
    lngX = clsUserPort.ClearInBuf
    lngX = clsUserPort.ClearOutBuf
    Dim bytSend(0 To 7) As Byte '发送的数据
    bytSend(0) = int通讯地址(仪表地址)
    bytSend(1) = 功能指令       '读数据命令
    bytSend(2) = 参数起始地址 \ 256
    bytSend(3) = 参数起始地址 Mod 256
    bytSend(4) = 参数连续长度 \ 256
    bytSend(5) = 参数连续长度 Mod 256
    Dim lngSendCrc16 As Long    '发送数据的Crc16校验值
    lngSendCrc16 = &HFFFF&
    For intN = 0 To 5
        lngSendCrc16 = Crc16(CLng(bytSend(intN)), &HA001&, lngSendCrc16)
    Next intN
    bytSend(6) = CByte(lngSendCrc16 And &HFF&)            '校验的高位
    bytSend(7) = CByte(Fix(lngSendCrc16 / 256) And &HFF&) '校验的低位
    clsUserPort.SendData bytSend, 8
    Sleep 200
    
    Dim bytReceive() As Byte    '接收的数据
    ReDim bytReceive(5 - 1 + 2 * 参数连续长度)
    clsUserPort.ReadData bytReceive, 5 + 2 * 参数连续长度, 1000
    
    Dim lngReceiveCrc16 As Long '接收数据的Crc16校验值
    lngReceiveCrc16 = &HFFFF&
    For intN = 0 To (UBound(bytReceive) - 2)
        lngReceiveCrc16 = Crc16(CLng(bytReceive(intN)), &HA001&, lngReceiveCrc16)
    Next intN
    Dim bytCrcH As Byte         '接收数据的校验的高位
    Dim bytCrcL As Byte         '接收数据的校验的低位
    bytCrcH = CByte(lngReceiveCrc16 And &HFF&)            '校验的高位
    bytCrcL = CByte(Fix(lngReceiveCrc16 / 256) And &HFF&) '校验的低位
    If bytCrcH = bytReceive(UBound(bytReceive) - 1) And bytCrcL = bytReceive(UBound(bytReceive)) Then '判断接收数据的Crc16校验的正确性
        For intN = 1 To bytSend(5)
            Select Case 功能指令
                Case 3
                    If bytReceive(1 + intN * 2) > 128 Then
                        dblData03(仪表地址, 参数起始地址 - 1000 + intN) = (bytReceive(1 + intN * 2) - 128) * 256 + bytReceive(2 + intN * 2) - 32768
                    Else
                        dblData03(仪表地址, 参数起始地址 - 1000 + intN) = bytReceive(1 + intN * 2) * 256 + bytReceive(2 + intN * 2)
                    End If
                Case 4
                    If bytReceive(1 + intN * 2) > 128 Then
                        dblData04(仪表地址, 参数起始地址 - 1000 + intN) = (bytReceive(1 + intN * 2) - 128) * 256 + bytReceive(2 + intN * 2) - 32768
                    Else
                        dblData04(仪表地址, 参数起始地址 - 1000 + intN) = bytReceive(1 + intN * 2) * 256 + bytReceive(2 + intN * 2)
                    End If
            End Select
        Next intN
    End If
End Sub

Public Sub WriteData(仪表地址 As Integer, 功能指令 As Integer, 参数地址 As Integer, 参数数值 As String)
    lngX = clsUserPort.ClearInBuf
    lngX = clsUserPort.ClearOutBuf
    Dim bytSend(0 To 7) As Byte '发送的数据
    bytSend(0) = int通讯地址(仪表地址)
    bytSend(1) = 功能指令 '写数据命令
    bytSend(2) = 参数地址 \ 256
    bytSend(3) = 参数地址 Mod 256
    If Val(参数数值) < 0 Then
        bytSend(4) = CLng("&H" & Left(Right("0000" & Hex(65536 + Val(参数数值)), 4), 2))
        bytSend(5) = CLng("&H" & Right(Right("0000" & Hex(65536 + Val(参数数值)), 4), 2))
    Else
        bytSend(4) = CLng("&H" & Left(Right("0000" & Hex(Val(参数数值)), 4), 2))
        bytSend(5) = CLng("&H" & Right(Right("0000" & Hex(Val(参数数值)), 4), 2))
    End If
    
    Dim lngSendCrc16 As Long '发送数据的Crc16校验
    lngSendCrc16 = &HFFFF&
    Dim intN As Integer
    For intN = 0 To 5
        lngSendCrc16 = Crc16(CLng(bytSend(intN)), &HA001&, lngSendCrc16)
    Next intN
    bytSend(6) = CByte(lngSendCrc16 And &HFF&)            '校验的高位
    bytSend(7) = CByte(Fix(lngSendCrc16 / 256) And &HFF&) '校验的低位
    clsUserPort.SendData bytSend, 8
End Sub
'Crc16校验函数
Public Function Crc16(ByVal Data As Long, ByVal Genpoly As Long, ByVal CrcData As Long) As Long
    Data = Data * 2
    Dim intN As Integer
    For intN = 8 To 1 Step -1
        Data = Fix(Data / 2)
        If ((Data Xor CrcData) And 1) Then
            CrcData = Fix(CrcData / 2) Xor Genpoly
        Else
            CrcData = Fix(CrcData / 2)
        End If
    Next intN
    Crc16 = CrcData
End Function