srcom.bas

VB实现的工控智能仪表编程,通讯控制,支持日本岛电Sr93,FP21,SR73,欧陆818,等仪表的通讯

Attribute VB_Name = "SRcom"

Function Sr93(Sr93_Add As String, Sr93_Comm As String, Sr93_Data As String) As String
    If Len(Sr93_Add) = 1 Then
        temp = "0" & Sr93_Add & "1"
    Else
        temp = Sr93_Add & "1"
    End If
    If Len(Sr93_Data) > 0 Then
        If Val(Sr93_Data) < 0 Then
            Sr93_Data = Hex(65536 + Val(Sr93_Data))
        Else
            Sr93_Data = Hex(Val(Sr93_Data))
        End If
        For i = Len(Sr93_Data) To 3
            Sr93_Data = "0" & Sr93_Data
        Next
        comm = Chr$(2) + temp & Sr93_Comm & "," & Sr93_Data + Chr$(3)
    Else
        comm = Chr$(2) + temp & Sr93_Comm + Chr$(3)
    End If
    bcc = 0
    For i = 1 To Len(comm)
        bcc = bcc + Asc(Mid(comm, i, 1))
    Next
    bcc = bcc Mod 256
    If bcc < 16 Then
        bcc = "0" & Hex(bcc)
    Else
        bcc = Hex(bcc)
    End If
    Sr93_Data = ""
    Sr93 = comm + bcc + Chr$(13)
End Function

Function Eur818(Eur818_Add As String, Eur818_Comm As String, Eur818_Data As String) As String
    If Eur818_Add < 10 Then
        temp = "00" + Eur818_Add + Eur818_Add
    Else
        temp = Mid(Eur818_Add, 1, 1) + Mid(Eur818_Add, 1, 1) + Mid(Eur818_Add, 2, 1) + Mid(Eur818_Add, 2, 1)
    End If
    If Len(Eur818_Data) = 0 Then
        Eur818 = Chr(4) + temp + Eur818_Comm + Chr(5)
    Else
        Eur818_Data = Format(Eur818_Data, "0.0")
        If Len(Eur818_Data) > 5 Then
            Eur818_Data = Mid(Eur818_Data, 1, 5)
        End If
        For i = Len(Eur818_Data) To 4
            Eur818_Data = Eur818_Data & "0"
        Next
        comm = Eur818_Comm + Eur818_Data + Chr(3)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc Xor Asc(Mid(comm, i, 1))
        Next
        bcc = Chr(bcc)
        Eur818 = Chr(4) + temp + Chr(2) + comm + bcc
    End If
End Function

Function Eur903(Eur903_Add As String, Eur903_Comm As String, Eur903_Data As String) As String
    If Eur903_Add < 10 Then
        temp = "00" + Eur903_Add + Eur903_Add
    Else
        temp = Mid(Eur903_Add, 1, 1) + Mid(Eur903_Add, 1, 1) + Mid(Eur903_Add, 2, 1) + Mid(Eur903_Add, 2, 1)
    End If
    If Len(Eur903_Data) = 0 Then
        Eur903 = Chr(4) + temp + Eur903_Comm + Chr(5)
    Else
        Eur903_Data = Format(Eur903_Data, "0.0")
        If Len(Eur903_Data) > 5 Then
            Eur903_Data = Mid(Eur903_Data, 1, 5)
        End If
        For i = Len(Eur903_Data) To 4
            Eur903_Data = Eur903_Data & "0"
        Next
        comm = Eur903_Comm + Eur903_Data + Chr(3)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc Xor Asc(Mid(comm, i, 1))
        Next
        bcc = Chr(bcc)
        Eur903 = Chr(4) + temp + Chr(2) + comm + bcc
    End If
End Function

Function I7018(I7018_Comm As String, I7018_Add As String, I7018_Value As String) As String
    If Len(I7018_Add) = 1 Then
        temp = I7018_Comm + "0" + I7018_Add + I7018_Value
    Else
        temp = I7018_Comm + I7018_Add + I7018_Value
    End If
    bcc = 0
    For i = 1 To Len(temp)
        bcc = bcc + Asc(Mid(temp, i, 1))
    Next
    bcc = bcc Mod 256
    If bcc < 16 Then
        bcc = "0" & Hex(bcc)
    Else
        bcc = Hex(bcc)
    End If
    I7018 = temp + bcc + Chr(13)
End Function

Function Fp21()
    
