兵锋无双txt下载校对:计算crc的完整程序

我给你delphi的CRC算法，这个文件可以直接使用

unit Main;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
GenPoly8Edit: TEdit;
GenPoly16Edit: TEdit;
GenPoly32Edit: TEdit;
TestCRC8Btn: TButton;
TestCRC16Btn: TButton;
TestCRC32Btn: TButton;
CalCRC8Btn: TButton;
CalCRC16Btn: TButton;
CalCRC32Btn: TButton;
CRC8ResultEdit: TEdit;
CRC16ResultEdit: TEdit;
CRC32ResultEdit: TEdit;
procedure FormCreate(Sender: TObject);
procedure TestCRC16BtnClick(Sender: TObject);
procedure TestCRC8BtnClick(Sender: TObject);
procedure TestCRC32BtnClick(Sender: TObject);
procedure CalCRC16BtnClick(Sender: TObject);
procedure CalCRC8BtnClick(Sender: TObject);
procedure CalCRC32BtnClick(Sender: TObject);
private
public
end;

var
Form1: TForm1;

GenPoly32: DWord;
GenPoly16: Word;
GenPoly8: Byte;
GenPoly4: Byte;
CRC32Tab: array [0..255] of DWord;
CRC16Tab: array [0..255] of Word;
CRC8Tab : array [0..255] of Byte;

implementation

{$R *.DFM}

function CalCRC16(data, crc, genpoly: Word): Word;
var i: Integer;
begin
crc := crc xor (data shl 8);
for i:=0 to 7 do
if (crc and $8000) <> 0 then
crc := (crc shl 1) xor genpoly
else crc := crc shl 1;
Result := crc;
end;

procedure InitCRC16Tab(genpoly: DWord);
var i: Integer;
begin
for i:=0 to 255 do
CRC16Tab[i] := CalCRC16(i,0,genpoly);
end;

function QuickCRC16(data, crc: Word): Word;
begin
crc := CRC16Tab[(crc shr 8) xor data] xor (crc shl 8);
Result := crc;
end;

function CalCRC8(data, crc, genpoly: Byte): Byte;
var i: Integer;
begin
crc := crc xor data;
for i:=0 to 7 do
if (crc and $01) <> 0 then
crc := (crc shr 1) xor genpoly
else crc := crc shr 1;
Result := crc;
end;

procedure InitCRC8Tab(genpoly: DWord);
var i: Integer;
begin
for i:=0 to 255 do
CRC8Tab[i] := CalCRC8(i,0,genpoly);
end;

function QuickCRC8(data, crc: Byte): Word;
begin
crc := CRC8Tab[crc xor data];
Result := crc;
end;

function CalCRC32(data, crc, genpoly: DWord): DWord;
var i: Integer;
begin
crc := crc xor data;
for i:=0 to 7 do
if (crc and $01) <> 0 then
crc := (crc shr 1) xor genpoly
else crc := crc shr 1;
Result := crc;
end;

procedure InitCRC32Tab(genpoly: DWord);
var i: Integer;
begin
for i:=0 to 255 do
CRC32Tab[i] := CalCRC32(i,0,genpoly);
end;

function QuickCRC32(data, crc: DWord): DWord;
begin
crc := CRC32Tab[Byte(crc xor data)] xor (crc shr 8);
Result := crc;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GenPoly8 := StrToInt(GenPoly8Edit.Text);
InitCRC8Tab(GenPoly8);
GenPoly16 := StrToInt(GenPoly16Edit.Text);
InitCRC16Tab(GenPoly16);
GenPoly32 := StrToInt(GenPoly32Edit.Text);
InitCRC32Tab(GenPoly32);
end;

procedure TForm1.TestCRC16BtnClick(Sender: TObject);
var data, crc, crcstart: Word;
begin
crcstart := $1234;
Memo1.Clear;
Memo1.Lines.Add('16bit CRC');
for data:=0 to 255 do
begin
crc := CalCRC16(data,crcstart,GenPoly16);
Memo1.Text := Memo1.Text + IntToHex(crc, 4) + ' ';
end;
Memo1.Lines.Add('');
Memo1.Lines.Add('16bit Quick CRC');
for data:=0 to 255 do
begin
crc := QuickCRC16(data,crcstart);
Memo1.Text := Memo1.Text + IntToHex(crc, 4) + ' ';
end;
end;

