program crc16;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  TCRC16Params = record
    Poly: Word;
    Init: Word;
    RefIn: Boolean;
    RefOut: Boolean;
    XorOut: Word;
    Check: Word;
    Name: string
  end;

  TCRC16 = class
  private
    FParams: TCRC16Params;
    FTable: array [Byte] of Word;
    FValue: PWord;
  protected
    procedure CheckInitialized;
    procedure UpdateLSB(Data: PByte; Count: Cardinal);
    procedure UpdateMSB(Data: PByte; Count: Cardinal);
  public
    constructor Create(const Params: TCRC16Params);
    function  CalcCRC16(Data: PByte; Count: Cardinal): Word;
    function  Complete: Word;
    procedure Initialize;
    procedure Update(Data: PByte; Count: Cardinal);
  end;

const
  CRC16BYPASS: TCrc16Params = (
    Poly: $8005;
    Init: $0000;
    RefIn: False;
    RefOut: False;
    XorOut: $0000;
    Check: $FEE8;
    Name: 'CRC-16/BUYPASS';
  );

{ TCRC16 }

function ReverseByte(b: Byte): Byte;
begin
  b := (b and $F0) shr 4 or (b and $0F) shl 4;
  b := (b and $CC) shr 2 or (b and $33) shl 2;
  Result := (b and $AA) shr 1 or (b and $55) shl 1;
end;

function ReverseWord(w: Word): Word;
begin
  w := (w and $FF00) shr 8 or (w and $00FF) shl 8;
  w := (w and $F0F0) shr 4 or (w and $0F0F) shl 4;
  w := (w and $CCCC) shr 2 or (w and $3333) shl 2;
  Result := (w and $AAAA) shr 1 or (w and $5555) shl 1;
end;

function TCRC16.CalcCRC16(Data: PByte; Count: Cardinal): Word;
begin
  Initialize;
  if FParams.RefIn then
    UpdateLSB(Data, Count)
  else
    UpdateMSB(Data, Count);
  Result := Complete;
end;

procedure TCRC16.CheckInitialized;
begin
  if FValue = nil then
    raise Exception.Create('You must call init first!');
end;

function TCRC16.Complete: Word;
begin
  CheckInitialized;
  if FParams.RefOut then
    Result := ReverseWord(FValue^) xor FParams.XorOut
  else
    Result := FValue^ xor FParams.XorOut;
  Dispose(FValue);
  FValue := nil;
end;

constructor TCRC16.Create(const Params: TCRC16Params);
const
  Test: AnsiString = '123456789';
var
  Check: Integer;
  Index: Byte;
  Value: Word;
  IsSet: Boolean;
begin
  FParams := Params;
	for Index := 0 to 255 do
  begin
    Value := Word(Index) shl 8;
    for Check := 0 to 7 do
    begin
      IsSet := Value and $8000 <> 0;
      Value := Value shl 1;
      if IsSet then
        Value := Value xor Params.Poly;
    end;
    FTable[Index] := Value;
  end;
  if CalcCRC16(PByte(Test), Length(Test)) <> FParams.Check then
    raise Exception.Create('Mismatch of the test value, possibly an error in the parameters.');
end;

procedure TCRC16.Initialize;
begin
  if FValue = nil then
    New(FValue);
  FValue^ := FParams.Init;
end;

procedure TCRC16.Update(Data: PByte; Count: Cardinal);
begin
  CheckInitialized;
  if FParams.RefIn then
    UpdateLSB(Data, Count)
  else
    UpdateMSB(Data, Count);
end;

procedure TCRC16.UpdateLSB(Data: PByte; Count: Cardinal);
var
  Index: NativeUInt;
begin
  for Index := NativeUInt(Data) to NativeUInt(Data) + Pred(Count) do
    FValue^ := FValue^ shl 8 xor FTable[Byte(FValue^ shr 8) xor ReverseByte(PByte(Index)^)];
end;

procedure TCRC16.UpdateMSB(Data: PByte; Count: Cardinal);
var
  Index: NativeUInt;
begin
  for Index := NativeUInt(Data) to NativeUInt(Data) + Pred(Count) do
    FValue^ := FValue^ shl 8 xor FTable[Byte(FValue^ shr 8) xor PByte(Index)^];
end;

const
  CRC16Test1: array of Byte = [$02, $01, $00, $02, $01, $14];
  CRC16Test2: array of Byte = [$02, $01, $00, $02, $01, $13];
 
begin
  try
    with TCRC16.Create(CRC16BYPASS) do
    try
      WriteLn('0x', CalcCRC16(PByte(CRC16Test1), Length(CRC16Test1)).ToHexString(4));
      WriteLn('0x', CalcCRC16(PByte(CRC16Test2), Length(CRC16Test2)).ToHexString(4));
    finally
      Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
end.