Attribute VB_Name = "ProtocoleModbus"
Option Explicit
' Module d'encodage et vérification des trames modbus
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)




Public Function ProtocoleModbusCreateHeaderReadFrame(Slave As Byte, Fonction As Byte, Adresse As Long, Qte As Integer, TblByte() As Byte) As Integer
' Création d'une trame modbus
' pour fonction 1,2,3,4
' Retourne la longueur de la trame encodée
Select Case Fonction
    Case 1, 2, 3, 4     ' Lectures n bits et n mots
    TblByte(0) = Slave
    TblByte(1) = Fonction
    TblByte(2) = CByte((Adresse And &HFF00&) / &H100)
    TblByte(3) = CByte(Adresse And &HFF)
    TblByte(4) = CByte((Qte And &HFF00&) / &H100)
    TblByte(5) = CByte(Qte And &HFF)
    ProtocoleModbusCreateHeaderReadFrame = 6
    
    
    Case Else
    ProtocoleModbusCreateHeaderReadFrame = 0
End Select



End Function

Public Function TranslateBinaryToHexaAscii(TblByte() As Byte, Optional ByVal pSize As Integer = -1) As String
' converti une table d'octet en une chaine de caractere representant la valeur
' des octets en héxa décimal
Dim Txt As String
Dim i As Integer

Txt = ""

If pSize = -1 Then pSize = UBound(TblByte)

For i = 0 To pSize
    Txt = Txt + Right$("0" + Hex(TblByte(i)), 2) + " "
Next i
TranslateBinaryToHexaAscii = Txt
End Function

Public Function ProtocoleModbusBuildAndAddCRC16(TblByte() As Byte, Size As Integer) As Integer
' Calcul le CRC16 d'une Trame
' Size est la taille de la trame incluant le 2 octets de CRC16
' La longueur est la longueur compléte de la trame (incluant la taille pour le CRC 16)
Dim j As Integer
Dim Crc As Long
Dim CRC16 As Long
Dim n As Integer
Dim Retenue As Boolean

Crc = &HFFFF&
For j = 0 To (Size - 2)
    Crc = Crc Xor CLng(TblByte(j))
    n = 0
    Do
        Retenue = False
        If (Crc Mod &H2&) <> 0 Then
            Retenue = True
        End If
        Crc = Fix(Crc / 2)
        If Retenue = True Then
            Crc = Crc Xor &HA001&
        End If
        n = n + 1
    Loop While (n <= 7)
Next j

' Invertion du CRC 16 calculé
CRC16 = (Crc And &HFF00&) / &H100
CRC16 = CRC16 + ((Crc And &HFF&) * &H100&)

TblByte(Size) = (Crc And &HFF00&) / &H100
TblByte(Size - 1) = (Crc And &HFF&)

ProtocoleModbusBuildAndAddCRC16 = Size


End Function

Public Function ProtocoleModbusIsAnswerStructOk(TblByte() As Byte, Size As Integer, Esclave As Byte, Fonction As Byte) As Integer
' Vérifie une reponse Modbus
' On passe en parametre
' La trame
' La longueur
' Le numéro d'esclave attendu
' Le code fonction attendu
' Retourne :
' 0 : OK
' -1 : Erreur CRC 16
' -2 : Err Esclave
' -3 : Erreur fonction
' -4 : Erreur Longueur


' Calcul du CRC16
Dim j As Integer
Dim Crc As Long
Dim CRC16 As Long
Dim n As Integer
Dim Retenue As Boolean


ProtocoleModbusIsAnswerStructOk = 0

Crc = &HFFFF&
For j = 0 To (Size - 3)
    Crc = Crc Xor CLng(TblByte(j))
    n = 0
    Do
        Retenue = False
        If (Crc Mod &H2&) <> 0 Then
            Retenue = True
        End If
        Crc = Fix(Crc / 2)
        If Retenue = True Then
            Crc = Crc Xor &HA001&
        End If
        n = n + 1
    Loop While (n <= 7)
Next j

' Invertion du CRC 16 calculé
CRC16 = (Crc And &HFF00&) / &H100
CRC16 = CRC16 + ((Crc And &HFF&) * &H100&)

If (TblByte(Size - 1) <> ((Crc And &HFF00&) / &H100)) Or (TblByte(Size - 2) <> (Crc And &HFF&)) Then
    ProtocoleModbusIsAnswerStructOk = -1
    Exit Function
