commport.~pas

对俄罗斯火花雷达进行控制

unit Commport;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, RzCommon, RzTabs, StdCtrls, RzCmboBx, RzLabel, RzButton,
  RzRadChk,IniFiles, ExtCtrls, RzPanel, RzStatus,Registry;
type
  TBuf = array [0..1023] of Byte;
  PBuf = ^TBuf;

//
function hex(c:String):Integer ;
//
function HexToInt(S:String): Integer;
//
Function StrtoHex(source:string;buf:TBuf):TBuf;
//串口发送数据
procedure ComSenddata(comstr,fmtstr:string;ComPort:TComm);
procedure SetFangxiang_HHDA(ComPort:TComm);
procedure SetFangxiang_HHDAA(Typeint:Integer;ComPort:TComm);
//stalker雷达发送数据
procedure StalkerSendData(SendStr:string;ComPort:Tcomm);
// 串口接收数据
function ComReceiveData(Buffer: Pointer;
BufferLength: Word):string;
//stalker雷达接收程序
function ComStaLkerData(Buffer: Pointer;
BufferLength: Word):string;
function ComStaLkerDataSi3(Buffer: Pointer;
BufferLength: Word):string;
function ComStaLkerDataHHDA(Buffer: Pointer;
BufferLength: Word):string;
//打开串口
procedure IsMessage;
procedure StartCom(ComPort:TComm;ComName:string);
//关闭串口
procedure StopCom(ComPort:TComm);
//处理数据
procedure TransData(Data:string );
procedure TransDataSi3(Data:string);
//处理stalker雷达数据
procedure TransStaLkerData(Data:string);
procedure TransDataHHDA(Data:string );
procedure Si3SendData(SendStr:string;ComPort:Tcomm);
function Si3TestOK(ComPort:Tcomm):Boolean;
procedure Si3SetTarget(TargetIndex:Integer;ComPort:Tcomm);
procedure RebootCom(ComPort:TComm);
procedure SetFangxiang_s3(Typeint:Integer;ComPort:TComm);
//校验和


function Checksum(Src:string):string;
var
  rbuf,sbuf:TBuf;
  ReadStr:string;
  datalen:integer;
  isOK:Boolean;
implementation

uses Unit1, Unit_Declare, UnitPubFunction;

procedure SetFangxiang_s3(Typeint:Integer;ComPort:TComm);
var
  i:Integer;
begin
    sbuf[1]:=$ef;
    sbuf[2]:=$02;
    sbuf[3]:=$01;
    sbuf[4]:=$00;
    sbuf[5]:=$03;
    sbuf[6]:=$00;
    sbuf[7]:=$82;
    sbuf[8]:=$00;

    case typeint of

        0:   //Away
        begin
           sbuf[9]:=$00;
           sbuf[10]:=$85;
        end;
        1:   //Closing
        begin
           sbuf[9]:=$01;
           sbuf[10]:=$86;
        end;
        2:   //Both
        begin
           sbuf[9]:=$02;
           sbuf[10]:=$87;
        end;
    end;
    sbuf[11]:=$03;
    for i:=1 to 11 do
    begin
       ComPort.WriteCommData(@sbuf[i],1);
    end;
end;
////
function hex(c:String):Integer ;
       var
         x:integer;
       begin
          if  (c=' ')   then
          x:=16
          else if (c='0')  then
            x:=0
          else if c='1' then
            x:=1
          else if c = '2' then
            x:=2
          else if c='3' then
            x:=3
          else if c='4' then
            x:=4
          else if c='5' then
            x:=5
          else if c='6' then
            x:=6
          else if c='7' then
            x:=7
          else if c='8' then
            x:=8
          else if c='9' then
            x:=9
         else if ((c='a') or (c='A')) then
            x:=10
         else if (c='b') or (c='B') then
            x:=11
         else if (c='c') or (c='C') then
            x:=12
         else if (c='d') or (c='D') then
            x:=13
         else if (c='e') or (c='E') then
            x:=14
         else if (c='f') or (c='F') then
            x:=15
         else
            x:=-1;
          Result:=x;
       end;
