(*

* Library: crc16

* File: crc16.pas

* Huge parts based on libcrc sourcecode

* Orginal Author: Lammert Bies (libcrc in c)

*

* Pascal version Author: Thaddy de Koning (Pascal translation and additional code)

*

* This file is licensed under the MIT License as stated below

*

* Original C version Copyright (c) 1999-2016 Lammert Bies

* Pascal version Copyright (c) 2017 Thaddy de Koning

*

* Permission is hereby granted, free of charge, to any person obtaining a copy

* of this software and associated documentation files (the "Software"), to deal

* in the Software without restriction, including without limitation the rights

* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

* copies of the Software, and to permit persons to whom the Software is

* furnished to do so, subject to the following conditions:

*

* The above copyright notice and this permission notice shall be included in all

* copies or substantial portions of the Software.

*

* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE

* SOFTWARE.

*)

unit crc16;

{$mode objfpc}

interface

const

{ Polynomials }

CRC_POLY_16 = $A001;

CRC_POLY_CCITT = $1021;

CRC_POLY_DNP = $A6BC;

CRC_POLY_KERMIT = $8408;

CRC_POLY_SICK = $8005;

{ Start values }

CRC_START_16 = $0000;

CRC_START_MODBUS = $FFFF;

CRC_START_XMODEM = $0000;

CRC_START_CCITT_1D0F = $1D0F;

CRC_START_CCITT_FFFF = $FFFF;

CRC_START_KERMIT = $0000;

CRC_START_SICK = $0000;

CRC_START_DNP = $0000;

{$push}{$J+}

crc_tab16_init:Boolean = true;

crc_tab16: array[0..255] of word =(

$0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,

$C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,

$CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,

$0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,

$D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,

$1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,

$1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,

$D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,

$F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,

$3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,

$3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,

$FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,

$2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,

$EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,

$E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,

$2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,

$A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,

$6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,

$6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,

$AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,

$7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,

$BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,

$B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,

$7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,

$5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,

$9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,

$9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,

$5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,

$8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,

$4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,

$4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,

$8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040 );

crc_tabccitt_init:boolean = true;

crc_tabccitt:array[0..255] of word = (

$0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,

$8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,

$1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,

$9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,

$2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,

$A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,

$3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,

$B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,

$48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,

$C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,

$5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,

$DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,

$6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,

$EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,

$7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,

$FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,

$9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,

$1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,

$83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,

$02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,

$B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,

$34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,

$A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,

$26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,

$D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,

$5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,

$CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,

$4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,

$FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,

$7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,

$EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,

$6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0);

crc_tabkermit_init:boolean = true;

var

crc_tabkermit:array[0..255] of word = (

$0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,

$8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,

$1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,

$9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,

$2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,

$AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,

$3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,

$BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,

$4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,

$CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,

$5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,

$DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,

$6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,

$EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,

$7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,

$FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,

$8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,

$0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,

$9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,

$18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,

$A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,

$2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,

$B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,

$39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,

$C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,

$4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,

$D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,

$5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,

$E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,

$6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,

$F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,

$7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78);

crc_tabdnp_init:Boolean = true;

crc_tabdnp:array[0..255] of word =(

$0000, $365E, $6CBC, $5AE2, $D978, $EF26, $B5C4, $839A,

$FF89, $C9D7, $9335, $A56B, $26F1, $10AF, $4A4D, $7C13,

$B26B, $8435, $DED7, $E889, $6B13, $5D4D, $07AF, $31F1,

$4DE2, $7BBC, $215E, $1700, $949A, $A2C4, $F826, $CE78,

$29AF, $1FF1, $4513, $734D, $F0D7, $C689, $9C6B, $AA35,

$D626, $E078, $BA9A, $8CC4, $0F5E, $3900, $63E2, $55BC,

$9BC4, $AD9A, $F778, $C126, $42BC, $74E2, $2E00, $185E,

$644D, $5213, $08F1, $3EAF, $BD35, $8B6B, $D189, $E7D7,

$535E, $6500, $3FE2, $09BC, $8A26, $BC78, $E69A, $D0C4,

$ACD7, $9A89, $C06B, $F635, $75AF, $43F1, $1913, $2F4D,

$E135, $D76B, $8D89, $BBD7, $384D, $0E13, $54F1, $62AF,

$1EBC, $28E2, $7200, $445E, $C7C4, $F19A, $AB78, $9D26,

$7AF1, $4CAF, $164D, $2013, $A389, $95D7, $CF35, $F96B,

$8578, $B326, $E9C4, $DF9A, $5C00, $6A5E, $30BC, $06E2,

$C89A, $FEC4, $A426, $9278, $11E2, $27BC, $7D5E, $4B00,

$3713, $014D, $5BAF, $6DF1, $EE6B, $D835, $82D7, $B489,

$A6BC, $90E2, $CA00, $FC5E, $7FC4, $499A, $1378, $2526,

$5935, $6F6B, $3589, $03D7, $804D, $B613, $ECF1, $DAAF,

$14D7, $2289, $786B, $4E35, $CDAF, $FBF1, $A113, $974D,

$EB5E, $DD00, $87E2, $B1BC, $3226, $0478, $5E9A, $68C4,

$8F13, $B94D, $E3AF, $D5F1, $566B, $6035, $3AD7, $0C89,

$709A, $46C4, $1C26, $2A78, $A9E2, $9FBC, $C55E, $F300,

$3D78, $0B26, $51C4, $679A, $E400, $D25E, $88BC, $BEE2,

$C2F1, $F4AF, $AE4D, $9813, $1B89, $2DD7, $7735, $416B,

$F5E2, $C3BC, $995E, $AF00, $2C9A, $1AC4, $4026, $7678,

$0A6B, $3C35, $66D7, $5089, $D313, $E54D, $BFAF, $89F1,

$4789, $71D7, $2B35, $1D6B, $9EF1, $A8AF, $F24D, $C413,

$B800, $8E5E, $D4BC, $E2E2, $6178, $5726, $0DC4, $3B9A,

$DC4D, $EA13, $B0F1, $86AF, $0535, $336B, $6989, $5FD7,

$23C4, $159A, $4F78, $7926, $FABC, $CCE2, $9600, $A05E,

$6E26, $5878, $029A, $34C4, $B75E, $8100, $DBE2, $EDBC,

$91AF, $A7F1, $FD13, $CB4D, $48D7, $7E89, $246B, $1235);

