Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 02.01.2018, 11:46   #1
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
Репутация: 26

icq: 375862898
По умолчанию Помощь в подсчете CRC (x^15 + 1)

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

Описание алгоритма:
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 вне форума   Ответить с цитированием
Старый 02.01.2018, 12:47   #2
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
Репутация: 26

icq: 375862898
По умолчанию

Нашел рабочий код на 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 вне форума   Ответить с цитированием
Старый 02.01.2018, 13:34   #3
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
Репутация: 26

icq: 375862898
По умолчанию

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

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 вне форума   Ответить с цитированием
Старый 02.01.2018, 13:43   #4
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
Репутация: 26

icq: 375862898
По умолчанию

Допиленная версия, на входе строка с командой, на выходе строка с 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 вне форума   Ответить с цитированием
Старый 02.01.2018, 13:45   #5
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
Репутация: 26

icq: 375862898
По умолчанию

Отличный форум, столько желающих помочь =)
Тему можно закрывать
__________________
Делфист - это звучит гордо!
Shurik Hacker вне форума   Ответить с цитированием
Старый 02.01.2018, 13:54   #6
Black Fregat
Программист
Участник клуба
 
Аватар для Black Fregat
 
Регистрация: 23.06.2009
Сообщений: 782
Репутация: 570
По умолчанию

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

Последний раз редактировалось Black Fregat; 02.01.2018 в 13:56. Причина: Зря возился только..
Black Fregat вне форума   Ответить с цитированием
Старый 02.01.2018, 15:31   #7
digitalis
Участник клуба
 
Аватар для digitalis
 
Регистрация: 04.02.2011
Адрес: Минск
Сообщений: 706
Репутация: 313
По умолчанию

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

Последний раз редактировалось digitalis; 02.01.2018 в 15:37.
digitalis вне форума   Ответить с цитированием
Старый 09.01.2018, 15:43   #8
IliaIT
Участник клуба
 
Аватар для IliaIT
 
Регистрация: 17.03.2009
Сообщений: 916
Репутация: 489
По умолчанию

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

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ошибка при подсчете количества Pushkin1983 Microsoft Office Access 3 07.06.2014 08:15
Баг в отрисовке и подсчете на Канве Silwerwing Помощь студентам 1 23.04.2013 19:04
Баг в отрисовке и подсчете на Канве Silwerwing Общие вопросы Delphi 0 14.04.2013 12:08
Не выводит результат о подсчете строк. Predator199 PHP 2 06.08.2012 16:52
Ошибка в подсчете Rik_Igle Помощь студентам 4 03.12.2011 21:58


06:14.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru