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 grenier

proc CRC16_berechnen :Paramètres crc_data%' Übergabe données

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

    tandis que bit_counter% > 0' 8x Durchläufe

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

        si feedback_bit% = $01' si 1, ensuite...

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

        EndIf

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

        si feedback_bit% = $01' si 1, ensuite...

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

        EndIf

        crc_data% = crc_data% >> 1' données Shift à droite
        Décembre bit_counter%' Schleifendurchlauf -1

    Endwhile' Ende Endlosschleife

endproc

Testaufruf:
CRC16_Sp% = 0' Reset CRC8 grenier

WhileLoop 0,2^16-1, 7' Chr$(0)+Chr$(0) jusqu'à Chr$(255)+Chr$(255) durchlaufen avec Step 7

    CRC16_berechnen(&Boucle)' CRC berechnen
    Imprimer "Daten="+Str$(&Boucle)+"   CRC16="+Str$(CRC16_Sp%),
    ' et eh bien comme Binärwert sous Anschluß qui Prüfsumme rückprüfen, muss ensuite 0 ergeben:"
    CRC16_berechnen(val("%"+right$("0000000000000000"+suis$(&Boucle),16)+right$("0000000000000000"+suis$(CRC16_Sp%),16)) )
    Imprimer tab(40);"Errorflag: ";Str$(CRC16_Sp%)

Endwhile

waitinput