Attribute VB_Name = "ProtocoleModbus"
Option Explicit
' Module d'encodage et vérification des trames modbus


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, Size As Integer) 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 = ""

For i = 0 To (Size)
    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
LongValue = CLng(TblByte(Xpos)) * &H100
LongValue = LongValue + CLng(TblByte(Xpos + 1))
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
' 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
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)

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, Size As Integer) 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 = ""

For i = 0 To (Size)
    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
