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 would z.B. X^8+X^5+X^4+X^0
Var CRC16_Sp% = 0' CRC16 memory

proc CRC16_berechnen :Parameters crc_data%' Übergabe data

    Var bit_counter% = 16' Schleifendurchlauf
    Var feedback_bit% = 0' bit Return

    while bit_counter% > 0' 8x Durchläufe

        feedback_bit% = Xor(CRC16_Sp%,crc_data%) & $01' XOR on 1 to check on

        if feedback_bit% = $01' if 1, then...

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

        EndIf

        CRC16_Sp% = (CRC16_Sp% >> 1) & $7FFF' Invoice values right & 32767  '$7F=247  <<<<<<

        if feedback_bit% = $01' if 1, then...

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

        EndIf

        crc_data% = crc_data% >> 1' data Invoice values right
        Dec bit_counter%' Schleifendurchlauf -1

    EndWhile' end Endlosschleife

endproc

Testaufruf:
CRC16_Sp% = 0' Reset CRC8 memory

WhileLoop 0,2^16-1, 7' Chr$(0)+Chr$(0) To Chr$(255)+Chr$(255) go through with Step 7

    CRC16_berechnen(&Loop)' CRC to charge
    Print "Daten="+Str $(&Loop)+"   CRC16="+Str $(CRC16_Sp%),
    ' well then as Binärwert under Connection the Prüfsumme rückprüfen, must then 0 yield:"
    CRC16_berechnen(val("%"+right$("0000000000000000"+be$(&Loop),16)+right$("0000000000000000"+be$(CRC16_Sp%),16)) )
    Print tab(40);"Errorflag: ";Str $(CRC16_Sp%)

EndWhile

waitinput