End If

If TblByte(0) <> CByte(Esclave) Then
    ProtocoleModbusIsAnswerStructOk = -2
    Exit Function
End If
If TblByte(1) <> CByte(Fonction) Then
    ProtocoleModbusIsAnswerStructOk = -3
    Exit Function
End If
If (Fonction <> 5) And (Fonction <> 6) And (Fonction <> 15) And (Fonction <> 16) Then
    If TblByte(2) <> (Size - 5) Then
        ProtocoleModbusIsAnswerStructOk = -4
        Exit Function
    End If
End If

End Function

Public Function ProtocoleModbusCreateHeaderWriteFrame(Slave As Byte, Fonction As Byte, Adresse As _
    Long, Qte As Integer, TblByte() As Byte) As Integer
' Création d'une trame modbus
' pour fonction 16
' Retourne la longueur de la trame encodée
Select Case Fonction
    Case 5
    TblByte(0) = Slave
    TblByte(1) = Fonction
    TblByte(2) = CByte((Adresse And &HFF00&) / &H100)
    TblByte(3) = CByte(Adresse And &HFF)
    ProtocoleModbusCreateHeaderWriteFrame = 8
    
    Case 16
    TblByte(0) = Slave
    TblByte(1) = Fonction
    TblByte(2) = CByte((Adresse And &HFF00&) / &H100)
    TblByte(3) = CByte(Adresse And &HFF)
    TblByte(4) = CByte((Qte And &HFF00&) / &H100)
    TblByte(5) = CByte(Qte And &HFF)
    TblByte(6) = CByte(Qte * 2)
    ProtocoleModbusCreateHeaderWriteFrame = (Qte * 2) + 9
    
    
    Case Else
    ProtocoleModbusCreateHeaderWriteFrame = 0
End Select



End Function


Public Function ProtocoleModbusExtractWord(TblByte() As Byte, WordNumber As Integer) As Long
' Extrait un mot (16 bits non signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
Xpos = ((WordNumber - 1) * 2) + 3
If Xpos < UBound(TblByte) Then
    LongValue = CLng(TblByte(Xpos)) * &H100
    LongValue = LongValue + CLng(TblByte(Xpos + 1))
Else
    LongValue = 0
End If
ProtocoleModbusExtractWord = LongValue

End Function

Public Function ProtocoleModbusExtractInteger(TblByte() As Byte, WordNumber As Integer) As Integer
' Extrait un entier(16 bits signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
'Dim IntegerValue As Integer
Xpos = ((WordNumber - 1) * 2) + 3
LongValue = CLng(TblByte(Xpos)) * &H100
LongValue = LongValue + CLng(TblByte(Xpos + 1))
If LongValue > 32767 Then
    LongValue = LongValue - 65536
End If

ProtocoleModbusExtractInteger = CInt(LongValue)

End Function

Public Function ProtocoleModbusExtractBitOfWord(TblByte() As Byte, WordNumber As Integer, BitNumber As Integer) As Boolean
' Extrait un bit d'un mot
' WordNumber 1 à n
' Bit Number 0 à 15
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
Dim BitValue As Boolean
Dim BitMask As Long
Dim i As Integer
'BitMask = 2 ^ BitNumber
BitMask = 1
For i = 1 To BitNumber
    BitMask = BitMask * 2
Next i
Xpos = ((WordNumber - 1) * 2) + 3
LongValue = CLng(TblByte(Xpos)) * &H100
LongValue = LongValue + CLng(TblByte(Xpos + 1))
' Decodage du Bit
BitValue = IIf((LongValue And BitMask) = BitMask, True, False)
ProtocoleModbusExtractBitOfWord = BitValue

End Function

Public Function ProtocoleModbusExtractLowByteOfWord(TblByte() As Byte, WordNumber As Integer) As Byte
' Extrait l'octet de poids faible d'un mot
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 3
ProtocoleModbusExtractLowByteOfWord = TblByte(Xpos + 1)

End Function

Public Function ProtocoleModbusExtractHighByteOfWord(TblByte() As Byte, WordNumber As Integer) As Byte
' Extrait un entier(16 bits signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 3
ProtocoleModbusExtractHighByteOfWord = TblByte(Xpos)
End Function

