Помощь в подсчете CRC (x^15 + 1)

[Shurik Hacker]

Пишу программу для передачи данных на железку, нужно рассчитать контрольную сумму передаваемой команды.

Описание алгоритма:
The two CRC bytes are calculated according to the formula x^15 + 1. In the calculation are included all data bytes plus the byte for block end. Every byte passes through the calculation register from teh MSB to LSB.
Three working bytes are used - S1, S0 and TR
S1 - Most significant byte from the CRC ( it is transmitted immediatelly after END)
S0 - Least significant byte from the CRC ( It is transmitted after S1)
TR - the current transmitted byte in the block.

The CRC is calculated as follows:
1. S1 and S0 are zeroed
2. TR is loaded with the current transmitted byte. The byte is transmitted.
3. Points 3.1 and 3.2 are executed 8 times:
3.1. S1, S0 and TR are shifted one bit to the left.
3.2. If the carry bit from S1 is 1, the MSB of S1 and LSB of S0 are inverted.
Points 2 and 3 are executed for all bytes, included in the calculation of the CRC - from the first byte after BEG up to and including byte END.
4. TR is loaded with 0 and point 3 is executed
5. TR is loaded with 0 and point 3 is executed
6. Byte S1 is transmitted
7. Byte S0 is transmitted

Примеры команд и их контрольные суммы (2 байта) (в ASCII):
Команда: R0;1;<CR>
Сумма: Н.

Команда: R0;2;<CR>
Сумма: M-

Команда: R0;4;<CR>
Сумма: Н*

Команда: R0;5;<CR>
Сумма: 2Ф

где <CR> = 1 байт = #13

Пытался сам написать программу для вычисления CRC, но суммы у меня выходят совершенно другие, прошу помощи экспертов в этом вопросе.

Мой не правильно работающий код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function ShowBits(AVal: Byte):string;
var i: Byte;
begin
Result:='';
  for i := (SizeOf(AVal) * 8 - 1)  downto 0 do
    begin
      if ((AVal shr i) and 1) = 1 then
        Result:=Result+'1'
      else
        Result:=Result+'0';
    end;
end;
function Pow(ABase, AExp: Byte): Int64;
var i: Integer;
begin
  Result := 1;
  for i := 1 to AExp do
    Result := Result * ABase;
end;
function RoL(AVal: Byte): Byte;
var MSB, S: Byte;
begin
  S := (SizeOf(AVal) * 8) - 1;
 
  MSB := (AVal and Pow(2, S)) shr S;
  AVal := AVal shl 1;
  AVal := AVal or MSB;
  Result := AVal;
end;
function RoR(AVal: Byte): Byte;
var LSB: Byte;
begin
  LSB := AVal and 1;
  AVal := AVal shr 1;
  AVal := AVal or (LSB shl (SizeOf(AVal) * 8 - 1));
  Result := AVal;
end;

function GetLSB(AVal: Byte):Byte;
begin
     Result := AVal and 1;
end;
function GetMSB(AVal: Byte):Byte;
var S: Byte;
begin
     S := (SizeOf(AVal) * 8) - 1;
     Result := (AVal and Pow(2, S)) shr S;
end;
function InvertMSBinByte(AVal: Byte):Byte;
begin
     Result := AVal xor (1 shl 7);
end;
function InvertLSBinByte(AVal: Byte):Byte;
begin
     Result := AVal xor (1 shl 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var TR,S1,S0,i,z,MSB: Byte;
Str: string;
begin
     S1:=0; S0:=0;
     Str:='R0;1;'+#13;
     for z:=1 to length(Str) do
     begin
     TR:= ord(Str[z]);
     for i:=1 to 8 do
     begin
     MSB:=GetMSB(TR);
     TR:=RoL(TR);
     S1:=RoL(S1);
     S0:=RoL(S0);
     if MSB=1 then
     begin
     S1:=InvertMSBinByte(S1);
     S0:=InvertLSBinByte(S0);
     end;
     end;
     end;
     showMessage(Char(S1)+Char(S0));
end;

end.

[Shurik Hacker]

Нашел рабочий код на php, как бы перевести его на delphi

<?php
function crc16($crc, $byte) {
    $crc = ($crc << 8) + $byte;
    for ($k = 0; $k < 8; $k++)
        $crc = ($crc & 0x800000) == 0 ? $crc << 1 : ($crc << 1) ^ 0x800100;
    $crc = ($crc >> 8) & 0xffff;
    return $crc;
}

$crc = 0;
$crc = crc16($crc, ord("R"));
$crc = crc16($crc, ord("0"));
$crc = crc16($crc, ord(";"));
$crc = crc16($crc, ord("1"));
$crc = crc16($crc, ord(";"));
$crc = crc16($crc, 13);
$crc = crc16($crc, 0);
$crc = crc16($crc, 0);
echo dechex($crc);

?>

[Shurik Hacker]

Пришлось всё делать самому =)
Вот рабочий код

function crc16(crc: longword; b: byte): word;
var k: byte;
begin
     crc := (crc shl 8) + b;
     for k:=0 to 7 do
     begin
     if  (crc and $800000) = 0 then
     crc := crc shl 1 else
     crc := (crc shl 1) xor $800100;
     end;
     crc := (crc shr 8) and $ffff;
     result:= crc;
end;
procedure TForm1.Button1Click(Sender: TObject);
var crc: word;
begin
     crc:=0;
     crc:=crc16(crc,ord('R'));
     crc:=crc16(crc,ord('0'));
     crc:=crc16(crc,ord(';'));
     crc:=crc16(crc,ord('1'));
     crc:=crc16(crc,ord(';'));
     crc:=crc16(crc,13);
     crc:=crc16(crc,0);
     crc:=crc16(crc,0);
     ShowMessage(inttostr(crc));
end;

[Shurik Hacker]

Допиленная версия, на входе строка с командой, на выходе строка с CRC

function crc16(crc: longword; b: byte): word;
var k: byte;
begin
     crc := (crc shl 8) + b;
     for k:=0 to 7 do
     begin
     if  (crc and $800000) = 0 then
     crc := crc shl 1 else
     crc := (crc shl 1) xor $800100;
     end;
     crc := (crc shr 8) and $ffff;
     result:= crc;
end;
function CommandToCRC(c:string):string;
var i: byte;
crc: word;
begin
     crc:=0;
     for i:=1 to length(c) do
     begin
     crc:=crc16(crc,ord(c[i]));
     end;
     crc:=crc16(crc,0);
     crc:=crc16(crc,0);
     Result:=Char(CRC div 256)+Char(CRC mod 256);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     ShowMessage(CommandToCRC('R0;1;'+#13));
end;

[Shurik Hacker]

Отличный форум, столько желающих помочь =)
Тему можно закрывать

[Black Fregat]

Вот и славно, тогда я свой код убираю

[digitalis]

Иногда "помощь клуба" заключается в том, что формулируя вопрос, начинаешь "глубже думать" - и додумываешься , у самого так бывало. А мне в прошлом тысячелетии пришлось считать CRC16, применил табличный метод - там даже думать не надо: берешь из таблицы констант очередное значение и ... Если в дальнейшей жизни понадобится - могу кинуть ссылку.
А в Новый год - так в основном не помогать, а пьянствовать водку

[IliaIT]

любое описание протокола RTU приборов содержит процедуру расчёта crc16. в как минимум 3 х языках программирования. думать не надо тупо копировать. плюс полином ещё разный можно ставить и начальное значение.