serialdebug.pas

Delphi语言的串口调试精灵,易于修改程序以便适用于不同用途

unit SerialDebug;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB;

type
  TMainForm = class(TForm)
    mmReceive: TMemo;
    Panel2: TPanel;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    cmbbxComNum: TComboBox;
    cmbbxBaud: TComboBox;
    cmbbxDataNum: TComboBox;
    cmbbxStopBit: TComboBox;
    cmbbxCheckBit: TComboBox;
    btnSerial: TButton;
    shpSerial: TShape;
    mmSend: TMemo;
    btnSend: TButton;
    chckbxHexSend: TCheckBox;
    chckbxTimer: TCheckBox;
    edtTime: TEdit;
    Label7: TLabel;
    MSComm: TMSComm;
    tmrSend: TTimer;
    btnClear: TButton;
    chckbxHexShow: TCheckBox;
    Panel3: TPanel;
    chckbxRTS: TCheckBox;
    chckbxDTR: TCheckBox;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    shpDSR: TShape;
    shpCTS: TShape;
    shpCD: TShape;
    procedure FormCreate(Sender: TObject);
    procedure btnSerialClick(Sender: TObject);
    procedure chckbxDTRClick(Sender: TObject);
    procedure chckbxRTSClick(Sender: TObject);
    procedure chckbxTimerClick(Sender: TObject);
    procedure MSCommComm(Sender: TObject);
    procedure chckbxHexShowClick(Sender: TObject);
    procedure chckbxHexSendClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure tmrSendTimer(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}
//该函数接收1个
//转换成功.输出字符对应的数
//转换失败.输出-1
function hex(c:char):Integer ;
var
      x:integer;
begin
     if c=' ' then
        x:=0
     else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
     else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
     else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
     else
        //输入错误
        x:=-1;        
      Result:=x;
end;

//该函数接收1个至2个字符
//转换成功.输出对应16进制数的值
//转换失败.输出-1。
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;

//程序的初始化
procedure TMainForm.FormCreate(Sender: TObject);
begin
    HexShow:=False;
    cmbbxComNum.ItemIndex:=0;
    shpSerial.Brush.Color:=clWhite;
    shpCD.Brush.Color:=clWhite;
    shpCTS.Brush.Color:=clWhite;
    shpDSR.Brush.Color:=clWhite;
    Panel1.Enabled:=True;
end;

//打开或者关闭串口，并变换指示灯的状态
procedure TMainForm.btnSerialClick(Sender: TObject);
var
    ComSetting:String;
    
begin
    if not MSComm.PortOpen then
    begin
        //打开串口
        MSComm.CommPort :=cmbbxComNum.ItemIndex +1;
        //默认值为 '9600,N,8,1'
        ComSetting:=cmbbxBaud.Text;
        ComSetting:=ComSetting+','+cmbbxCheckBit.Text;
        ComSetting:=ComSetting+','+cmbbxDataNum.Text;
        ComSetting:=ComSetting+','+cmbbxStopBit.Text;
        MSComm.Settings:=ComSetting;
        MSComm.PortOpen:=True;

        //变换各个组件的状态
        shpSerial.Brush.Color:=clRed; //指示灯变红
        Panel1.Enabled:=False;
        btnSerial.Caption :='关闭串口';
        chckbxHexShow.Enabled:=False;
    end
    else  begin
        //关闭串口
        //变换各个组件的状态
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示灯变白
        Panel1.Enabled:=True;
        btnSerial.Caption :='打开串口';
        chckbxHexShow.Enabled:=True;        
    end;
end;

//设置DTR线状态
procedure TMainForm.chckbxDTRClick(Sender: TObject);
begin
        MSComm.DTREnable :=chckbxDTR.Checked
end;

//设置RTS线状态
procedure TMainForm.chckbxRTSClick(Sender: TObject);
begin
        MSComm.RTSEnable :=chckbxRTS.Checked
end;

//开启定时器，定时发送数据
procedure TMainForm.chckbxTimerClick(Sender: TObject);
begin
    if chckbxTimer.Checked then
    begin
        tmrSend.Interval:=StrToInt(edtTime.Text);
        tmrSend.Enabled:=True;        
    end
    else begin
        tmrSend.Enabled:=False;
    end;
end;

//处理控件的该事件，获取底层交换的数据和连线的状态
procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen:Integer;
    tmpInt:Integer;
    tmpvar:Variant;
    InputString:String;
    
begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;

        //接收二进制数据，转换为十六进制显示
        if HexShow then
        begin
          tmpvar:=MSComm.Input;
          InputString:='';
          for i:= 0 to InputLen-1 do
          begin
            tmpInt:=tmpvar[i];
            InputString:=InputString+' '+LowerCase(IntToHex(tmpInt,2));
          end;
        end
        //直接接收字符
        else begin
            InputString:=MSComm.Input;
        end;    
        MainForm.mmReceive.Text :=MainForm.mmReceive.Text +InputString;
    end
    //显示CD线的状态
    else if MSComm.CommEvent=ComEvCD then
    begin
        if MSComm.CDHolding then
            shpCD.Brush.Color:=clRed
        else
            shpCD.Brush.Color:=clWhite;
    end
    //显示CTS线的状态
    else if MSComm.CommEvent=ComEvCTS then
    begin
        if MSComm.CTSHolding then
            shpCTS.Brush.Color:=clRed
        else
            shpCTS.Brush.Color:=clWhite;
    end
    //显示DSR线的状态
    else if MSComm.CommEvent=ComEvDSR then
    begin
        if MSComm.DSRHolding then
            shpDSR.Brush.Color:=clRed
        else
            shpDSR.Brush.Color:=clWhite;
    end;
end;

//设置MSComm控件的数据接收的方式
procedure TMainForm.chckbxHexShowClick(Sender: TObject);
begin
    if chckbxHexShow.Checked then
    begin
        MSComm.InputMode:=1;
        HexShow:=True;
    end
    else begin
        MSComm.InputMode:=0;
        HexShow:=False;
    end;
end;

//设置参数HexSend的值，以告诉程序如何发送数据
procedure TMainForm.chckbxHexSendClick(Sender: TObject);
begin
    HexSend:=chckbxHexSend.Checked;
end;


//发送数据
procedure TMainForm.btnSendClick(Sender: TObject);
var
    Len:Integer;
    i,count,tmpInt:Integer;
    tmpVar:Variant;
    tmpStr,Output:String;
    
begin
    if not MSComm.PortOpen then
    begin
        showmessage('没有打开串口！');
        Exit;
    end
    else begin
        //发送二进制数，需要使用Variant变量矩阵，矩阵大小自动调节
        if HexSend then
        begin
            Output:=mmSend.Text;
            Len:=Length(Output);
            if Len>0 then
            begin
               i:=1;
               count:=1;
               //创建一个Variant数组
               tmpVar:=VarArrayCreate([1,1],varByte);
               while(i<Len) do
               begin
                  //每3个字符串中截取2个字符，转换为16进制
                  tmpStr:=Copy(Output,i,2);
                  tmpStr:=LowerCase(tmpStr);
                  tmpInt:=HexToInt(tmpStr);
                  if tmpInt=-1 then
                  begin
                      showmessage('发送的数据格式有问题！');
                      exit;
                  end
                  else begin
                      tmpVar[Count]:=tmpInt;
                      Inc(count);
                     //增大Variant数组
                      VarArrayRedim(tmpVar,count);
                  end;
                  i:=i+3;
               end;
               MSComm.Output :=tmpVar;               
            end;
        end
        else begin
            MSComm.Output :=mmSend.Text;
        end;
    end;
end;

//清空数据显示区
procedure TMainForm.btnClearClick(Sender: TObject);
begin
    mmReceive.Text:='';
end;

//定时器在指定的事件内触发该事件，实现数据的定时发送
procedure TMainForm.tmrSendTimer(Sender: TObject);
begin
    //如果串口已经打开，则发送数据
    if MSComm.PortOpen then
        btnSendClick(sender);
end;

function    ReadFromPLC(ReadChar:Array of char; ReadAddress:Array of Byte;
       ReadBytes :Integer): Boolean;
var
   ReadDataSum:integer;
   DataSumCheck:integer;
   tmpStr:String;
   tmpchr,chr1,chr2:char;
   tmpVar:Variant;
   Input:Variant;
   InputLen,i,tmpInt:Integer;

