comtest.pas

串口通信相关程序源代码

unit ComTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,  Grids, ExtCtrls,  Spin;
type
  TForm1 = class(TForm)
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    Memo2: TMemo;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label2: TLabel;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  k,nn,sendtimes:integer;
  comf1:integer;
    dcb1:DCB;
    COMMTIMEOUTS1:COMMTIMEOUTS;
    Readbuf1,Writebuf1:array[0..1000]of byte;
    NumberOfBytesRead1,NumberOfBytesWritten1:Cardinal;


implementation

{$R *.DFM}


procedure TForm1.Button5Click(Sender: TObject);
var ComPort:PChar;
begin
   sendtimes:=0;
   case RadioGroup1.ItemIndex of
     0:begin
       ComPort:='Com1';
       end;
     1:begin
       ComPort:='Com2';
       end;
   end;


if Button1.Caption='运行串口' then
   begin
     comf1:=Createfile(ComPort,  GENERIC_WRITE + GENERIC_READ,
          0,nil, OPEN_EXISTING,   0,0);
   if comf1>0 then
      begin
      Button2.Enabled:=true;
      SetupComm(comf1,1600,1600);
      dcb1.Baudrate:=9600;
      dcb1.ByteSize:=8;
      dcb1.StopBits:=ONESTOPBIT;
      dcb1.Parity:=EVENPARITY;
      SetCommState(comf1,Dcb1);
      with COMMTIMEOUTS1 do
         begin
         ReadIntervalTimeout:=0;
         ReadTotalTimeoutMultiplier:=0;
         ReadTotalTimeoutConstant:=60;
         WriteTotalTimeoutMultiplier:=0;
         WriteTotalTimeoutConstant:=100;
         end;
      SetCommTimeOuts(comf1,COMMTIMEOUTS1);
      end
   else exit;
      timer1.enabled:=true;
      Button1.Caption:='终止串口';
   end
else
   begin
    timer1.enabled:=false;
    closeHandle(comf1);
    comf1:=0;
    Button1.Caption:='运行串口';
    Button2.Enabled:=false;
   end;
   label3.caption:=Comport+'='+inttostr(comf1);
   k:=0;
   nn:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,n,k1:integer;
    s1:string;
begin
   k1:=memo1.Lines.count;
   n:=0;
   s1:='';
   while n<k1 do
     begin
     s1:=s1+memo1.text;
     inc(n);
     end;
  memo1.Lines.Clear;
  for i:=1 to length(s1) do writebuf1[i-1]:=ord(s1[i]);
  if WriteFile(comf1,writebuf1,length(s1), NumberOfBytesWritten1,nil ) then
     begin
     inc(sendtimes);
     label1.caption:='第'+inttostr(sendtimes)+
     '次 '+inttostr(NumberOfBytesWritten1)+'字符';
     end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var  i:integer;
    s2:string;
begin
   if ReadFile(comf1,readbuf1,30, NumberOfBytesRead1,nil )  then
       begin
       inc(k);
       if NumberOfBytesRead1>0 then
          begin
           nn:=nn+NumberOfBytesRead1;
           s2:='';
           for i:=0 to NumberOfBytesRead1-1 do s2:=s2+chr(readbuf1[i]);
           Form1.memo2.Lines.add(s2);
           form1.label2.caption:='第'+inttostr(k)+
              '次  本次收到'+inttostr(NumberOfBytesRead1)+
              '字符  共:'+inttostr(nn)+'字符'+s2;
           end;
       end;

end;

end.