关于delphi下modbusRTU应用问题中关键CRC校验计算

modbusRTU发送和接收在delphi方面的应当资料太少了，希望这份资源能成为作这块需要的人的一个帮助，目前在接收和发送方面都没有问题，问题在CRC码的计算这里；程序的操作步骤是先输入数据；之后刷新数据（就是给发送数据变量赋值），生成校验码，之后就可以按发送键，还有一些功能键如定时发送，定时保存数据就不多讲；现在在生成CRC校验上有问题，我弄了一周了还没有弄出来，有此方面的行家试一试，看能不能弄出来，网上都是VB的，delphi都没有办法用；或到网上下载程序地址：www.zhskyland.com/modubusRTUdemo.rar      产生问题的代码主要为下面一段，但不一定是有问题
//生成16进制的校验码，就这里出问题了，计算生成不了有效的CRC校验码出来，也有可能是赋值发送数据那么代码，现在不知  在那里有问题了，
procedure TForm1.Button9Click(Sender: TObject);
var
  i:integer;
  s:string;
begin
  i:=6;
  if IsHexStr(edit6.Text) then
  begin
      strtointashex(cardinal(i),edit6.Text);
      label1.Caption:=inttostr(i);
  end;
  StrToIntAsHex(crcstart,edit8.Text);
  StrToIntAsHex(crcfunt,edit7.Text);
  IntToStrAsHex(s,tablecrc16(crcstart,crcfunt,bytearray(@Sbuf),i));
  edit7.Text:=s;
end;全部代码如下：
var
  Form1: TForm1;
  viewstring:string;
  length1,i,j,k:integer;
  rbuf:array[1..1000]of byte;
  crcfunt,crcstart:Cardinal;// 初始化值
  arrayfun:array of byte;  
implementation
uses
  radixu;{$R *.dfm}//对于查表进行CRC校验计算函数;是查表法，上面有表，放不下，没有放，可以下载了看
function tablecrc16(var crcstart1:Cardinal;Crcfunt1:Cardinal;byearray1:array of byte;const bytelength:integer):word;
var
 i:integer;
 iindex,j:integer;
 crchi,crclo:integer;
begin
 i:=0;
 crchi:=hi(crcstart1);
 crclo:=lo(crcstart1);
 for i:=0 to bytelength-1 do
 begin
     iindex:=crchi xor byearray1[j];
     crchi:=crclo xor tablecrchi[iindex];
     crclo:=tablecrclow[iindex];
     j:=j+1;
 end;
 result:=(crchi shl 8 or crclo);
 end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  richedit1.Clear;
  timer1.Enabled:=false;
  timer2.Enabled:=false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 i,j:integer;
 str:string;
begin
    str:='发送'+' '+inttostr(K)+char($0D)+char($0A);
    viewstring:='';
    form1.Comm1.WriteCommData(Pchar(arrayfun),8);
    sleep(30);
    for i:=0 to 7 do
    viewstring:=viewstring+inttohex(arrayfun[i],2)+' ';    viewstring:=str+viewstring;
    richedit1.SelStart;
    richedit1.SelAttributes.Color:=clblue;
    richedit1.Lines.Add(viewstring);
    k:=k+1;
end;procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  str:string;
  i:integer;
