comm_unit1.pas

delphi做的个串口测试程序,可以用来测试硬件的串口通讯

unit comm_Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    sdbutton: TButton;
    send_w: TEdit;
    rcv_w: TMemo;
    comselect: TComboBox;
    baudselect: TComboBox;
    Button1: TButton;
    Button2: TButton;
    MSComm1: TMSComm;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    BitBtn1: TBitBtn;
    Label3: TLabel;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

    procedure MSComm1Comm(Sender:TObject);
    procedure sdbuttonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  rcv_length,snd_length:integer;
  rcv_arr,snd_arr:array[1..200] of byte;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  mscomm1.inbuffercount:=0;
  mscomm1.inputlen:=0;
  mscomm1.rthreshold:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if mscomm1.portopen then
  begin
    mscomm1.portopen:=false;
    mscomm1.dtrenable:=false;
    mscomm1.rtsenable:=false;
  end;
  mscomm1.settings:=baudselect.text;
  if comselect.text='COM1' then
    mscomm1.commport:=1
  else if comselect.text='COM2' then
         mscomm1.commport:=2
       else if comselect.text='COM3' then
              mscomm1.commport:=3
            else if comselect.text='COM4' then
                   mscomm1.commport:=4;
  mscomm1.portopen:=true;
  mscomm1.dtrenable:=true;
  mscomm1.rtsenable:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if mscomm1.portopen then
  begin
    mscomm1.portopen:=false;
    mscomm1.dtrenable:=false;
    mscomm1.rtsenable:=false;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  rcv_w.text:='';
end;

procedure TForm1.MSComm1Comm(Sender:TObject);
var
  rcvstr:Olevariant;
  length,seri_i:integer;
  sub_str,comp_str:array[1..100] of byte;
begin
  if mscomm1.commevent=2 then
  begin
    sleep(200);
    length:=mscomm1.inbuffercount;
    rcvstr:=mscomm1.input;
    for seri_i:=1 to length do
    begin
      rcv_arr[seri_i+rcv_length]:=rcvstr[seri_i-1];
      rcv_w.text:=rcv_w.text+copy(inttohex(rcv_arr[seri_i+rcv_length],2),1,2)+' ';
    end;
    rcv_length:=rcv_length+length;
  end;
end;

function inttobcd(tempdata:integer):integer;
var
  i,j:integer;
begin
  i:=tempdata div 10;
  j:=tempdata mod 10;
  result:=i*16+j;
end;

procedure TForm1.sdbuttonClick(Sender: TObject);
var
  Vtemp: Variant;
  Ovtemp: olevariant;
  i: integer;