Public Function ProtocoleModbusExtractDoubleWord(TblByte() As Byte, WordNumber As Integer) As Long
' Extrait un double mot (32 bits signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
Xpos = ((WordNumber - 1) * 2) + 3
If Xpos <= UBound(TblByte) - 3 Then
    ' Attention au signe
    If TblByte(Xpos) < 128 Then
        LongValue = CLng(TblByte(Xpos)) * &H1000000
        LongValue = LongValue + (CLng(TblByte(Xpos + 1)) * &H10000)
        LongValue = LongValue + (CLng(TblByte(Xpos + 2)) * &H100)
        LongValue = LongValue + CLng(TblByte(Xpos + 3))
    Else
        LongValue = &H80000000
        LongValue = LongValue + (CLng(TblByte(Xpos) And &H7F) * &H1000000)
        LongValue = LongValue + (CLng(TblByte(Xpos + 1)) * &H10000)
        LongValue = LongValue + (CLng(TblByte(Xpos + 2)) * &H100)
        LongValue = LongValue + CLng(TblByte(Xpos + 3))
    End If
Else
    LongValue = 0
End If
ProtocoleModbusExtractDoubleWord = LongValue

End Function

Public Sub ProtocoleModbusSetWord(TblByte() As Byte, WordNumber As Integer, WordValue As Long)
' Met à jour le mot demandé dans la trame
' Le premier mot démarre à la position d'octet 7
' Le second mot est à la position 9 etc
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 7
TblByte(Xpos) = CByte((WordValue And &HFF00&) / &H100)
TblByte(Xpos + 1) = CByte(WordValue And &HFF&)
End Sub

Public Sub ProtocoleModbusSetInteger(TblByte() As Byte, WordNumber As Integer, IntegerValue As Integer)
' Met à jour l'entier demandé dans la trame
' Met à jour le mot demandé dans la trame
' Le premier mot démarre à la position d'octet 7
' Le second mot est à la position 9 etc
Dim Xpos As Integer
Dim LongValue As Long
Xpos = ((WordNumber - 1) * 2) + 7

' Convertion de l'entier en Long
If IntegerValue < 0 Then
    LongValue = CLng(IntegerValue) - 65536
Else
    LongValue = CLng(IntegerValue)
End If
TblByte(Xpos) = CByte((LongValue And &HFF00&) / &H100)
TblByte(Xpos + 1) = CByte(LongValue And &HFF&)
End Sub

Public Sub ProtocoleModbusSetBitOfWord(TblByte() As Byte, WordNumber As Integer, BitNumber As Integer, BitValue As Boolean)
' Positionne un bit dans un mot
' WordNumber 1 à n
' Bit Number 0 à 15
Dim Xpos As Integer
'Dim LongValue As Long
Dim BitMask As Long
Dim i As Integer
Dim x As Integer
'BitMask = 2 ^ BitNumber
BitMask = 1

Xpos = ((WordNumber - 1) * 2) + 7
x = BitNumber
If x > 7 Then
    'Xpos = Xpos + 1
    x = x - 8
Else
    Xpos = Xpos + 1
End If
For i = 1 To x
    BitMask = BitMask * 2
Next i
If BitValue = True Then
    TblByte(Xpos) = TblByte(Xpos) Or CByte(BitMask)
Else
    BitMask = BitMask Xor &HFF
    TblByte(Xpos) = TblByte(Xpos) And BitMask
End If
End Sub

Public Function ProtocoleModbusExtractBit(TblByte() As Byte, BitNumber As Integer) As Boolean
' Extrait un bit d'une requete type 1 ou 2
' BitNumber 1 à n
' Le premier bit démarre à la position d'octet 3
Dim Xpos As Integer
'Dim LongValue As Long
Dim ByteMask As Byte
Dim ModuloBit As Integer
Dim x As Integer
' Calcul de la position du bit dans les octets de données
ModuloBit = (BitNumber - 1) Mod 8
ByteMask = 1
If ModuloBit = 0 Then
    Xpos = Fix((BitNumber - 1) / 8) + 3
Else
    Xpos = Fix((BitNumber - 1) / 8) + 3
    'ByteMask = 2 ^ ModuloBit
    For x = 1 To ModuloBit
        ByteMask = ByteMask * 2
    Next x
End If
If (TblByte(Xpos) And ByteMask) = ByteMask Then
    ProtocoleModbusExtractBit = True
Else
    ProtocoleModbusExtractBit = False
End If
End Function