begin
  viewstring:='';
  move(buffer^,(Pchar(@rbuf))^,bufferlength);
  for i:=1 to bufferlength do
  begin
    viewstring:=viewstring+inttohex(rbuf[i],2)+'';
  end;
    length1:=bufferlength+length1;
    str:='接收'+'  '+inttostr(j)+'  '+inttostr(length1)+char($0D)+Char($0A);
    viewstring:=str+viewstring;
    richedit1.SelStart;
    richedit1.SelAttributes.Color:=clred;
    richedit1.Lines.Add(viewstring);
    if (tablecrc16(crcstart,crcfunt,rbuf,bufferlength)=0) then
    begin
       richedit1.Lines.Add('CRC正确');
       statusbar1.Panels[7].Text:='CRC正确';
    end else
    begin
      richedit1.Lines.Add('CRC不正确');
       statusbar1.Panels[7].Text:='CRC不正确';
    end;
    richedit1.Lines.Add(#13);
    j:=j+1; end;procedure TForm1.Button3Click(Sender: TObject);
begin
richedit1.Clear;
end;procedure TForm1.Button6Click(Sender: TObject);
begin
 j:=0;
 k:=0;
 length1:=0;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
 button1.Click;
end;procedure TForm1.Edit1Change(Sender: TObject);
begin
  timer1.Enabled:=false;
end;procedure TForm1.Button7Click(Sender: TObject);
begin
   timer1.Enabled:=false;
   timer1.Interval:=strtoint(edit1.Text);
   timer1.Enabled:=true;
end;procedure TForm1.Button8Click(Sender: TObject);
begin
timer1.Enabled:=false;
end;//生成16进制的校验码，就这里出问题了，计算生成不了有效的CRC校验码出来
procedure TForm1.Button9Click(Sender: TObject);
var
  i:integer;
  s:string;
begin
  i:=6;
  if IsHexStr(edit6.Text) then
  begin
      strtointashex(cardinal(i),edit6.Text);
      label1.Caption:=inttostr(i);
  end;
  StrToIntAsHex(crcstart,edit8.Text);
  StrToIntAsHex(crcfunt,edit7.Text);
  IntToStrAsHex(s,tablecrc16(crcstart,crcfunt,bytearray(@Sbuf),i));
  edit7.Text:=s;
end;procedure TForm1.Edit2Exit(Sender: TObject);
begin
  if not IsHexStr(edit2.Text) then
  begin
     messagebox( 0,'十六进制字节非法.示范：F0', '提示', mb_ok) ;
  end;
end;procedure TForm1.Edit3Exit(Sender: TObject);
begin
 if not IsHexStr(edit2.Text) then
  begin
     messagebox( 0,'十六进制字节非法.示范：F0', '提示', mb_ok) ;
  end;
end;procedure TForm1.Edit4Exit(Sender: TObject);
begin
 if not IsHexStr(edit2.Text) then
  begin
     messagebox( 0,'十六进制字节非法.示范：F0', '提示', mb_ok) ;
  end;
end;procedure TForm1.Edit5Exit(Sender: TObject);
begin
 if not IsHexStr(edit2.Text) then
  begin
     messagebox( 0,'十六进制字节非法.示范：F0', '提示', mb_ok) ;
  end;
end;
//这里给发送数据赋值
procedure TForm1.Button5Click(Sender: TObject);
var
  i:integer;
  j:word;
  d:byte;
  strs,str2:string;
begin
 setlength(arrayfun,8); //  这里设置发送的数据长度 if IsHexStr(edit2.Text) then //第一个发送字节
 begin
   StrToIntAsHex(Cardinal(i),edit2.Text);    //进位制转换函数
   d:=lo(i);
 end;
 arrayfun[0]:=d; if IsHexStr(edit3.Text) then     //判断是否是16进制字符
 begin
   StrToIntAsHex(Cardinal(i),edit3.Text);    //进位制转换函数
   d:=lo(i);
 end;
 arrayfun[1]:=d; if IsHexStr(edit4.Text) then     //判断是否是16进制字符
 begin
   StrToIntAsHex(Cardinal(i),edit4.Text);    //进位制转换函数
   d:=lo(i);
 end;
 arrayfun[2]:=hi(i);
 arrayfun[3]:=lo(i); if IsHexStr(edit5.Text) then     //判断是否是16进制字符
 begin
   StrToIntAsHex(Cardinal(i),edit5.Text);    //进位制转换函数
 end;
 arrayfun[4]:=hi(i);
 arrayfun[5]:=lo(i); if IsHexStr(edit7.Text) then     //判断是否是16进制字符
 begin
   StrToIntAsHex(Cardinal(i),edit8.Text);    //进位制转换函数
 end;  if IsHexStr(edit8.Text) then     //判断是否是16进制字符
   begin
     StrToIntAsHex(Cardinal(i),edit7.Text);    //进位制转换函数
   end;
     i:=6;
     j:=tablecrc16(crcstart,crcfunt,arrayfun,i); //获取CRC校验
     IntToStrAsHex(strs,j);
     edit6.Text:=strs;
     arrayfun[6]:=hi(j);
     arrayfun[7]:=lo(j);
     str2:='';
     strs:='';
   for i:=0 to 7 do
   begin
      IntToStrAsHex(strs,Arrayfun[i]); //将要发送的数据赋给strs
      str2:=str2+strs+' ';
   end;
      edit9.Text:=str2;
end;procedure TForm1.Edit10Change(Sender: TObject);
begin
timer2.Enabled:=false;
end;procedure TForm1.Button11Click(Sender: TObject);
begin
  timer2.Enabled:=false;
  timer2.Interval:=strtoint(edit10.Text);
  timer2.Enabled:=true;
end;procedure TForm1.Timer2Timer(Sender: TObject);
begin
    richedit1.Lines.SaveToFile('G:\ModbusRTUDemo\data\wwccss.rtf');
end;procedure TForm1.Button13Click(Sender: TObject);
begin
   timer2.Enabled:=false;
end;procedure TForm1.Button12Click(Sender: TObject);
begin
   winexec('C:\Program Files\Windows NT\Accessories\wordpad.exe G:\ModbusRTUDemo\data\wwccss.rtf',sw_show);
end;procedure TForm1.N2Click(Sender: TObject);
begin
try
  form1.Comm1.StartComm;
  statusbar1.Panels[1].Text:='打开';
except
   ShowMessage('打开端口错误,可能已被打开');
   StatusBar1.panels[1].Text:='关闭' ;
end;
end;procedure TForm1.N3Click(Sender: TObject);
begin
  comm1.StopComm;
end;
end.