Turbo Pascal, CRC16

Comments

• Phat Nat

  May 2008

  Sorry. I've seen your post here for a while, but never worked with Checksums so I've had to do some research. Below is the working code for the three basic CRC16 checks (sorry no CRC32 support).
  I took almost all this code from others, so I think I left most credits in (found from the site you listed).
  
  The main section at the bottom is basically what you want to focus on.
  
  [code]
  PROGRAM CRCTable;
  CONST
  hexdigit: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  InitialValue : Word = $0000;
  
  TYPE
  pByte = ^Byte;
  TCRCDescription = record
  Width : Integer;
  Polynom : Word;
  Init : Word;
  RefIn : Boolean;
  RefOut : Boolean;
  XorOut : Word;
  end;
  TCRCLookUpTable16 = array[Byte] of Word;
  
  CONST
  CRC16Desc : TCRCDescription =
  (Width : 16;
  Polynom : $8005;
  Init : $0000;
  RefIn : True;
  RefOut : True;
  XorOut : $0000);
  
  CRC16CCITTDesc : TCRCDescription =
  (Width : 16;
  Polynom : $1021;
  Init : $FFFF;
  RefIn : False;
  RefOut : False;
  XorOut : $0000);
  
  CRC16XModemDesc : TCRCDescription =
  (Width : 16;
  Polynom : $8408;
  Init : $0000;
  RefIn : True;
  RefOut : True;
  XorOut : $0000);
  
  Table : TCRCLookupTable16 = { Standard CRC-16 Table }
  ($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);
  
  VAR
  CRC16 : Word;
  InputString : String;
  MyPolyInfo : TCRCDescription;
  X : Byte;
  
  const
  Bitmask : array[0..15] of Word =
  ($0001, $0002, $0004, $0008,
  $0010, $0020, $0040, $0080,
  $0100, $0200, $0400, $0800,
  $1000, $2000, $4000, $8000);
  
  function CrcReflect(Value: Word; BitCount: Integer): Word;
  var
  i: Integer;
  Result : Word;
  begin
  Result := Value;
  Dec(BitCount);
  for i := 0 to BitCount do
  begin
  if (Value and 1) <> 0 then
  Result := Result or Bitmask[BitCount - i]
  else
  Result := Result and not Bitmask[BitCount - i];
  Value := Value shr 1;
  end;
  CRCReflect := Result;
  end;
  
  (***************** CRC Lookup Table Generation ********************)
  
  function CrcMakeLookupTableItem(const Desc: TCRCDescription;
  Index: Integer): Word;
  var
  i: Integer;
  WidthMask: Word;
  TopBit: Word;
  Result: Word;
  begin
  with Desc do
  begin
  WidthMask := (((1 shl Width) and $FFFFFFFE) - 1) or 1;
  TopBit := 1 shl (Width - 1);
  if RefIn then
  Result := CRCReflect(Index,8)
  else
  Result := Index;
  Result := Result shl (Width - 8);
  for i := 0 to 7 do
  begin
  if (Result and TopBit) <> 0 then
  Result := (Result shl 1) xor Polynom
  else
  Result := Result shl 1;
  end;
  if RefIn then
  Result := CRCReflect(Result,Width);
  Result := Result and WidthMask;
  CrcMakeLookupTableItem := Result;
  end;
  end;
  
  
  function CrcMakeLookupTable16(const Desc: TCRCDescription;
  var Table: TCRCLookUpTable16): Boolean;
  var
  i: Integer;
  Result : Boolean;
  begin
  Result := Desc.Width <= 16;
  CrcMakeLookupTable16 := Result;
  if not Result then Exit;
  for i := 0 to 255 do
  Table[i] := CrcMakeLookupTableItem(Desc, i);
  end;
  
  FUNCTION CalcCRC16 (p: pByte; nbyte: WORD) : Word;
  VAR
  i: WORD;
  q: pByte;
  Result : Word;
  {The following is a little cryptic (but executes very quickly).
  The algorithm is as follows:
  1. exclusive-or the input byte with the low-order byte of
  the CRC register to get an INDEX
  2. shift the CRC register eight bits to the right
  3. exclusive-or the CRC register with the contents of
  Table[INDEX]
  4. repeat steps 1 through 3 for all bytes}
  BEGIN
  q := p;
  Result := InitialValue;
  FOR i := 1 TO nBYTE DO
  BEGIN
  Result := Hi(Result) XOR Table[ q^ XOR Lo(Result) ];
  INC(q)
  END;
  CalcCRC16 := Result XOR InitialValue;
  END {CalcCRC16};
  
  (** MAIN SECTION **)
  Begin
  { Standard x^16 + x^15 + x^2 + 1 }
  CRCMakeLookupTable16(CRC16Desc, Table);
  
  (** Note the above line is useless as the table will be generated over **
  ** in the next line, but shows how to do standard CRC16 (default) or **
  ** also can use CRC16CCITTDesc for third basic method **)
  
  { XModem x^16 + x^12 + x^5 + 1 }
  CRCMakeLookupTable16(CRC16XModemDesc, Table);
  
  { Initial Value is usually set to $0000 or $FFFF }
  InitialValue := $0000;
  
  { The String to be translated }
  InputString := 'Hello World!';
  WriteLn('Input = "',InputString,'"');
  
  { The function to translate based upon the table created above }
  CRC16 := CalcCRC16(Addr(InputString[1]),Length(InputString));
  { Display our CRC16 value on screen! }
  WriteLn('CRC16 = ',CRC16);
  End.
  (** END MAIN SECTION **)
  [/code]
  
  If you need a hand with anything more, I'm here.
  
  Phat Nat