procedure TForm1.TestCRC8BtnClick(Sender: TObject);
var data, crc, crcstart: Byte;
begin
crcstart := $12;
Memo1.Clear;
Memo1.Lines.Add('8bit CRC');
for data:=0 to 255 do
begin
crc := CalCRC8(data,crcstart,GenPoly8);
Memo1.Text := Memo1.Text + IntToHex(crc, 2) + ' ';
end;
Memo1.Lines.Add('');
Memo1.Lines.Add('8bit Quick CRC');
for data:=0 to 255 do
begin
crc := QuickCRC8(data,crcstart);
Memo1.Text := Memo1.Text + IntToHex(crc, 2) + ' ';
end;
end;

procedure TForm1.TestCRC32BtnClick(Sender: TObject);
var data, crc, crcstart: DWord;
begin
crcstart := $12345678;
Memo1.Clear;
Memo1.Lines.Add('32bit CRC');
for data:=0 to 255 do
begin
crc := CalCRC32(data,crcstart,GenPoly32);
Memo1.Text := Memo1.Text + IntToHex(crc, 8) + ' ';
end;
Memo1.Lines.Add('');
Memo1.Lines.Add('32bit Quick CRC');
for data:=0 to 255 do
begin
crc := QuickCRC32(data,crcstart);
Memo1.Text := Memo1.Text + IntToHex(crc, 8) + ' ';
end;
end;

function GetDataFromText(str: String): String;
var i, p1, p2: Integer;
begin
Result := '';
while str <> '' do
begin
i := 0;
p1 := Pos(' ',str);
p2 := Pos(#13#10,str);

if p1=1 then
begin Delete(str,1,1); continue; end;
if p2=1 then
begin Delete(str,1,2); continue; end;

if (p1=0) and (p2=0) and (str<>'') then
begin
i := StrToIntDef('$'+str,0);
Delete(str,1,Length(str));
end;
if ((p1>0) and (p2=0)) or
((p1>0) and (p2>0) and (p1<p2)) then
begin
i := StrToIntDef('$'+Copy(str,1,p1-1),0);
Delete(str,1,p1);
end;
if ((p1=0) and (p2>0)) or
((p1>0) and (p2>0) and (p1>p2)) then
begin
i := StrToIntDef('$'+Copy(str,1,p2-1),0);
Delete(str,1,p2+1);
end;
Result := Result + Chr(i);
end;
end;

procedure TForm1.CalCRC16BtnClick(Sender: TObject);
var
i: Integer;
databuf: String;
data, crc: Word;
begin
databuf := GetDataFromText(Memo1.Text);
crc := 0;
for i:=1 to Length(databuf) do
begin
data := Ord(databuf[i]);
crc := CalCRC16(data,crc,GenPoly16);
end;
CRC16ResultEdit.Text := 'CRC16 = ' + IntToHex(crc,4);
end;

procedure TForm1.CalCRC8BtnClick(Sender: TObject);
var
i: Integer;
databuf: String;
data, crc: Byte;
begin
databuf := GetDataFromText(Memo1.Text);
crc := 0;
for i:=1 to Length(databuf) do
begin
data := Ord(databuf[i]);
crc := CalCRC8(data,crc,GenPoly8);
end;
CRC8ResultEdit.Text := 'CRC8 = ' + IntToHex(crc,2);
end;

procedure TForm1.CalCRC32BtnClick(Sender: TObject);
var
i: Integer;
databuf: String;
data, crc: DWord;
begin
databuf := GetDataFromText(Memo1.Text);
crc := 0;
for i:=1 to Length(databuf) do
begin
data := Ord(databuf[i]);
crc := CalCRC32(data,crc,GenPoly32);
end;
CRC32ResultEdit.Text := 'CRC32 = ' + IntToHex(crc,8);
end;

end.