[rodionov_uv]

Имеем от производителя прибора функцию по подсчету CRC24 посылки прибору

Код:

function crc_octets (octets: PChar; len: Integer): Integer;
const
CRC24_INIT = $00b704ce;
CRC24_POLY = $01864cfb;
var
crc: Integer;
temp: Integer;
i: Integer;
begin
crc := CRC24_INIT;
while (len <> 0) do
begin
   Dec(len);
   temp := Integer (octets^);
   Inc(octets);
   temp := temp shl 16;
   crc := crc xor temp;
   for i := 0 to 7 do
   begin
     crc := crc shl 1;
     if (crc and $01000000) <> 0 then
       crc := crc xor CRC24_POLY;
   end;
end;
crc := crc and $00ffffff;
result := crc;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text := IntToHex(crc_octets(Addr(Edit1.Text[1]), 10), 6);
end;

При вводе в Edit1 строки ffff012001 вмето 452E2B получаем BC5DD3.
Что я делаю не так?

Админ: Пользуемся тегами при оформлении кода!

[lmikle]

Посмтотри тут: http://www.delphigroups.info/2/b3/408419.html
Или вообще, просто скачай вот этот модуль и пользуй: https://github.com/danieleteti/dsfc/...Part_I/CRC.pas

[lmikle]

Вот правильный код из первой ссылки:

Код:

function CRC24(s : String) : Cardinal;
const
  crcInit = $000B704CE;
  crcPoly = $001864CFB;
var
  i,k: integer;
begin
  Result:= crcInit;
  for k:=1 to length(s) do
    begin
      Result:= Result xor (ord(s[k]) shl 16);
      for i:=0 to 7 do
        begin
          Result:= Result shl 1;
          if (Result and $1000000) <> 0 then
            Result:= Result xor crcPoly;
        end;
    end;
  Result:= Result and $FFFFFF;
end;

Но он, вроде, дает тот же результат, что и твой.
Ты уверен, что там на вход идет строка??? Может там ffff012001 это бинарное значение?

[rodionov_uv]

ffff012001 это посылка в HEXе в СОМ порт прибору, а полная посылка состоит 3байта CRC24 и 5байт запрос, ну это в этом примере. Я просто набросываю по кирпичикам, а потом все соединяю в общий проект.

Модуль CRC пробовал, но почему то он работает не коректно. У производителя на одну систему опроса используется три вида подсчета CRC это CRC24, CRC16 и CRC8. С CRC16 и CRC8 разобрался, а вот с этой ну никак.

Это система дистанционного опроса электросчетчико в Меркурий.

[rodionov_uv]

Все спасибо, разобрался. Вот полностью рабочий код может кому пригодится.

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function crc_octets (octets: PChar; len: Integer): Integer;
const
CRC24_INIT = $00b704ce;
CRC24_POLY = $01864cfb;
var
crc: Integer;
temp: Integer;
i: Integer;
begin
crc := CRC24_INIT;
while (len <> 0) do
begin
   Dec(len);
   temp := Integer (octets^);
   Inc(octets);
   temp := temp shl 16;
   crc := crc xor temp;
   for i := 0 to 7 do
   begin
     crc := crc shl 1;
     if (crc and $01000000) <> 0 then
       crc := crc xor CRC24_POLY;
   end;
end;
crc := crc and $00ffffff;
result := crc;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
WritteBuffer: array of Byte;
i, k, len: Integer;
j: Real;
s: String;
x: Byte;
begin
  if (Edit1.Text = '') then
  begin
    ShowMessage('У вас заполнены не все поля');
    Exit;
  end
  else
  begin
    Edit2.Text := '';
    len := Length(Edit1.Text);
    if len mod 2 = 0 then
    begin
      j := len / 2;
      len := Round(j);
      SetLength(WritteBuffer, len);
      if RadioGroup1.ItemIndex = 0 then
      Edit2.Text := IntToHex(crc_octets(Addr(Edit1.Text[1]) , len*2), 6)
      else
        begin
          k := 1;
          s := '';
          for i := 0 to len-1 do
          begin
            s := '$' + Copy(Edit1.Text, k, 2);
            x := StrToInt(Copy(s, 1, 3));
            WritteBuffer[i] := x;
            k := k + 2;
          end;
          Edit2.Text := IntToHex(crc_octets(PChar(WritteBuffer), len), 6);
        end;
      end
    else
      begin
        ShowMessage('Не коректно введены данные');
        Exit;
      end;
    end;
end;

end.

Сама прога
CRC24.rar