End Function
Function Eur2604()

End Function

Function SR73(Sr73_Add As String, Sr73_Comm As String, Sr73_Data As String) As String
    If Len(Sr73_Add) = 1 Then
        temp = "0" & Sr73_Add
    Else
        temp = Sr73_Add
    End If
    If Len(Sr73_Data) > 0 Then
        If Val(Sr73_Data) >= 0 Then
            For i = 4 To Len(Sr73_Data) Step -1
               Sr73_Data = "0" + Sr73_Data
            Next
            Sr73_Data = "+" & Sr73_Data
        Else
            Sr73_Data = Mid(Sr73_Data, 2)
            For i = 4 To Len(Sr73_Data) Step -1
               Sr73_Data = "0" + Sr73_Data
            Next
            Sr73_Data = "-" & Sr73_Data
        End If
        comm = temp & Sr73_Comm & Sr73_Data + ":"
    Else
        comm = temp & Sr73_Comm + ":"
    End If
    bcc = 0
    For i = 1 To Len(comm)
        bcc = bcc Xor Asc(Mid(comm, i, 1))
    Next
    If bcc < 16 Then
        bcc = "0" & Hex(bcc)
    Else
        bcc = Hex(bcc)
    End If
    SR73 = "@" + comm + bcc + Chr$(13)
    Sr73_Data = ""
End Function

Function Eur818bcc(Eur818bcc_Str) As Boolean
    If Len(Eur818bcc_Str) > 1 Then
        comm = Mid(Eur818bcc_Str, 2, Len(Eur818bcc_Str) - 2)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc Xor Asc(Mid(comm, i, 1))
        Next
        bcc = Chr(bcc)
        If bcc = Right(Eur818bcc_Str, 1) Then
            Eur818bcc = True
        Else
            Eur818bcc = False
        End If
    Else
        Eur818bcc = False
    End If
End Function
Function Eur903bcc(Eur903bcc_Str) As Boolean
    If Len(Eur903bcc_Str) > 1 Then
        comm = Mid(Eur903bcc_Str, 2, Len(Eur903bcc_Str) - 2)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc Xor Asc(Mid(comm, i, 1))
        Next
        bcc = Chr(bcc)
        If bcc = Right(Eur903bcc_Str, 1) Then
            Eur903bcc = True
        Else
            Eur903bcc = False
        End If
    Else
        Eur903bcc = False
    End If
End Function

Function I7018bcc(I7018bcc_Str) As Boolean
    If Len(I7018bcc_Str) > 2 Then
        comm = Mid(I7018bcc_Str, 1, Len(I7018bcc_Str) - 3)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc + Asc(Mid(comm, i, 1))
        Next
        bcc = bcc Mod 256
        If bcc < 16 Then
            bcc = "0" & Hex(bcc)
        Else
            bcc = Hex(bcc)
        End If
        If bcc = Left(Right(I7018bcc_Str, 3), 2) Then
            I7018bcc = True
        Else
            I7018bcc = False
        End If
    Else
        I7018bcc = False
    End If
End Function

Function SR73bcc(SR73bcc_Str) As Boolean
    If Len(SR73bcc_Str) > 3 Then
        comm = Mid(SR73bcc_Str, 2, Len(SR73bcc_Str) - 4)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc Xor Asc(Mid(comm, i, 1))
        Next
        bcc = bcc Mod 256
        If bcc < 16 Then
            bcc = "0" & Hex(bcc)
        Else
            bcc = Hex(bcc)
        End If
        If bcc = Left(Right(SR73bcc_Str, 3), 2) Then
            SR73bcc = True
        Else
            SR73bcc = False
        End If
    Else
        SR73bcc = False
    End If
End Function

Function SR93bcc(SR93bcc_Str) As Boolean
    If Len(SR93bcc_Str) > 2 Then
        comm = Mid(SR93bcc_Str, 1, Len(SR93bcc_Str) - 3)
        bcc = 0
        For i = 1 To Len(comm)
            bcc = bcc + Asc(Mid(comm, i, 1))
        Next
        bcc = bcc Mod 256
        If bcc < 16 Then
            bcc = "0" & Hex(bcc)
        Else
            bcc = Hex(bcc)
        End If
        If bcc = Left(Right(SR93bcc_Str, 3), 2) Then
            SR93bcc = True
        Else
            SR93bcc = False
        End If
    Else
        SR93bcc = False
    End If
End Function