cmdheader.pas

给出一个工业ＰＬＣ联网监控的例子

unit cmdHeader;

interface
uses SysUtils;

	function BCCLink(_StrS:string):string;
	function MkPTCmd(UnitNo,Addr,dLen:word):string;    // 读出测量值
	function ProcessReCmdStr(ReCmd:string;var CmdType:string;var ReturnVal,UnitNo:integer):boolean;

implementation

function _FormatEx(Fdata:integer;IntBit:integer):string;
var
	s1:string;
begin
  s1:=intToStr(Fdata);
  while Length(s1)<IntBit do
  begin
    S1:='0'+s1;
  end;
  _FormatEx:=s1;
end;
function BCCLink(_StrS: string): string;
var
	fcs,n,n1:Byte;
begin
  fcs:=0;
	n1:=Length(_StrS);
  if n1>20 then n1:=9;
  for n:=1 to n1 do  //add(-1) 2000/4/12  23:36  ??
		fcs:=fcs xor ord(_StrS[n]);
	_StrS:=_StrS+inttoHex(fcs,2)+#13;
	BCCLink:=String(_StrS);
end;
function MkPTCmd(UnitNo,Addr,dLen:word): string; //采用word模式读写操作.
var             
	 A,B,L,SendS:string;
begin
//加入容错检测判断
// UnitNo{00h..FEh}   0..255   or FFh只有一个单元
// Addr{0000h..0FFFh} 0~4095
// dLen{01h..40h}     0~64
	if (UnitNo>255)or(Addr>4094)Or(dLen>64) then
	begin
		MkPTCmd:='输入参数错误';
		exit;
	end;
	if (4095-Addr)<dLen then
	begin
		MkPTCmd:='读取数据超长';
		exit;
	end;
	A:=inttoHex(UnitNo,2);             //单元地址
	B:=inttoHex(Addr,4);								//寄存器地址
	L:=inttoHex(dLen,2);             	//要读取数据的长度
	Sends:=Format('%d%s%s%s%s',[5,A,'RW',B,L]);  //读A单元地址B处L长度的数据
  Sends[1]:=#5;
	MkPTCmd :=BCCLink(Sends);
end;
function ProcessReCmdStr(ReCmd: string; var CmdType:string;
  var ReturnVal,UnitNo: integer): boolean;
var
  err,x,y:integer;
	errs:string;
begin
  ProcessReCmdStr:=False;
  //if Recmd='' then  exit;
	CmdType:='未定义错误:'+ReCmd;
	x:=Pos(#5,ReCmd);
  y:=Pos('*',ReCmd);
  case (Y-x) of
  12:begin  //发出去的命令串
       if Length(ReCmd)<14 then
       begin
         ProcessReCmdStr:=False;
         CmdType:='冗余命令';
         exit;
       end else
       begin
         delete(ReCmd,1,y); //去掉冗余 @ 00 RX01 (FCS)*
         x:=Pos('@',ReCmd);
         y:=Pos('*',ReCmd);
         if (X>0)and (Y>(x+12)) then
         begin
           if Copy(ReCmd,x+6,2)<>'00' then
           begin
             CmdType:=ReCmd+':出错';
             ProcessReCmdStr:=False;
           end else
           begin
             CmdType:=Copy(ReCmd,x+4,2);
             UnitNo:=strtointdef(Copy(ReCmd,x+1,2),0);
             ReturnVal:=strtointdef(Copy(ReCmd,x+8,4),0);
             ProcessReCmdStr:=True;
           end;
         end;
       end;
     end;
  14:begin  //收回的反馈串
       if Copy(ReCmd,x+6,2)<>'00' then
       begin
         CmdType:=ReCmd+':出错';
         ProcessReCmdStr:=False;
       end else
       begin
         CmdType:=Copy(ReCmd,x+4,2);
         UnitNo:=strtointdef(Copy(ReCmd,x+1,2),0);
         ReturnVal:=strtointdef(Copy(ReCmd,x+8,4),0);
         ProcessReCmdStr:=True;
       end;
     end;
  10:begin  //收回的错误信息
       CmdType:=Copy(ReCmd,x+4,2);
       if Pos('0D',ReCmd)>0 then errs:='局部方式';
       err:=strtointdef(Copy(ReCmd,x+6,2),0);// $0d:
       case err of
         10:  errs:='奇偶校验出错';
         11:  errs:='成帧出错';
         13:  errs:='FCS校验出错';
         14:  errs:='命令格式出错';
         15:  errs:='设定数据范围出错';
       end;
       CmdType:=CmdType+':'+errs;
       UnitNo:=strtointdef(Copy(ReCmd,x+1,2),0);
       ProcessReCmdStr:=False;
     end;
  7 :begin
       if Pos('IC',ReCmd)>0 then
       begin
         CmdType:='未定义错误';
         ProcessReCmdStr:=False;
         UnitNo:=strtointdef(Copy(ReCmd,x+1,2),0);
       end;
     end;
  end;
end;


end.