//////
function HexToInt(S:String): Integer;
       var
          tmpInt1,tmpInt2:Integer ;
       begin
          if Length(S)=1 then
          begin
             Result:=hex(S[1]);
          end
          else if Length(S)=2 then
          begin
            tmpInt1:=hex(S[1]);
            tmpInt2:=hex(S[2]);
            if (tmpInt1=-1) or (tmpInt2=-1) then
               Result:=-1
            else
               Result:= tmpInt1*16+tmpInt2;
          end
          else
               Result:=-1;
       end;
////

Function StrtoHex(source:string;buf:TBuf):TBuf;
var
  strlength:integer;
  i:integer;
begin
  strlength:=length(source);
  for i:=1 to strlength do
     buf[i]:=Ord(source[i]);
  result:=buf;  
end;


procedure ComSenddata(comstr,fmtstr:string;ComPort:TComm);
var
sendlen:integer;
i:Integer ;
sendstr:string;
begin
  sendstr :='EF0201000300'+comstr+'00'+fmtstr;
  sendstr :=sendstr +Checksum(sendstr);
  sendlen:=Length(sendstr) div 2;
  for i:=1 to sendlen do
  begin
   sbuf[i]:=HexToInt(copy(sendstr,i*2-1,2));
  end;
  for i:=1 to sendlen do
  begin
   ComPort.WriteCommData(@sbuf[i],1);
  end;
end;

procedure SetFangxiang_HHDA(ComPort:TComm);
var
  i:Integer;
begin
    sbuf[1]:=$FE;
    sbuf[2]:=$3F;
    for i:=1 to 2 do
    begin
       ComPort.WriteCommData(@sbuf[i],1);
    end;
end;

procedure SetFangxiang_HHDAA(Typeint:Integer;ComPort:TComm);
var
  i:Integer;
begin
    case typeint of
        0:   //Away
        begin
           sbuf[1]:=$FE;
           sbuf[2]:=$3D;
        end;
        1:   //Closing
        begin
           sbuf[1]:=$FE;
           sbuf[2]:=$3C;
        end;
        2:   //Both
        begin
           sbuf[1]:=$FE;
           sbuf[2]:=$3E;
        end;
        3:
        begin
           sbuf[1]:=$FE;
           sbuf[2]:=$AA;
        end;
    end;
    for i:=1 to 2 do
    begin
       ComPort.WriteCommData(@sbuf[i],1);
    end;
end;

procedure StalkerSendData(SendStr:string;ComPort:Tcomm);
var
sendlen:integer;
i:Integer ;
begin
  sendlen:=Length(sendstr) div 2;
  for i:=1 to sendlen do
  begin
   sbuf[i]:=HexToInt(copy(sendstr,i*2-1,2));
  end;
  for i:=1 to sendlen do
  begin
   ComPort.WriteCommData(@sbuf[i],1);
   Delay(10);
  end;
end;

function Checksum(Src:string):string;
var
  i:Integer;
  strlen:Integer;
  isodd:Boolean;
  sumint:Integer;
begin
  isodd:=false;
  sumint :=0;
  strlen :=Length(src) div 2;
  for i:=1 to strlen do
  begin
     if isodd  then
         begin
         sumint:=sumint+HexToInt(copy(src,i*2-1,2))*256;
         isodd:=False;
         end
         else
         begin
         sumint:=sumint+HexToInt(copy(src,i*2-1,2));
         isodd:=True;
         end;     
  end;
  Result :=IntToHex((sumint mod 256),2)+IntToHex((sumint div 256),2);
end;

function ComReceiveData(Buffer: Pointer;
BufferLength: Word):string;
var
  i:integer;
begin
  move(buffer^,pchar(@rbuf)^,bufferlength);
  for i:=0 to bufferlength-1 do
    begin
      ReadStr:=ReadStr+inttohex(rbuf[i],2);
      datalen:=datalen+1;
      if rbuf[i]=$ff then
         begin
          ReadStr:='ff';
          datalen :=1;
         end;
      if rbuf[i]=$ef then
         begin
          TransData(ReadStr);
         end;
    end;
  Result :='';
