unit Modbus_main; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; function CalCRC16(AData:array of Byte;AStart,AEnd:Integer):Word; procedure Button1Click(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } function TForm1.CalCRC16(AData:array of Byte;AStart,AEnd:Integer):Word; //16位CRC校验方法 const GENP=$A001; //多项式公式X16+X15+X2+1(1100 0000 0000 0101) var crc:Word; i:Integer; tmp:Byte; procedure CalOneByte(AByte:Byte); //计算1个字节的校验码 var j:Integer; begin crc:=crc xor AByte; //将数据与CRC寄存器的低8位进行异或 for j:=0 to 7 do //对每一位进行校验 begin tmp:=crc and 1; //取出最低位 crc:=crc shr 1; //寄存器向右移一位 crc:=crc and $7FFF; //将最高位置0 if tmp=1 then //检测移出的位,如果为1,那么与多项式异或 crc:=crc xor GENP; crc:=crc and $FFFF; end; end; begin crc:=$FFFF; //将余数设定为FFFF for i:=AStart to AEnd do //对每一个字节进行校验 CalOneByte(AData[i]); Result:=crc; end; procedure TForm1.Button1Click(Sender: TObject); var Data:array[0..255] of Byte; i,j,k,WordLength: integer; Edit1temp:string; Edit1Value:string; CRCtemp:string; Res :Word; begin Edit1temp := Edit1.Text; Edit1Value :=StringReplace(Edit1temp,' ','',[rfReplaceAll]); //取到待校验字符串并去掉字符串中间的所有空格 k:=Length(Edit1Value); WordLength :=trunc(k/2);//trunc函数取整数部分的值 begin i :=1; j :=0; for j:=0 to WordLength-1 do begin if (i mod 2)=0 then //每2个字符放入一个字节中 i:=i+1; if i>=Length(Edit1Value) then exit; Data[j]:=StrToInt('$'+copy(Edit1Value,i,2)); //取出字符并转换为16进制数 i:=i+1; end; Res:=CalCRC16(Data,Low(Data),WordLength-1); CRCtemp:=IntToHex(Res,4); if(WordLength<7) then Edit2.Text:=RightStr(CRCtemp,2)+' '+LeftStr(CRCtemp,2) //小于6组数说明是上位机发送的数据,需要将得到的CRC校验结果的高低位交换,再显示 else Edit2.Text:=LeftStr(CRCtemp,2)+' '+RightStr(CRCtemp,2);//大于6组数说明是上位机收到的数据,不需要将得到的CRC校验结果的高低位交换,直接显示 end end; end.