Public Function ProtocoleModbusIsRequeteStructIsOk(TblByte() As Byte, Size As Integer, Esclave As _
    Integer, Fonction As Integer, Adresse As Long, NbItem As Integer) As Integer
' Vérifie La structure d'une requete modbus
' On passe en parametre
' La trame
' La longueur
' Retourne :
' 0 : OK
' -1 : Erreur CRC 16
' -2 : Erreur Esclave
' -3 : Erreur fonction inconnu
' -4 : Erreur Longueur
' -5 : Erreur Quantite de données

' Met à jour numéro esclave
' Code Fonction
' Adresse
' Nb Bit ou mot


' Calcul du CRC16
Dim j As Integer
Dim Crc As Long
Dim CRC16 As Long
Dim n As Integer
Dim Retenue As Boolean
Dim LongValue As Long

ProtocoleModbusIsRequeteStructIsOk = 0

Crc = &HFFFF&
For j = 0 To (Size - 3)
    Crc = Crc Xor CLng(TblByte(j))
    n = 0
    Do
        Retenue = False
        If (Crc Mod &H2&) <> 0 Then
            Retenue = True
        End If
        Crc = Fix(Crc / 2)
        If Retenue = True Then
            Crc = Crc Xor &HA001&
        End If
        n = n + 1
    Loop While (n <= 7)
Next j

' Invertion du CRC 16 calculé
CRC16 = (Crc And &HFF00&) / &H100
CRC16 = CRC16 + ((Crc And &HFF&) * &H100&)

If (TblByte(Size - 1) <> ((Crc And &HFF00&) / &H100)) Or (TblByte(Size - 2) <> (Crc And &HFF&)) Then
    ' Erreur CRC 16
    ProtocoleModbusIsRequeteStructIsOk = -1
    Exit Function
End If

' Extraction du numéro d'esclave
Esclave = CInt(TblByte(0))
If Esclave = 0 Then
    ProtocoleModbusIsRequeteStructIsOk = -2
    Exit Function
End If

Fonction = CInt(TblByte(1))
Select Case Fonction
    Case 1, 2, 3, 4, 5, 6, 15, 16
    
    Case Else
    ProtocoleModbusIsRequeteStructIsOk = -3
    Exit Function
    
End Select
' Adresse Toujours en 3 et 4
' Quantité Toujours en 5 et 6 sauf pour fonction 5 et 6 Valeur fixe à 1
' Nb Octets de données (pour vérification par rapport à la longueur)
' Uniquement pour 15 et 16 en position 7

' Extraction de l'adresse (3 et 4)
LongValue = CLng(TblByte(2)) * &H100
LongValue = LongValue + CLng(TblByte(3))
Adresse = LongValue
' Extraction de la quantité
Select Case Fonction
    Case 1, 2, 3, 4, 15, 16
    LongValue = CLng(TblByte(4)) * &H100
    LongValue = LongValue + CLng(TblByte(5))
    NbItem = CInt(LongValue)
    Case 5, 6
    NbItem = 1
End Select

' Vérification quantité d'octets de données
' pour les trames de type 15 et 16
Select Case Fonction
    Case 15
    LongValue = CLng(TblByte(6))
    If (Size - 9) <> LongValue Then
        ProtocoleModbusIsRequeteStructIsOk = -5
        Exit Function
    ElseIf (LongValue < 1) Or (LongValue > 100) Then
        ProtocoleModbusIsRequeteStructIsOk = -5
        Exit Function
    End If
    
    Case 16
    LongValue = CLng(TblByte(6))
    If (Size - 9) <> LongValue Then
        ProtocoleModbusIsRequeteStructIsOk = -5
        Exit Function
    ElseIf (LongValue < 2) Or (LongValue > 200) Then
        ProtocoleModbusIsRequeteStructIsOk = -5
        Exit Function
    End If
    
    Case Else
    
End Select

End Function
Public Sub ProtocoleModbusSetLowByteOfWord(TblByte() As Byte, WordNumber As Integer, ByteValue As Byte)
' Position l'octet de poids faible d'un mot
' WordNumber 1 à n
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 7 + 1
TblByte(Xpos) = ByteValue

End Sub

Public Sub ProtocoleModbusSetHighByteOfWord(TblByte() As Byte, WordNumber As Integer, ByteValue As Byte)
' Position l'octet de poids fort d'un mot
' WordNumber 1 à n
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 7
TblByte(Xpos) = ByteValue

End Sub