end;

function ComStaLkerData(Buffer: Pointer;
BufferLength: Word):string;
var
  i:integer;  
begin
  move(buffer^,pchar(@rbuf)^,bufferlength);
  for i:=0 to bufferlength-1 do
    begin
      ReadStr:=ReadStr+inttohex(rbuf[i],2);
      datalen:=datalen+1;
      if rbuf[i]=$0D then
         begin
          ReadStr:='0D';
          datalen :=1;
          DataBegin:=true;
         end;
      if (datalen=4) and (DataBegin) and (copy(ReadStr,1,2)='0D') then
//      if (datalen=4) and (DataBegin) then
         begin
          TestStaLker:=True;
          datalen :=0;
          DataBegin :=false;
          TransStaLkerData(ReadStr);
          ReadStr:='';
         end;
      if datalen =5 then
         begin
           if ReadStr='3031323334'  then
           begin
               TestStaLker:=True;
               datalen :=0;
               ReadStr:='';
           end;
         end;  
    end;
  Result :='';
end;

function ComStaLkerDataSi3(Buffer: Pointer;
BufferLength: Word):string;
var
  i:Integer;
begin
  move(buffer^,pchar(@rbuf)^,bufferlength);
  for i:=0 to bufferlength-1 do
    begin
      ReadStr:=ReadStr+inttohex(rbuf[i],2);
      datalen:=datalen+1;
      if rbuf[i]=$2B then
         begin
          ReadStr:='2B'; //+
          datalen :=1;
         end;
      if rbuf[i]=$2D then //-
         begin
          ReadStr:='2D';
          datalen :=1;
         end;
      if rbuf[i]=$3F then//?
         begin
          ReadStr:='3F';
          datalen :=1;
         end;
      if rbuf[i]=$4F then
         begin
           if rbuf[i+1]=$4B then
             isok:=True
             else
             isok:=False;
         end;
      if (datalen=5) and (copy(ReadStr,9,2)='0D') then
         begin
          TransDataSi3(ReadStr);
          ReadStr:='';
         end;

    end;
  Result :='';
end;

function ComStaLkerDataHHDA(Buffer: Pointer;
BufferLength: Word):string;
var
  i:integer;
begin
  move(buffer^,pchar(@rbuf)^,bufferlength);
  for i:=0 to bufferlength-1 do
    begin
      ReadStr:=ReadStr+inttohex(rbuf[i],2);
      datalen:=datalen+1;
      if rbuf[i]=$FD then
         begin
          ReadStr:='FD';
          datalen :=1;
         end;
      if rbuf[i]=$50 then
         begin
           Form1.Memo1.Lines.Add(ReadStr);
           TransDataHHDA(ReadStr);
         end;
    end;
  Result :='';
end;

procedure IsMessage;
begin
   if GetData >= 20091116 then
   begin
       Application.MessageBox('within the Program is Dedbug！', 'Admonition',
         MB_OK + MB_ICONSTOP + MB_TOPMOST);
   end; 
end;

procedure StartCom(ComPort:TComm;ComName:string);
var
  comok:BOOLean;
begin
  ComPort.StopComm;
  ComPort.CommName :=ComName;
  ComPort.BaudRate :=9600;
//  ComPort.BaudRate :=StrToInt(BaudRate);
  ComPort.ByteSize :=_8;
  ComPort.StopBits := _1;
  datalen :=0;
  ReadStr :='';
  comok:=true;
  try
    ComPort.StartComm ;
  except
    ErrorMessage('串口','打开串口'+ComName+'错误!');
    ErrorMsgBox('','打开串口'+ComName+'错误!');
    comok:=False;
  end;
  if comok then
  begin
    Delay(500);
    Si3SendData('START',ComPort);
  end;
end;