{$pop}

{ Array initializations for different CRC's }

procedure init_crc16_tab;

procedure init_crcccitt_tab;

procedure init_crckermit_tab;

procedure init_crcdnp_tab;

{ CRC16 implementations }

function crc_16( const input_str:Pbyte;num_bytes:integer ):word;inline;

function crc_modbus( const input_str:Pbyte; num_bytes:integer):word;inline;

function crc_ccitt_generic( const input_str:PByte; num_bytes:integer;start_value:word ):word;inline;

function crc_xmodem( const input_str:PByte;num_bytes:integer):word;inline;

function crc_ccitt_1d0f( const input_str:PByte;num_bytes:integer):word;inline;

function crc_ccitt_ffff( const input_str:PByte;num_bytes:integer):word;inline;

function crc_kermit( const input_str:PByte; num_bytes:integer ):word;inline;

function crc_dnp( const input_str:PByte; num_bytes:Integer):word;

function crc_sick( const input_str:PByte; num_bytes:integer ):word;

{ Update functions }

function update_crc_ccitt( crc:word;c:byte ):word; inline;

function update_crc_kermit( crc:word; c:byte ):word;

function update_crc_dnp(crc:word; c:byte ):word;inline;

function update_crc_sick(crc:word; c,prev_byte:Byte ):word;inline;

implementation

procedure init_crc16_tab;

var

i,j,crc,c:word;

begin

for i := 0 to 255 do

begin

crc := 0;

c := i;

for j := 0 to 7 do

begin

if (crc xor c) and $0001 > 0 then

crc := ( crc >> 1 ) xor CRC_POLY_16

else

crc := crc >> 1;

c := c >> 1;

end;

crc_tab16[i] := crc;

end;

crc_tab16_init := true;

end;

procedure init_crcccitt_tab;

var

i,j,crc,c:word;

begin

for i := 0 to 255 do

begin

crc := 0;

c := i << 8;

for j :=0 to 7 do

begin

if (crc xor c) and $8000 <> 0 then

crc := ( crc << 1 ) xor CRC_POLY_CCITT

else

crc := crc << 1;

c := c << 1;

end;

crc_tabccitt[i] := crc;

end;

crc_tabccitt_init := true;

end;

procedure init_crckermit_tab;

var

i,j,crc,c:word;

begin

for i:=0 to 255 do

begin

crc := 0;

c := i;

for j := 0 to 7 do

begin

if ( (crc xor c) and $0001 ) <> 0 then

crc := ( crc >> 1 ) xor CRC_POLY_KERMIT

else

crc := crc >> 1;

c := c >> 1;

end;

crc_tabkermit[i] := crc;

end;

crc_tabkermit_init := true;

end;

procedure init_crcdnp_tab;

var

i,j,crc,c:word;

begin

for i := 0 to 255 do

begin

crc := 0;

c := i;

for j :=0 to 7 do

begin

if ( (crc xor c) and $0001 ) <> 0 then

crc := ( crc >> 1 ) xor CRC_POLY_DNP

else

crc := crc >> 1;

c := c >> 1;

end;

crc_tabdnp[i] := crc;

end;

crc_tabdnp_init := true;

end;

function crc_16( const input_str:Pbyte;num_bytes:integer ):word;

var

ptr:PByte;

a:integer;

begin

if not crc_tab16_init then init_crc16_tab;

result := CRC_START_16;

ptr := input_str;

if ptr <> nil then for a :=0 to pred(num_bytes) do

begin

Result := (Result >> 8) xor crc_tab16[ (Result xor ptr^) and $00FF ];

inc(ptr);

end;

end;

function crc_modbus( const input_str:Pbyte; num_bytes:integer):word;

var

ptr:PByte;

a:integer;

begin

if not crc_tab16_init then init_crc16_tab;

result := CRC_START_MODBUS;

ptr := input_str;

if ptr <> nil then for a := 0 to pred(num_bytes) do

begin

result := (result >> 8) xor crc_tab16[ (result xor ptr^) and $00FF ];

inc(ptr);

end;

end;

function crc_ccitt_generic( const input_str:PByte; num_bytes:integer;start_value:word ):word;

var

ptr:PByte;

a:integer;

begin

if not crc_tabccitt_init then init_crcccitt_tab;

Result := start_value;

ptr := input_str;

if ptr <> nil then for a := 0 to pred(num_bytes) do

begin

Result := (Result << 8) xor crc_tabccitt[ ((Result >> 8) xor ptr^) and $00FF ];

inc(ptr);

end;

end;

function update_crc_ccitt( crc:word;c:byte ):word; inline;

begin

if not crc_tabccitt_init then init_crcccitt_tab;

result := (crc << 8) xor crc_tabccitt[ ((crc >> 8) xor word(c)) and $00FF ];

end;

function crc_xmodem( const input_str:PByte;num_bytes:integer):word;inline;

begin

result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_XMODEM );

