Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

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

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

Пришлось всё делать самому =)
Вот рабочий код
Код:
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, 12:43   #4
Shurik Hacker
Проги на заказ
Пользователь
 
Аватар для Shurik Hacker
 
Регистрация: 22.05.2007
Сообщений: 41
По умолчанию

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

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

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

Последний раз редактировалось Black Fregat; 02.01.2018 в 12:56. Причина: Зря возился только..
Black Fregat вне форума Ответить с цитированием
Старый 02.01.2018, 14:31   #7
digitalis
Старожил
 
Аватар для digitalis
 
Регистрация: 04.02.2011
Сообщений: 4,534
По умолчанию

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

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

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ошибка при подсчете количества 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