Public Function ProtocoleModbusExtractFloat(TblByte() As Byte, WordNumber As Integer) As Double
' Extrait un Flottant IEEE sur 2 mots de la trame Modbus
' et retourne la valeur sous format Double
' WordNumber 1 à n
Dim Xpos As Integer
Dim SngValue As Single
Dim TByte(4) As Byte
Dim i As Integer
Dim j As Integer
Dim Chaine As String
Xpos = ((WordNumber - 1) * 2) + 3
j = 3
For i = 0 To 3
    TByte(j) = TblByte(Xpos + i)
    j = j - 1
Next i
CopyMemory SngValue, TByte(0), 4
Chaine = Str$(SngValue)
ProtocoleModbusExtractFloat = CDbl(Chaine)

End Function

Public Sub ProtocoleModbusSetFloat(TblByte() As Byte, WordNumber As Integer, FloatValue As Double)
' Ecrit un Flottant IEEE sur 2 mots de la trame Modbus
Dim Xpos As Integer
Dim SngValue As Single
Dim TByte(4) As Byte
Dim i As Integer
Dim j As Integer
Dim Chaine As String

Chaine = Str$(FloatValue)
SngValue = CSng(Chaine)
CopyMemory TByte(0), SngValue, 4
Xpos = ((WordNumber - 1) * 2) + 7

j = 3
For i = 0 To 3
    TblByte(Xpos + i) = TByte(j)
    j = j - 1
Next i

End Sub

Public Function ProtocoleModbusExtractString(TblByte() As Byte, WordNumber As Integer, Size As Integer) As String
' Extrait une chaine de caractère d'une table de mots
' L'extaction se fait à partir de du mot WordNumber pour le nombre de caractère spécifié par Size
' Extrait un mot (16 bits non signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim TxtValue As String
Dim i As Integer
Xpos = ((WordNumber - 1) * 2) + 3
' XPos est le permier octet
TxtValue = ""
For i = 1 To Size
    TxtValue = TxtValue & Chr$(TblByte(Xpos + i - 1))
Next i
ProtocoleModbusExtractString = TxtValue


End Function

Public Sub ProtocoleModbusSetDoubleWord(TblByte() As Byte, WordNumber As Integer, WordValue As Long)
' Met à jour le mot demandé dans la trame
' Le premier mot démarre à la position d'octet 7
' Le second mot est à la position 9 etc
Dim Xpos As Integer
Xpos = ((WordNumber - 1) * 2) + 7

'TblByte(Xpos) = CByte((WordValue And &HFF00&) / &H100)
'TblByte(Xpos + 1) = CByte(WordValue And &HFF&)
'TblByte(Xpos + 2) = CByte((WordValue And &HFF000000) / &H1000000)
'TblByte(Xpos + 3) = CByte((WordValue And &HFF0000) / &H10000)
TblByte(Xpos) = CByte((WordValue And &HFF000000) / &H1000000)
TblByte(Xpos + 1) = CByte((WordValue And &HFF0000) / &H10000)
TblByte(Xpos + 2) = CByte((WordValue And &HFF00&) / &H100)
TblByte(Xpos + 3) = CByte(WordValue And &HFF&)

End Sub

Public Function ProtocoleModbusExtractDoubleWordIntel(TblByte() As Byte, WordNumber As Integer) As Long
' Extrait un double mot (32 bits signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
Xpos = ((WordNumber - 1) * 2) + 3
' Attention au signe
If TblByte(Xpos + 2) < 128 Then
    LongValue = CLng(TblByte(Xpos + 2)) * &H1000000
    LongValue = LongValue + (CLng(TblByte(Xpos + 3)) * &H10000)
    LongValue = LongValue + (CLng(TblByte(Xpos)) * &H100)
    LongValue = LongValue + CLng(TblByte(Xpos + 1))
Else
    LongValue = &H80000000
    LongValue = LongValue + (CLng(TblByte(Xpos + 2) And &H7F) * &H1000000)
    LongValue = LongValue Or (CLng(TblByte(Xpos + 3)) * &H10000)
    LongValue = LongValue Or (CLng(TblByte(Xpos)) * &H100)
    LongValue = LongValue Or CLng(TblByte(Xpos + 1))
End If

ProtocoleModbusExtractDoubleWordIntel = LongValue

End Function

