CRC16 Buypass berechnen VBA

Ulrich Gast #4913977
Lesenswert?
• ▲
▼ 
Guten Morgen,
ich hoffe ihr könnt mir bei meinem Problem weiterhelfen.

Bei einer RS232 Kommunikation muss jeder Befehl mit einer CRC16 
Checksumme abgesetzt werden. Da ich mein Projekt in VBA schreibe finde 
ich leider keinen Ansatz um auf das richtige Ergebnis zu kommen. Alle 
bisherigen Codebeispiele liefern leider keine richtigen Ergebnisse. Ich 
tippe darauf, dass man den Code evtl auf Buypass umstellen müsste, was 
mir leider nicht gelingt. Wäre toll wenn mir jemand dabei helfen könnte.

mein bisheriger Code sieht wie folgt aus:

1
Public Function CRC_CCITT2(btArrX() As Byte, _

2
    bolLOFirst As Boolean) As Long

3
    Dim lngCRC As Long

4
    Dim lngPolynom As Long

5
    Dim x As Long

6
    Dim y As Long

7
    Dim bolB1 As Boolean

8
    Dim bolB2 As Boolean

9
    Dim lngArr2(15) As Long

10
    Dim lngCRC2 As Long

11
    Dim btArr() As Byte

12
 

13
 

14
    ReDim btArr(UBound(btArrX) + 2)

15


16
    For x = 0 To UBound(btArrX)

17
        btArr(x) = btArrX(x)

18
    Next

19
    btArr(x) = &H0

20
    btArr(x + 1) = &H0

21


22
    For x = 0 To 15

23
        lngArr2(x) = 2 ^ x

24
    Next

25


26
    lngPolynom = &H8005&

27


28
    For x = 0 To UBound(btArr)

29
        For y = 0 To 7

30
            bolB1 = lngCRC > &H7FFF&

31
            bolB2 = btArr(x) And lngArr2(y)

32
            lngCRC = lngCRC And &H7FFF&

33


34
            lngCRC = lngCRC * 2

35
            If bolB2 Then

36
                lngCRC = lngCRC + 1

37
            End If

38
            If bolB1 Then

39
                lngCRC = lngCRC Xor lngPolynom

40
            End If

41
        Next

42
    Next

43


44
    If bolLOFirst Then

45
        For x = 0 To 15

46
            If lngCRC And lngArr2(x) Then

47
                lngCRC2 = lngCRC2 + lngArr2(15 - x)

48
            End If

49
        Next

50
        CRC_CCITT2 = lngCRC2

51
    Else

52
        CRC_CCITT2 = lngCRC

53
    End If

54


55
End Function

1
Private Sub Befehl137_Click()

2
   Dim data(1) As Byte

3


4
   data(0) = 4

5
   data(1) = 80

6
   MsgBox "Crc16 = " & Hex$(CRC_CCITT2(data, True))

7
End Sub


Im Anhang hab ich euch auch noch einen Screenshot hinterlassen von einem 
Online CRC16 Rechner , der die richtigen Ergebnisse ausspuckt.

sunshine2k.de/coding/java...rc/crc_js.html

  


      

      Angehängte Dateien:



        
    




  

    Antwort Zitieren Bearbeiten Thread verschieben Thread sperren Anmeldepflicht aktivieren Anpinnen Thread löschen Thread mit anderem zusammenführen Beitrag melden
  








      

      






    

    

       Thread beobachten


    

        


Antwort schreiben




  
Bitte melde dich an, um einen Beitrag zu schreiben.

  

  
Bestehender Account



  

    

      

        
        
      

      

        
        
      

    


    

      
      
    




  
oder

  Mit Google-Account einloggen





  
Noch kein Account?

  
Die Registrierung ist kostenlos und dauert nur eine Minute.

  Jetzt registrieren