procedure StopCom(ComPort:TComm);
begin
  try
    Si3SendData('STOP',ComPort);
    ComPort.StopComm;
    Form1.Label1.Caption := '0';
    Speed_x := 0;
  except
    ErrorMessage('串口','关闭串口'+ComPort.CommName+'错误!');
    ErrorMsgBox('','关闭串口'+ComPort.CommName+'错误');
  end;
end;

procedure TransData(data:string);
begin
  if speedstr <> Copy(data,15,2) then                                           //如果速度值改变
  begin
      speedstr :=Copy(data,15,2);
      Targetspeed:=hextoint(speedstr);                                          //截取新的速度值
      //将速度值转为10进制的字符串
      isnew:=True;                                                              //将新数据标志位置1
  end
  else
  begin
      isnew:=False;
  end;
end;

procedure TransDataHHDA(Data:string );
begin
    if speedstr <> Copy(data,15,2) then                                           //如果速度值改变
      begin
          speedstr :=Copy(data,15,2);
          Targetspeed:=hextoint(speedstr);                                          //截取新的速度值
          //将速度值转为10进制的字符串
          isnew:=True;                                                              //将新数据标志位置1
      end
      else
      begin
          isnew:=False;
      end;
end;

procedure TransStaLkerData(Data:string);
var
  nowspeed:string;
begin
  nowspeed:=Copy(Data,4,1)+Copy(Data,6,1)+Copy(Data,8,1);
  try
      nowspeed:=IntToStr(StrToInt(nowspeed));
  except
      nowspeed := '0';
  end;
  if speedstr <> nowspeed then                                                  //如果速度值改变
  begin
      speedstr :=nowspeed;
      Targetspeed:=StrToInt(nowspeed);                                          //截取新的速度值
      //将速度值转为10进制的字符串
      isnew:=True;                                                              //将新数据标志位置1
  end
  else
  begin
      isnew:=False;
  end;
end;

procedure TransDataSi3(Data:string);
var
  nowspeed:string;
  fchar:string;
begin
  nowspeed:=Copy(Data,4,1)+Copy(Data,6,1)+Copy(Data,8,1);
  if Copy(Data,1,2) ='2B' then
     fchar :='+';
  if Copy(Data,1,2) ='2D' then
     fchar :='-';
  if Copy(Data,1,2) ='3F' then
     fchar :='';
  try
    nowspeed:=IntToStr(StrToInt(nowspeed));
  except
    nowspeed:='0';
  end;
  nowspeed:=fchar+nowspeed;  
  if speedstr <> nowspeed then                                        //如果速度值改变
  begin
    speedstr :=nowspeed;
    Targetspeed:=StrToInt(nowspeed);                                                //截取新的速度值
    isnew:=True;
  end
  else
  begin
    isnew:=False;
  end;
end;

procedure Si3SendData(SendStr:string;ComPort:Tcomm);
var
sendlen:integer;
i:Integer ;
s:string;
begin
  sendlen:=Length(sendstr);
  for i:=1 to sendlen do
  begin
   s:=copy(sendstr,i,1);
   sbuf[i]:=ord(s[1]);
  end;
  sbuf[sendlen+1]:=$0D;
  for i:=1 to sendlen+1 do
  begin
   ComPort.WriteCommData(@sbuf[i],1);
   Delay(10);
  end;
end;

function Si3TestOK(ComPort:Tcomm):Boolean;
begin
  Si3SendData('OK',ComPort);
  Delay(100);
  Result :=isOK;
end;

procedure Si3SetTarget(TargetIndex:Integer;ComPort:Tcomm);
begin
  if TargetIndex =1 then
  begin
    Si3SendData('Target Report:All',ComPort);
  end;
  if TargetIndex =2 then
  begin
    Si3SendData('Target Report:Approach',ComPort);
  end;
  if TargetIndex =3 then
  begin
    Si3SendData('Target Report:Recede',ComPort);
  end;
end;

procedure RebootCom(ComPort:TComm);
begin
    Si3SendData('Reboot',ComPort);
end;

end.