XProfan

CLS
' DEMO ONLY! NO WARRANTY WHATSOEVER! ALL RIGHTS APPLY TO THEIR RESPECTIVE OWNERS!
def &IBM = $A001' Used by Bisync, Modbus, USB, ANSI X3.28, SIA DC-07, ...
def &CCITT=$8408' Used by X.25, V.41, HDLC FCS, XMODEM, Bluetooth, PACTOR, SD
def &SCSI =$EDD1' Used by SCSI
Def %CRC16POLY &CCITT' $18 wäre z.B. X^8+X^5+X^4+X^0
Var CRC16_Sp% = 0' CRC16 Speicher

proc CRC16_berechnen :Parameters crc_data%' Übergabe Daten

    Var bit_counter% = 16' Schleifendurchlauf
    Var feedback_bit% = 0' Bit Rückgabe

    while bit_counter% > 0' 8x Durchläufe

        feedback_bit% = Xor(CRC16_Sp%,crc_data%) & $01' XOR auf 1 überprüfen

        if feedback_bit% = $01' wenn 1, dann...

            CRC16_Sp% = Xor(CRC16_Sp%,%CRC16POLY)' XOR mit Poly

        EndIf

        CRC16_Sp% = (CRC16_Sp% >> 1) & $7FFF' Shift rechts & 32767  '$7F=247  <<<<<<

        if feedback_bit% = $01' wenn 1, dann...

            CRC16_Sp% = CRC16_Sp% | $8000' 32768    'ODER 128   <<<<<<<<<<<<<<<

        EndIf

        crc_data% = crc_data% >> 1' Daten Shift rechts
        Dec bit_counter%' Schleifendurchlauf -1

    EndWhile' Ende Endlosschleife

endproc

Testaufruf:
CRC16_Sp% = 0' Reset CRC8 Speicher

WhileLoop 0,2^16-1, 7' Chr$(0)+Chr$(0) bis Chr$(255)+Chr$(255) durchlaufen mit Step 7

    CRC16_berechnen(&Loop)' CRC berechnen
    Print "Daten="+Str$(&Loop)+"   CRC16="+Str$(CRC16_Sp%),
    ' Und nun als Binärwert unter Anschluß der Prüfsumme rückprüfen, muss dann 0 ergeben:"
    CRC16_berechnen(val("%"+right$("0000000000000000"+bin$(&Loop),16)+right$("0000000000000000"+bin$(CRC16_Sp%),16)) )
    Print tab(40);"Errorflag: ";Str$(CRC16_Sp%)

EndWhile

waitinput