• Markus.L

  May 2008

  Thank you for the effort, right now i'am a bit busy with another problem, but i'll look into it as soon as i can. I'll let you know if i still need a hand with it or if i can get it to work on my own. Once more thanks a lot.
  
  Markus, L.
  
• Markus.L

  May 2008

  Hi again phat nat, i have been trying to get it to work for a while now and while generating new CRC16 lookup table with:
  { XModem x^16 + x^12 + x^5 + 1 }
  CRCMakeLookupTable16(CRC16XModemDesc, Table); - function
  i get an error while runing the program, it gives an error that program has exceeded value range. This error comes from our automation system where iam trying to implement the code into.
  
  I traced the problem into this specific line in CRCmakeLookupTable16Item:
  WidthMask := (((1 shl Width) and $FFFFFFFE) - 1) or 1;
  
  I can't really figure out what is causing it since i'am having dificulties to find out what the line does in the first place
  
  If anyone has any ideas what might be causing that error, i would appreciate it. Cheers in advance.
  
  Markus, L.
  
• Phat Nat

  May 2008

  : I traced the problem into this specific line in
  : CRCmakeLookupTable16Item:
  : WidthMask := (((1 shl Width) and $FFFFFFFE) - 1) or 1;
  :
  : I can't really figure out what is causing it since i'am having
  : dificulties to find out what the line does in the first place
  
  It's probably because it's using a DWord (32 bytes) as an AND operator and only giving back a WORD (16 bytes) to WidthMask. (This probably doesn't help as it sounds confusing to me!)
  
  Try this:
  [code]
  WidthMask := Word((((1 shl Width) and $FFFFFFFE) - 1) or 1);
  [/code]
  
  or this:
  [code]
  WidthMask := (((1 shl Width) and $FFFE) - 1) or 1;
  [/code]
  
  and if that doesn't work, this will work. I think that all the modes listed have the WidthMask set to $FFFF, so you could probably just set it to that. I have just added a check below:
  [code]
  If Width = 16 Then WidthMask := $FFFF;
  [/code]
  
  Basically, this takes a "1" bit and Shifts it up "Width" number of times.
  Pretty much 2^Width (2 to the power of Width). Then it takes the result and makes sure the result is even by removing the odd 1. It then subtracts 1 from that answer and then makes sure the result is odd.
  
  Not sure if you really care or not and I don't really know why it's doing this, but there it is. Anyways, I think what you really want is just one of the lines above.
  
  Phat Nat
• Markus.L

  May 2008

  
  Hi,
  Setting WidthMask to FFFF seemed to work on that one, but now i have the same error on the line below:
  
  [code]: TopBit := 1 shl (Width - 1);[/code]
  
  That shifts bit 1 left Width-1 times? What could cause the Pascal value range insufficient error this time?
  
  Thanks in advance.
  Markus, L.
  
  
  
  
• Phat Nat

  May 2008

  :
  : Hi,
  : Setting WidthMask to FFFF seemed to work on that one, but now i
  : have the same error on the line below:
  :
  : [code]: : TopBit := 1 shl (Width - 1);[/code]:
  :
  : That shifts bit 1 left Width-1 times? What could cause the Pascal
  : value range insufficient error this time?
  :
  : Thanks in advance.
  : Markus, L.
  
  Not sure. Being that it's an older compiler I guess it doesn't like alot of these variable changes? The only thing I can see is that in the CRC declaration at the very top WIDTH is declared as INTEGER and we aredeclaring TOPBIT as WORD. You could try changing the CRC declaration form INTEGER to WORD and see if that fixes it. Or try overriding the code like so:
  [code]
  TopBit := Word(1 shl (Width - 1));
  [/code]
  Unfortunately I'm not sure what your compiler is disliking as my compiler gives no complaints. Hope this helps though.
  
  Phat Nat
• Markus.L

  May 2008

  Hi,
  
  Again I'am a bit busy with other project, but i'll try that when i can. Thanks for the help!
  
  Markus,L