begin
  begin
    rcv_length:=0;

    snd_length:=31;
    snd_arr[1]:=$fe;
    snd_arr[2]:=$fe;
    snd_arr[3]:=$68;
    snd_arr[4]:=$00;
    snd_arr[5]:=$01;
    snd_arr[6]:=$00;
    snd_arr[7]:=$00;
    snd_arr[8]:=$00;
    snd_arr[9]:=$00;
    snd_arr[10]:=$68;
    snd_arr[11]:=$04;
    snd_arr[12]:=$11;
    snd_arr[13]:=$42+$33;
    snd_arr[14]:=$6f+$33;
    snd_arr[15]:=$6e+$33;
    snd_arr[16]:=$61+$33;
    snd_arr[17]:=$5f+$33;
    snd_arr[18]:=$32+$33;
    snd_arr[19]:=$41+$33;
    snd_arr[20]:=$35+$33;
    snd_arr[21]:=$31+$33;
    snd_arr[22]:=$32+$33;
    snd_arr[23]:=$01+$33;
    snd_arr[24]:=$29+$33;
    snd_arr[25]:=$05+$33;
    snd_arr[26]:=$06+$33;
    snd_arr[27]:=$30+$33;
    snd_arr[28]:=$45+$33;
    snd_arr[29]:=$11+$33;
    snd_arr[30]:=snd_arr[3]+snd_arr[4]+snd_arr[5]+snd_arr[6]+snd_arr[7]+
                 snd_arr[8]+snd_arr[9]+snd_arr[10]+snd_arr[11]+snd_arr[12]+
                 snd_arr[13]+snd_arr[14]+snd_arr[15]+snd_arr[16]+snd_arr[17]
                 +snd_arr[18]+snd_arr[19]+snd_arr[20]+snd_arr[21]+snd_arr[22]
                 +snd_arr[23]+snd_arr[24]+snd_arr[25]+snd_arr[26]+snd_arr[27]
                 +snd_arr[28]+snd_arr[29];
    snd_arr[31]:=$16;
           {
    snd_length:=11;
    snd_arr[1]:=$fe;
    snd_arr[2]:=$fe;
    snd_arr[3]:=$fe;
    snd_arr[4]:=$fe;
    snd_arr[5]:=12;//strtoint(send_w.text);
    snd_arr[6]:=$55;
    snd_arr[7]:=$b1;
    snd_arr[8]:=$10;
    snd_arr[9]:=18;
    snd_arr[10]:=snd_arr[9]+snd_arr[8]+snd_arr[7]+snd_arr[6]+snd_arr[5];
    snd_arr[11]:=$0d;
          }
    {snd_length:=9;
    snd_arr[1]:=$fe;
    snd_arr[2]:=$fe;
    snd_arr[3]:=$fe;
    snd_arr[4]:=$fe;
    snd_arr[5]:=$10;
    snd_arr[6]:=strtoint(send_w.text);
    snd_arr[7]:=$01;
    snd_arr[8]:=snd_arr[6]+snd_arr[7];
    snd_arr[9]:=$16;
     }
    Vtemp:=Vararraycreate([0,snd_length-1],VarByte);
    for i:=0 to (snd_length-1) do
    begin
      Vtemp[i]:=snd_arr[i+1];
    end;
    Ovtemp:=Vtemp;
    if mscomm1.portopen then
    begin
      mscomm1.Output:=Ovtemp;
    end
    else
    begin
      mscomm1.settings:=baudselect.text;
      if comselect.text='COM1' then
        mscomm1.commport:=1
      else if comselect.text='COM2' then
             mscomm1.commport:=2
           else if comselect.text='COM3' then
                  mscomm1.commport:=3
                else if comselect.text='COM4' then
                       mscomm1.commport:=4;
      mscomm1.portopen:=true;
      mscomm1.Output:=Ovtemp;
    end;
  end;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if mscomm1.portopen then
  begin
    mscomm1.portopen:=false;
    mscomm1.dtrenable:=false;
    mscomm1.rtsenable:=false;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Vtemp: Variant;
  Ovtemp: olevariant;
  i: integer;
begin
  if mscomm1.portopen then
  begin
    i:=strtoint(send_w.text);
    i:=i+1;
    send_w.text:=inttostr(i);

    rcv_length:=0;

    snd_length:=9;
    snd_arr[1]:=$fe;
    snd_arr[2]:=$fe;
    snd_arr[3]:=$fe;
    snd_arr[4]:=$fe;

    snd_arr[5]:=$10;
    snd_arr[6]:=strtoint(send_w.text);
    snd_arr[7]:=$01;
    snd_arr[8]:=snd_arr[6]+snd_arr[7];
    snd_arr[9]:=$16;

  {  snd_length:=11;
    snd_arr[1]:=$fe;
    snd_arr[2]:=$fe;
    snd_arr[3]:=$fe;
    snd_arr[4]:=$fe;
    send_w.text:=inttostr(strtoint(send_w.text)+1);
    snd_arr[5]:=strtoint(send_w.text);
    snd_arr[6]:=$55;
    snd_arr[7]:=$01;
    snd_arr[8]:=$10;
    snd_arr[9]:=$50;
    snd_arr[10]:=snd_arr[9]+snd_arr[8]+snd_arr[7]+snd_arr[6]+snd_arr[5];
    snd_arr[11]:=$0d;
 }
    Vtemp:=Vararraycreate([0,snd_length-1],VarByte);
    for i:=0 to (snd_length-1) do
    begin
      Vtemp[i]:=snd_arr[i+1];
    end;
    Ovtemp:=Vtemp;
    mscomm1.Output:=Ovtemp;

    progressbar1.max:=9;
    if progressbar1.position=9 then
      progressbar1.position:=0
    else
      progressbar1.position:=progressbar1.position+1;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  close;
end;

end.