Public Sub ProtocoleModbusSetDoubleWordIntel(TblByte() As Byte, WordNumber As Integer, WordValue As Long)
' Met à jour le mot demandé dans la trame
' Le premier mot démarre à la position d'octet 7
' Le second mot est à la position 9 etc
Dim Xpos As Integer
Dim Octet As Byte
Xpos = ((WordNumber - 1) * 2) + 7


If WordValue >= 0 Then
    TblByte(Xpos + 0) = CByte((WordValue And &HFF00&) / &H100)
    TblByte(Xpos + 1) = CByte(WordValue And &HFF&)
    TblByte(Xpos + 2) = CByte((WordValue And &HFF000000) / &H1000000)
    TblByte(Xpos + 3) = CByte((WordValue And &HFF0000) / &H10000)
Else
    TblByte(Xpos + 0) = CByte((WordValue And &HFF00&) / &H100)
    TblByte(Xpos + 1) = CByte(WordValue And &HFF&)
    Octet = CByte((WordValue And &H7F000000) / &H1000000)
    Octet = Octet Or &H80
    TblByte(Xpos + 2) = Octet
    TblByte(Xpos + 3) = CByte((WordValue And &HFF0000) / &H10000)

End If


End Sub

Public Sub ProtocoleModbusSetString(TblByte() As Byte, WordNumber As Integer, StringLen As Integer, StringValue As String)
' Met à jour les mots demandés dans la trame
' Le premier mot démarre à la position d'octet 7
' Le second mot est à la position 9 etc
Dim Xpos As Integer
Dim i As Integer
Xpos = ((WordNumber - 1) * 2) + 7
For i = 1 To StringLen
    If i <= Len(StringValue) Then
        TblByte(Xpos + i - 1) = Asc(Mid$(StringValue, i, 1))
    End If
Next i
End Sub

Public Function ProtocoleModbusExtractWordFromMasterCde(TblByte() As Byte, WordNumber As Integer) As Long
' Extrait un mot (16 bits non signé)
' WordNumber 1 à n
' Le premier mot démarre à la position d'octet 3
' Le second mot est à la position 5 etc
Dim Xpos As Integer
Dim LongValue As Long
Xpos = ((WordNumber - 1) * 2) + 7
LongValue = CLng(TblByte(Xpos)) * &H100
LongValue = LongValue + CLng(TblByte(Xpos + 1))
ProtocoleModbusExtractWordFromMasterCde = LongValue

End Function

Public Function TranslateBinaryToString(TblByte() As Byte, Optional ByVal pSize As Integer = -1) As String
' converti une table d'octet en une chaine de caractere ascii
' On ne prend que les caractères dont le code ASCCI est supérieur ou égale à &h20
Dim Txt As String
Dim i As Integer

Txt = ""

If pSize = -1 Then pSize = UBound(TblByte)

For i = 0 To pSize
    If TblByte(i) >= &H20 Then
        Txt = Txt + Chr$(TblByte(i))
    End If
Next i
TranslateBinaryToString = Txt

End Function


Public Function ProtocoleModbusCheckCRC16(TblByte() As Byte, Size As Integer) As Integer
' Retourne False si le CRC16 et Nok
Dim j As Integer
Dim Crc As Long
Dim CRC16 As Long
Dim n As Integer
Dim Retenue As Boolean
Dim MemoL As Byte
Dim MemoH As Byte

' Memorise le CRC16
MemoL = TblByte(Size - 1)
MemoH = TblByte(Size)

Crc = &HFFFF&
For j = 0 To (Size - 2)
    Crc = Crc Xor CLng(TblByte(j))
    n = 0
    Do
        Retenue = False
        If (Crc Mod &H2&) <> 0 Then
            Retenue = True
        End If
        Crc = Fix(Crc / 2)
        If Retenue = True Then
            Crc = Crc Xor &HA001&
        End If
        n = n + 1
    Loop While (n <= 7)
Next j

' Invertion du CRC 16 calculé
CRC16 = (Crc And &HFF00&) / &H100
CRC16 = CRC16 + ((Crc And &HFF&) * &H100&)

If (MemoH <> (Crc And &HFF00&) / &H100) Or (MemoL = (Crc And &HFF&)) Then
    ProtocoleModbusCheckCRC16 = False
Else
    ProtocoleModbusCheckCRC16 = True
End If


'TblByte(Size) = (Crc And &HFF00&) / &H100
'TblByte(Size - 1) = (Crc And &HFF&)


End Function

