unit1.pas

RS232串口通讯随书源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    Button3: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    CTSNo: TLabel;
    DSRNo: TLabel;
    RINo: TLabel;
    DCDNo: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DetectEvent();
  private
    { Private declarations }
  public
    hComm:THandle;
    { Public declarations }
  end;

var
  Form1: TForm1;

  WEvent:TEvent;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  cc:TCOMMCONFIG;
  Temp:string;
begin
  Temp:='COM1';// 选择所要打开的COM
  hComm:=CreateFile(PChar(Temp), GENERIC_READ or GENERIC_WRITE,
       0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);                   // 打开COM
  if (hComm = INVALID_HANDLE_VALUE) then begin         // 如果COM 未打开
    MessageBox (0, '打开通信端口错误!!','',MB_OK);
    exit;
  end;

  GetCommState(hComm,cc.dcb);                         // 得知目前COM 的状态
  cc.dcb.BaudRate:=CBR_9600;                          // 设置波特率为9600
  cc.dcb.ByteSize:=8;                                 // 字节为 8 bit
  cc.dcb.Parity:=NOPARITY;                            // Parity 为 None
  cc.dcb.StopBits:=ONESTOPBIT;                        // 1 个Stop bit

  if not SetCommState(hComm, cc.dcb) then begin       // 设置COM 的状态
    MessageBox (0, '通信端口设置错误!!!','',MB_OK);
    CloseHandle(hComm);
    exit;
  end;
  //以下设置所要检测的事件
  DetectEvent;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  if WEvent.Handle <>0 then
    WEvent.Free ;
   SetCommMask(hcomm,$0);
   CloseHandle(hComm);
   close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  EvWait:DWORD;
  OverLap:TOVERLAPPED;
  EE:TWaitResult;
begin
  if hComm=0 then exit ; //若未打开通信端口则跳出
  //建立一个Event对象
  WEvent:=TEvent.Create(nil,True,False,'') ;
  //将Event Handle指定给Overlap结构
  OverLap.hEvent :=WEvent.Handle;
  //等待事件的发生
  if WaitCommEvent(hComm,EvWait,@Overlap) then
  begin
    //先检查Event
    EE:=WEvent.WaitFor(10);
    if EE<>wrSignaled	then exit ;//若未触发，则跳出
    WEvent.ResetEvent;//清除事件
    if (EvWait and EV_CTS)=EV_CTS then //检查CTS是否改变
      begin
       CTSNo.Caption := inttostr(strtoint(CTSNo.Caption)+1);
       if  Shape1.Brush.Color=clRed then
        Shape1.Brush.Color:=clWhite
       else
         Shape1.Brush.Color:=clRed;
      end;
    if (EvWait and EV_DSR)=EV_DSR then //检查DSR是否改变
      begin
      DSRNo.Caption := inttostr(strtoint(DSRNo.Caption)+1);
      if  Shape2.Brush.Color=clRed then
       Shape2.Brush.Color:=clWhite
      else
        Shape2.Brush.Color:=clRed;
      end;

    if (EvWait and EV_RING)=EV_RING then //检查RI是否改变
      begin
      RINo.Caption := inttostr(strtoint(RINo.Caption)+1);
      if  Shape3.Brush.Color=clRed then
       Shape3.Brush.Color:=clWhite
      else
        Shape3.Brush.Color:=clRed;
      end;

    if (EvWait and EV_RLSD)=EV_RLSD then//检查CD是否改变
      begin
       DCDNo.Caption := inttostr(strtoint(DCDNo.Caption)+1);
       if  Shape4.Brush.Color=clRed then
        Shape4.Brush.Color:=clWhite
       else
         Shape4.Brush.Color:=clRed;
      end;

  end;

end;

Procedure TForm1.DetectEvent();
 var
  EvWait:DWORD ;
begin
  if hComm=0 then Exit;
  EvWait:=EV_CTS+ EV_DSR+EV_RING+EV_RLSD+EV_BREAK
          +EV_RXCHAR+EV_RXFLAG+EV_TXEMPTY+EV_ERR;
  if not SetCommMask(hComm,EvWait) then
  begin
    MessageBox (0, '设置错误!!','',MB_OK);
  end;
  Timer1.Enabled :=true;
end;



end.