//CRC generator/verifier algorithm demostration:
//it explains the partial results of each division
 
//Copyleft Fabio Zorba
 
var
 cmd, message, polynomial, result, log : string;
 i, pos : integer;
 
function xor_string (str1, str2 : string) : string;
var
 tmp : string;
 i : integer;
begin
 tmp := '';
 for i := 1 to length (str1) do
 begin
  if str1 [i] = str2 [i] then tmp := tmp + '0'
  else tmp := tmp + '1';
 end;
 xor_string := tmp;
end;
 
procedure get_only_01 (var str : string);
var
 result : string;
 i : integer;
begin
 result := '';
 for i := 1 to length (str) do
  if (str [i] = '0') or (str [i] = '1') then result := result + str [i];
 str := result;
end;
 
procedure shift_left_string (var str : string);
var
 i : integer;
begin
 for i := 1 to length (str)-1 do
  str [i] := str [i+1];
 str [length (str)] := '0';
end;
 
begin
 
 if paramcount < 3 then
 begin
  writeln ('Usage:');
  writeln ('crc_calculator G|V message polynomial');
  writeln ('example:');
  writeln ('generate crc  --> crc_calculator G 110101   101');
  writeln ('check message --> crc_calculator V 11010111 101');
  exit;
 end;
 
 cmd := upcase (paramstr (1));
 message := paramstr (2);
 polynomial := paramstr (3);
 
 if (cmd <> 'G') and (cmd <> 'V') then
 begin
  writeln ('Please choose:');
  writeln ('G --> generate crc');
  writeln ('V --> verify message');
  exit;
 end;
 
 //remove characters that not are '0' or '1'
 get_only_01 (message);
 get_only_01 (polynomial);
 
 if cmd = 'G' then
  //append zeroes to binary message
  for i := 1 to length (polynomial)-1 do message := message + '0';
 
 result := '';
 for i := 1 to length (polynomial) do result := result + message [i];
 
 pos := length (polynomial);
 
 writeln (message);
 
 while pos <= length (message)   do
 begin
 
  log := '<-- shift only ';
  if result [1] = '1' then log := '<-- (' + result + ' xor ' + polynomial + ') <-- shift ';
 
  if result [1] = '1' then
   result := xor_string (result, polynomial);
 
  pos := pos + 1;
 
  shift_left_string (result);
  if pos <= length (message) then result [length(result)] := message [pos]
  //remove last bit if end of division
  else result [0] := char (ord (result [0])-1);
 
  for i := pos downto length (polynomial)+1 do write ('_');
 
  writeln (result,' ',log,'+ ',message [pos]);
 
 end;
 
 writeln ('crc: ',result);
 
end.

//CRC-16 over 1 byte function
//Copyleft Fabio Zorba 2013
const
  crc16_polynom = $8005;
 
var
  data : byte;
 
function ByteCrc16(data : byte) : word;
var
 crc : word;
 i : integer;
begin
 crc := data;
 crc := crc shl 8; //crc = data + 0000_0000
 
 //8 bit in a byte
 for i := 1 to 8 do
 begin
  if crc and $8000 <> 0 then
  begin
   crc := crc shl 1; //drop MSB bit, so drop the MSB polynom 0x1_8005
   crc := crc xor crc16_polynom;
  end
  else
   crc := crc shl 1;
 end;
 ByteCrc16 := crc;
end;
 
begin
 val (paramstr(1), data); //input 8 bit data
 write (ByteCrc16(data)); //output 16 bit CRC
end.