Einzelnen Beitrag anzeigen

samso

Registriert seit: 29. Mär 2009
439 Beiträge
 
#11

AW: CRC von C in Delphi übersetze

  Alt 25. Mär 2023, 13:03
Folgendes Programm liefert bei mir das korrekt Ergebnis

Delphi-Quellcode:
program CRCTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils;

function cal_crc_half(pin: PByte; len: Byte): Word;
var
  crc: Word;
  da: Byte;
  ptr: PByte;
  bCRCHign: Byte;
  bCRCLow: Byte;
const
  crc_ta: array[0..15] of Word = ($0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,
                                  $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef);
begin
  ptr := pin;
  crc := 0;
  while (len > 0) do
  begin
    da := crc shr 12; // CRC high four bits
    crc := crc shl 4; // The CRC is shifted to the right by 4 bits, which is equivalent to taking the lower 12 bits of the CRC.
    crc := crc xor crc_ta[da xor (ptr^ shr 4)]; // Add the upper 4 bits of the CRC and the first half of the byte and look up the table to calculate the CRC, then add the remainder of the last CRC.
    da := crc shr 12; // CRC high four bits
    crc := crc shl 4; // The CRC is shifted to the right by 4 bits, which is equivalent to taking the lower 12 bits of the CRC.
    crc := crc xor crc_ta[da xor (ptr^ and $0f)]; // Add the upper 4 bits of the CRC and the last half of the byte and look up the table to calculate the CRC, then add the remainder of the last CRC.
    Inc(ptr);
    Dec(len);
  end;
  bCRCLow := crc and $FF;
  bCRCHign := crc shr 8;
  if (bCRCLow = $28) or (bCRCLow = $0d) or (bCRCLow = $0a) then
    Inc(bCRCLow);
  if (bCRCHign = $28) or (bCRCHign = $0d) or (bCRCHign = $0a) then
    Inc(bCRCHign);
  crc := (bCRCHign shl 8) + bCRCLow;
  Result := crc;
end;

var
  Test: AnsiString;
  CRC: Word;
begin
  try
    Test := 'QPIGS';
    CRC := cal_crc_half(Pointer(Test), Length(Test));
    writeln(IntToHex(CRC, 4));
    ReadLn;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
  Mit Zitat antworten Zitat