communit.pas

串口通信相关程序源代码

unit CommUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    Button2: TButton;
    Label2: TLabel;
    Timer1: TTimer;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  comf1:integer;
  Dcb1:dcb;
  wbuf,Rbuf:array[0..4095]of byte;
  cto1:Commtimeouts;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var ports:Pchar;
begin
   with RadioGroup1 do
      case itemindex of
          0:ports:='Com1';
          1:ports:='Com2';
      end;
   comf1:=createfile(ports,GENERIC_READ+GENERIC_WRITE,0,nil,OPEN_EXISTING,0,0);
   if comf1>0 then
      begin
      setupcomm(comf1,2000,2000);
      with dcb1 do
         begin
         baudrate:=9600;
         bytesize:=8;
         stopbits:=ONESTOPBIT;
         Parity:=NOPARITY;   //EVENPARITY;
         end;
      SetCommState(comf1,dcb1);
      with cto1 do
         begin
          ReadIntervalTimeout:=0;
          ReadTotalTimeoutMultiplier:=0;
          ReadTotalTimeoutConstant:=60;
          WriteTotalTimeoutMultiplier:=0;
          WriteTotalTimeoutConstant:=100;
         end;
         SetCommTimeouts(comf1,cto1);
      label1.Caption:=ports+' handle='+ inttostr(comf1);

      end
   else label1.Caption:='false';
end;

procedure TForm1.Button2Click(Sender: TObject);
var ss:string;
    wlen,numwbuf:longword;
    i:integer;
begin
   ss:=memo1.Text;
   wlen:=length(ss);
   //move(ss[1],wbuf,wlen);
   for i:=0 to wlen-1 do wbuf[i]:=ord(ss[i+1]);
   writefile(comf1,wbuf,wlen,numwbuf,nil);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var ss:string;
    numrbuf:longword;
    i:integer;
begin
timer1.Tag:= timer1.Tag +1;
label2.Caption:=inttostr(label2.tag)+'/'+inttostr(timer1.Tag);
readfile(comf1,rbuf,60,numrbuf,nil);
if numrbuf>0 then
   begin
   label2.tag:=label2.tag + numrbuf;
   ss:='';
   for i:=0 to numrbuf-1 do ss:=ss+inttostr(rbuf[i])+',';
   memo2.Lines.Add(ss);
   //for i:=1 to numrbuf do ss:=ss+chr(rbuf[i]);
   //move(rbuf,ss,numrbuf);
   //memo2.Text:=ss;
   end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var ss:string;
    numrbuf:longword;
begin
readfile(comf1,rbuf,60,numrbuf,nil);

end;

procedure TForm1.Button4Click(Sender: TObject);
var ss:string;
    wlen,numwbuf:longword;
    i:integer;
begin

   wlen:=1;
   wbuf[0]:=02;     //正文开始字符STX(ASCII码02H)
   writefile(comf1,wbuf,wlen,numwbuf,nil);

end;

procedure TForm1.Button5Click(Sender: TObject);
var    wlen,numwbuf:longword;
begin
   wlen:=1;
   wbuf[0]:=$10;    //数据链路转换字符DLE(10H)
   writefile(comf1,wbuf,wlen,numwbuf,nil);

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  timer1.Enabled:=CheckBox1.Checked;
end;

end.