end;

function crc_ccitt_1d0f( const input_str:PByte;num_bytes:integer):word;inline;

begin

result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_CCITT_1D0F );

end;

function crc_ccitt_ffff( const input_str:PByte;num_bytes:integer):word;inline;

begin

result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_CCITT_FFFF );

end;

function crc_kermit( const input_str:PByte; num_bytes:integer ):word;

var

crc,low_byte,high_byte:word;

ptr:PByte;

a:integer;

begin

if not crc_tabkermit_init then init_crckermit_tab;

crc := CRC_START_KERMIT;

ptr := input_str;

if ptr <> nil then for a := 0 to pred(num_bytes) do

begin

crc := (crc >> 8) xor crc_tabkermit[ (crc xor word(ptr^)) and $00FF ];

inc(ptr);

end;

low_byte := (crc and $ff00) >> 8;

high_byte := (crc and $00ff) << 8;

crc := low_byte or high_byte;

Result := crc;

end;

function update_crc_kermit( crc:word; c:byte ):word;

begin

if not crc_tabkermit_init then init_crckermit_tab;

Result := (crc >> 8) xor crc_tabkermit[ (crc xor dword(c)) and $00FF ];

end;

function crc_dnp( const input_str:PByte; num_bytes:Integer):word;

var

low_byte,high_byte:word;

ptr:PByte;

a:integer;

begin

if not crc_tabdnp_init then init_crcdnp_tab;

Result := CRC_START_DNP;

ptr := input_str;

if ptr <> nil then for a :=0 to pred(num_bytes) do

begin

Result := (Result >> 8) xor crc_tabdnp[ (Result xor ptr^) and $00FF ];

inc(ptr);

end;

Result := not Result;

low_byte := (Result and $ff00) >> 8;

high_byte := (Result and $00ff) << 8;

Result := low_byte or high_byte;

end;

function update_crc_dnp(crc:word; c:byte ):word;inline;

begin

if not crc_tabdnp_init then init_crcdnp_tab;

result := (crc >> 8) xor crc_tabdnp[ (crc xor dword(c)) and $00FF ];

end;

function crc_sick( const input_str:PByte; num_bytes:integer ):word;

var

low_byte,high_byte,short_c,short_p:word;

ptr:PByte;

a:integer;

begin

Result := CRC_START_SICK;

ptr:= input_str;

short_p := 0;

if ptr <> nil then for a := 0 to pred(num_bytes) do

begin

short_c := $00FF and word(ptr^);

if ( Result and $8000 ) <> 0 then

Result := ( Result << 1 ) xor CRC_POLY_SICK

else

Result := Result << 1;

Result := Result xor ( short_c or short_p );

short_p := short_c << 8;

inc(ptr);

end;

low_byte := (Result and $FF00) >> 8;

high_byte := (Result and $00FF) << 8;

Result := low_byte or high_byte;

end;

function update_crc_sick(crc:word; c,prev_byte:Byte ):word;inline;

var

short_c,short_p:word;

begin

short_c := $00FF and dword(c);

short_p := ( $00FF and dword(prev_byte) ) << 8;

if ( crc and $8000 ) <> 0 then

crc := ( crc << 1 ) xor CRC_POLY_SICK

else

crc := crc << 1;

crc := crc xor ( short_c or short_p );

result := crc;

end;

end.