DELPHISPCOMM温控器Modbus协议通讯设计.doc

DELPHI SPCOMM温控器Modbus协议通讯设计QQ:64782489陈建光unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SPComm, ExtCtrls,StrUtils;type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; Button3: TButton; ComboBox1: TComboBox; Label2: TLabel; GroupBox1: TGroupBox; Label3: TLabel; ComboBox2: TComboBox; Memo2: TMemo; GroupBox2: TGroupBox; Button4: TButton; Button5: TButton; Label5: TLabel; Button6: TButton; Label1: TLabel; Label6: TLabel; Label4: TLabel; Label7: TLabel; ComboBox3: TComboBox; ComboBox4: TComboBox; ComboBox5: TComboBox; Comm1: TComm; GroupBox3: TGroupBox; Panel1: TPanel; Panel2: TPanel; Label8: TLabel; Label9: TLabel; Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label15: TLabel; Panel3: TPanel; Panel4: TPanel; Button7: TButton; Button9: TButton; Button10: TButton; Timer1: TTimer; Label14: TLabel; Panel5: TPanel; Label16: TLabel; Edit1: TEdit; Label17: TLabel; Edit2: TEdit; Label18: TLabel; Edit3: TEdit; Label19: TLabel; Edit4: TEdit; Edit5: TEdit; Label20: TLabel; Label21: TLabel; Edit6: TEdit; Button8: TButton; Label22: TLabel; Edit7: TEdit; Button12: TButton; Edit8: TEdit; Label23: TLabel; Edit9: TEdit; Label25: TLabel; Panel6: TPanel; Edit10: TEdit; Label24: TLabel; Edit11: TEdit; Label26: TLabel; Label27: TLabel; Button11: TButton; Button13: TButton; Timer2: TTimer; procedure SetComPort(); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word); procedure Button3Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button7Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button9Click(Sender: TObject); procedure Button10Click(Sender: TObject); procedure Button11Click(Sender: TObject); procedure Button13Click(Sender: TObject); procedure Timer2Timer(Sender: TObject); /function CalCRC16(AData:array of Byte;AStart,AEnd:Integer):Word; /function returnCRC16(vStr1:String):String; private Private declarations public Public declarations end;var Form1: TForm1; viewstring:string; /定义全局字符串 rbuf,sbuf:array of byte; /定义全局可变字节数组 Cur_Qry_Str: array1.32 of string; /当前查询字符串 Btn_Qry_Str,Tmr_Qry_Str:array1.32 of string; /按钮、定时器返回字符串数组 Btn_Rtn_Str,Tmr_Rtn_Str:array1.32 of string; /按钮、定时器返回字符串数组 cur_wd,Cur_wd_p,set_wd,Cur_Mode,Open_sta:array1.32 of integer; /设置当前温度、设置温度、开关状态数组 implementation$R *.dfm/=此处用于自动获取系统的串口数目以及名称，调用api函数实现相关功能=procedure EnumComPorts(Ports: TStrings);varKeyHandle: HKEY;ErrCode, Index: Integer;ValueName, Data: string;ValueLen, DataLen, ValueType: DWORD;TmpPorts: TStringList;beginErrCode := RegOpenKeyEx( HKEY_LOCAL_MACHINE, HARDWAREDEVICEMAPSERIALCOMM, 0, KEY_READ, KeyHandle);if ErrCode ERROR_SUCCESS then Exit; / raise EComPort.Create(CError_RegError, ErrCode);TmpPorts := TStringList.Create;try Index := 0; repeat ValueLen := 256; DataLen := 256; SetLength(ValueName, ValueLen); SetLength(Data, DataLen); ErrCode := RegEnumValue( KeyHandle, Index, PChar(ValueName), Cardinal(ValueLen), nil, ValueType, PByte(PChar(Data), DataLen); if ErrCode = ERROR_SUCCESS then begin SetLength(Data, DataLen); TmpPorts.Add(Data); Inc(Index); end else if ErrCode ERROR_NO_MORE_ITEMS then exit; /raise EComPort.Create(CError_RegError, ErrCode); until (ErrCode ERROR_SUCCESS) ; TmpPorts.Sort; Ports.Assign(TmpPorts);finally RegCloseKey(KeyHandle); TmpPorts.Free;end;end;/=替换字符串中的空格函数=function Trimplace(str: string): string; var tmp: string; p : Integer; begin tmp := Trim(str); while Pos( ,tmp)0 do begin p := Pos( ,tmp); tmp := Copy(tmp,1,p-1)+Copy(tmp,p+1,Length(tmp)-p); end; Result := tmp; end;/字符串转成16进制代码function strToHexStr(str:string):string;varc:char;ss:string;i:integer;beginwhile str do begin c:=str1; ss:=ss+format(%0x,ord(c); delete(str,1,1);end;strtohexStr:= ss;end;/16进制字符串转换成字符串function HexStrToStr(const S:string):string;vart:Integer;ts:string;M,Code:Integer;begint:=1;Result:=;while t=Length(S) dobegin /xlh 2006.10.21 while (tLength(S)or(not (St+1 in 0.9,A.F,a.f) then ts:=$+St else ts:=$+St+St+1; Val(ts,M,Code); if Code=0 then Result:=Result+Chr(M); inc(t,2);end;end;/替换字符串函数function replacing(s,source,target:string):string; var site,StrLen:integer; begin source在S中出现的位置 site:=pos(source,s); source的长度 StrLen:=length(source); 删除source字符串 delete(s,site,StrLen); 插入target字符串到S中 insert(target,s,site); 返回新串 replacing:=s; end;/ CalCRC16用于计算Modbus RTU的CRC16/ 多项式公式为X16+X15+X2+1/function CalCRC16(AData:array of Byte;AStart,AEnd:Integer):Word;const GENP=$A001; /多项式公式X16+X15+X2+1（1100 0000 0000 0101）var crc:Word; i:Integer; tmp:Byte;procedure CalOneByte(AByte:Byte); /计算1个字节的校验码varj: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(ADatai); Result:=crc;end;function returnCRC16(vStr1:String):String;var Data:array0.255 of Byte; i,j,Count:Integer; Res:Word; ResStr:string; szData:string;begin szData:=Trimplace(vStr1); /读入欲校验的字符串 Count:=round(Length(Trimplace(vStr1)/2); /读入需要计算的字符串长度 i:=1; j:=0; for j:=0 to Count-1 do begin if (i mod 2)=0 then /每2个字符放入一个字节中 i:=i+1; if i=Length(szData) then exit; Dataj:=StrToInt($+copy(szData,i,2); /取出字符并转换为16进制数 i:=i+1; end; /showmessage(inttostr(Count-1); Res:=CalCRC16(Data,Low(Data),Count-1); ResStr:=IntToHex(Res,4); Result:=RightStr(ResStr,2)+ +LeftStr(ResStr,2); /两个字节对调*end;/=设置串口=procedure TForm1.SetComPort();begin /获取计算机中的串口列表，并设置当前设备的串口号 EnumComPorts(ComboBox1.Items); if ComboBox1.Items.Count0 then begin try ComboBox1.ItemIndex:=0; /ComboBox1.Items.Count-1; Comm1.CommName:=ComboBox1.Text; Comm1.BaudRate:=StrtoInt(ComboBox2.Text); /设置串口的当前波特率 Comm1.StopComm; /打开之前先关闭串口 Comm1.StartComm; / Label1.Caption:=串口状态：+ComboBox1.Text+串口已打开; except Label1.Caption := 状态：+ComboBox1.Text+串口打开失败; end; end else begin Label1.Caption:=串口状态：+ComboBox1.Text+串口已关闭; end; /showmessage(inttostr(ComboBoxComList.Items.Count);end;/=打开串口=procedure TForm1.Button1Click(Sender: TObject);begin try Comm1.BaudRate:=StrtoInt(ComboBox2.Text); /设置串口的当前波特率 Comm1.CommName:=ComboBox1.Text; if ComboBox3.Text=Even(偶) then /设置奇偶校验 Comm1.Parity:=Even; if ComboBox3.Text=Mark(标记) then Comm1.Parity:=Mark; if ComboBox3.Text=None(无) then Comm1.Parity:=None; if ComboBox3.Text=Odd(奇) then Comm1.Parity:=Odd; if ComboBox3.Text=Space(空格) then Comm1.Parity:=Space; if ComboBox4.Text=5 then /设置数据位 Comm1.ByteSize:=_5; /设置数据位 if ComboBox4.Text=6 then Comm1.ByteSize:=_6; /设置数据位 if ComboBox4.Text=7 then Comm1.ByteSize:=_7; /设置数据位 if ComboBox4.Text=8 then Comm1.ByteSize:=_8; /设置数据位 if ComboBox5.text=1 then /设置停止位 Comm1.StopBits:=_1; if ComboBox5.text=1.5 then Comm1.StopBits:=_1_5; if ComboBox5.text=2 then Comm1.StopBits:=_2; comm1.StopComm; comm1.StartComm; Label1.Caption:=状态：+ComboBox1.Text+串口已开始捕获 except Label1.Caption := 状态：+ComboBox1.Text+串口打开失败; end; /Label1.Caption:=inttoStr(Comm1.CommPort); /Label1.Caption:=InttoStr(Comm1.BaudRate);end;/关闭串口procedure TForm1.Button2Click(Sender: TObject);begin comm1.StopComm; Label1.Caption := 状态：+ComboBox1.Text+串口已停止捕获;end;/=设置串口号=procedure TForm1.FormCreate(Sender: TObject);begin SetComPort();end;/=自定义发送数据过程=procedure senddata;vari:integer;commflg:boolean;begin viewstring:=; commflg:=true; /showmessage(inttostr(high(sbuf); for i:=1 to high(sbuf) do begin if not Fm1.writecommdata(sbufi,1) then begin commflg:=false; break; end; /发送时字节间的延时 sleep(1); viewstring:=viewstring+inttohex(sbufi,2)+ ; if not commflg then messagedlg(发送失败 !,mterror,mbyes,0); end; viewstring:=发送+viewstring; Form1.memo1.lines.add(viewstring); /Form1.memo1.lines.add();end;/ =串口发送数据=procedure sentcustom(SqrStr:string);var str11:string ; i,j,k:integer; tmpstr:string;begin if SqrStr then begin str11:=Trimplace(SqrStr); /替换字符串中的所有空格 i:=round(length(str11)/2); /获得字符串长度,除2取整后加1 /showmessage(inttostr(i); setlength(sbuf,i+1); /重新设定发送数组范围 /showmessage(inttostr(high(sbuf); for j:=1 to i do begin tmpstr:=copy(str11,j*2-1,2); /showmessage(tmpstr); if tmpstr= then tmpstr:=00; sbufj:=byte(strtoint($+tmpstr); /将变量转换为byte数组 end; end else begin setlength(sbuf,9); sbuf1:=byte($01); sbuf2:=byte($03); sbuf3:=byte($00); sbuf4:=byte($00); sbuf5:=byte($00); sbuf6:=byte($05); sbuf7:=byte($85); sbuf8:=byte($C9); end; senddata;end;/=接收数据=procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word); type ss=array1.8192of char ; var str1:ss; i:integer; s:array0.8192 of char ; n:integer; string1:string;begin str1:=Buffer; /s=(0,1,2,3.E) for i:=0 to 9 do si:=chr(48+i); for i:=10 to 15 do si:=chr(55+i); string1:=; for i:=1 to bufferlength do begin n:=ord(str1i); string1:=string1+sn div 16+sn mod 16+ ; / 除取整 除取余 /listbox1.Items.add(接收 + sn div 16+sn mod 16 ); end; /转换字符串完毕后，清空buffer ZeroMemory(buffer,0); /根据过滤状态，调用replacing函数替换字符串 if label5.Caption=状态：已停止过滤 then begin string1 :=string1; end else begin for i:=0 to memo2.Lines.Count-1 do begin string1:=replacing(string1,trim(memo2.Lines.Stringsi),); end; string1:=replacing(string1,82 71 14 01 08 ,); string1:=replacing(string1,81 33 00 00 09 80 33 00 00 08 ,); end; if trim(string1) then begin memo1.Lines.Add(接收+string1); Tmr_Rtn_Str1:= string1 end; if trim(string1) then begin memo1.Lines.Add(接收+string1); for i:=1 to 16 do begin if Tmr_Qry_Stri=01 03 00 00 00 05 then begin Tmr_Rtn_Stri:= string1; Tmr_Qry_Stri:=; end else Tmr_Qry_Stri:=; end; end;end;/=清除MEMO文本框中的数据=procedure TForm1.Button3Click(Sender: TObject);begin memo1.Clear;end;procedure TForm1.Button4Click(Sender: TObject);begin label5.Caption:=状态：已开始过滤end;procedure TForm1.Button5Click(Sender: TObject);begin label5.Caption:=状态：已停止过滤end;procedure TForm1.Button6Click(Sender: TObject);begin memo2.Clear;end;/查询状态函数function Return_Sta_Sting(SqrStr:string):String;vari:integer;Cur_CRC16Str,End_Sqr_Str:string;begin for i:=1 to 32 do /循环地址码132,将查询返回值保存至数组 begin if strtoint(copy(Trimplace(SqrStr),1,2)=i then begin Cur_CRC16Str:=returnCRC16(SqrStr); /计算CRC16校验码 End_Sqr_Str:=SqrStr + +Cur_CRC16Str; /最终查询字符串 sentcustom(End_Sqr_Str); /发送查询指令 Result:=End_Sqr_Str end end; end;/定时返回状态值procedure TForm1.Timer1Timer(Sender: TObject);vari,Ad_id:integer; /循环用整数变量Tmr_Qry_Str1:string; /定时器状态查询字符串变量Tmr_Rtn_Str1:string; /定时器状态返回字符串变量begin Tmr_Qry_Str1:=01 03 00 00 00 05; /查询字符串 Ad_id:=StrToInt($+Edit1.Text); /查询字符串地址码 try For i:=1 to 16 do begin if i=Ad_id then begin Tmr_Qry_Stri:=Tmr_Qry_Str1; /为状态查询字符串数组赋值 Return_Sta_Sting(Tmr_Qry_Str1); /执行状态查询 Tmr_Rtn_Str1:=Trimplace(Tmr_Rtn_Stri); /状态返回值 /label28.caption:=Tmr_Rtn_Str1; end; if (Tmr_Rtn_Str1) and (copy(Tmr_Rtn_Str1,5,2)=0A) and (round(length(Tmr_Rtn_Str1)/2)=15) then begin Edit7.text:=Tmr_Rtn_Str1; Label8.Caption:=IntToStr(trunc(StrToInt($+copy(Tmr_Rtn_Str1,7,4)/10); /当前温度 Edit8.Text:=Label8.Caption; Label9.Caption:=.+IntToStr(StrToInt($+copy(Tmr_Rtn_Str1,7,4)-(trunc(StrToInt($+copy(Tmr_Rtn_Str1,7,4)/10)*10); Label13.Caption:=IntToStr(trunc(StrToInt($+copy(Tmr_Rtn_Str1,11,4)/10); /设置温度 Edit9.Text:=Label13.Caption; if StrToInt($+copy(Tmr_Rtn_Str1,15,4)=1 then /当前模式 begin Label14.Visible:=false; Label27.Visible:=true; Edit11.Text:=01; end else begin Label14.Visible:=true; Label27.Visible:=false; Edit11.Text:=00; end; if StrToInt($+copy(Trimplace(Tmr_Rtn_Str1),23,4)=1 then /当前状态 begin Panel6.Visible:=false; Edit10.Text:=01; end else begin Panel6.Visible:=true; Edit10.Text:=00; end; end; end; except end;end;/=开关按钮=procedure TForm1.Button7Click(Sender: TObject);vari,Ad_id:integer;Btn_Qry_Str1:string;begin Btn_Qry_Str1:=01 06 00 04 00 00; /关闭 Ad_id:=StrToInt($+Edit1.Text); /查询字符串地址码 for i:=1 to 16 do begin if i=Ad_id then begin if Edit10.Text=01 then begin Btn_Qry_Str1:=01 06 00 04 00 00; /关闭 Btn_Qry_Stri:=Btn_Qry_Str1; Edit6.Text:=Return_Sta_Sting(Btn_Qry_Str1); /打开 Edit10.Text:=00; Edit1.Text:=01; /地址码