begin
   DataSumCheck:=0;
   tmpVar:=VarArrayCreate([1,11],varByte);
   tmpVar[1]:=$02;//STX
   tmpVar[2]:=$30;//CMDO
   DataSumCheck:=DataSumCheck+$30;   
   tmpVar[3]:=ReadAddress[0];
   DataSumCheck:=DataSumCheck+ReadAddress[0];
   tmpVar[4]:=ReadAddress[1];
   DataSumCheck:=DataSumCheck+ReadAddress[1];
   tmpVar[5]:=ReadAddress[2];
   DataSumCheck:=DataSumCheck+ReadAddress[2];
   tmpVar[6]:=ReadAddress[3];
   DataSumCheck:=DataSumCheck+ReadAddress[3];

   tmpStr:=IntToHex(ReadBytes,2);
   tmpChr:=tmpStr[1];
   tmpVar[7]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[8]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);

   tmpVar[9]:=$03;//ETX
   DataSumCheck:=DataSumCheck+$03;

   tmpStr:=IntToHex(DataSumCheck,2);
   tmpChr:=tmpStr[1];
   tmpVar[10]:=Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[11]:=Ord(tmpChr);
   MainForm.MSComm.Output:=tmpVar;

   sleep(1000);

   InputLen:=MainForm.MSComm.InBufferCount;
   Input:=MainForm.MSComm.Input;
   if InputLen>0 then
   begin
      if Input[0]=$02 then//STX
      begin
        ReadDataSum:=0;
        for i:=1 to ReadBytes do
        begin
            tmpInt:=Input[i];
            ReadChar[i-1]:=chr(tmpInt);
            ReadDataSum:=ReadDataSum+Input[i];
        end;
        inc(i);
        if Input[i]=$03 then
        begin
            ReadDataSum:=ReadDataSum+$03;
            tmpStr:=IntToHex(ReadDataSum,2);
            chr1:=tmpStr[1];
            chr2:=tmpStr[2];            
            if (ord(chr1)=Input[1]) and (ord(chr1)=Input[1]) then
            begin
                Result:=True;
                ShowMessage('DataRead succeed');
            end
            else begin
                Result:=False;                
                ShowMessage('DataRead check fail');                
            end;
        end;
      end
      else
        Result:=False;
   end
   else
      Result:=False;
end;


function    WritePLC(WriteChar:Array of char; WriteAddress:Array of Byte;
       WriteBytesCount :Integer): Boolean;
var
   ReadDataSum:integer;
   DataSumCheck:integer;
   tmpStr:String;
   tmpchr,chr1,chr2:char;
   tmpVar:Variant;
   Input:Variant;
   InputLen,i,tmpInt:Integer;

begin
   DataSumCheck:=0;
   tmpInt:=11+WriteBytesCount;
   tmpVar:=VarArrayCreate([1,tmpInt],varByte);
   tmpVar[1]:=$02;//STX
   tmpVar[2]:=$31;//CMDO
   DataSumCheck:=DataSumCheck+$31;   
   tmpVar[3]:=WriteAddress[0];
   DataSumCheck:=DataSumCheck+WriteAddress[0];
   tmpVar[4]:=WriteAddress[1];
   DataSumCheck:=DataSumCheck+WriteAddress[1];
   tmpVar[5]:=WriteAddress[2];
   DataSumCheck:=DataSumCheck+WriteAddress[2];
   tmpVar[6]:=WriteAddress[3];
   DataSumCheck:=DataSumCheck+WriteAddress[3];

   tmpStr:=IntToHex(WriteBytesCount,2);
   tmpChr:=tmpStr[1];
   tmpVar[7]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[8]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpVar[9]:=$03;//ETX
   DataSumCheck:=DataSumCheck+$03;

   for i:=0 to WriteBytesCount-1 do
   begin
      tmpVar[10+i]:=ord(WriteChar[i]);
      DataSumCheck:=DataSumCheck+ord(WriteChar[i]);
   end;

   tmpStr:=IntToHex(DataSumCheck,2);
   tmpChr:=tmpStr[1];
   tmpVar[10+WriteBytesCount]:=Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[11+WriteBytesCount]:=Ord(tmpChr);

   MainForm.MSComm.Output:=tmpVar;

   sleep(1000);

   InputLen:=MainForm.MSComm.InBufferCount;
   Input:=MainForm.MSComm.Input;
   if InputLen>0 then
   begin
      if Input[0]=$06 then//STX
      begin
         Result:=True;
         ShowMessage('DataWrite succeed');
      end
      else begin
         Result:=False;
         ShowMessage('DataWrite check fail');                
      end;
   end
   else
      Result:=False;
end;

procedure TMainForm.Panel2Click(Sender: TObject);
var
  tmpWord:Word;
  str:string;
  ch:char;
begin
  tmpWord:=3;
  str:=IntToHex(3,2);
  ch:=str[1];
  Caption:=ch;
end;

end.