unit1.pas

delphi串口通信 WAPI串口编程示例

unit Unit1;

interface

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

const
  WM_COMMNOTIFY = WM_USER + 100; // 通讯消息

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox4: TComboBox;
    ComboBox3: TComboBox;
    ComboBox2: TComboBox;
    ComboBox1: TComboBox;
    Label7: TLabel;
    ComboBox5: TComboBox;
    btnOpenCom: TButton;
    btnSendData: TButton;
    btnReceiveData: TButton;
    btnCloseCom: TButton;
    procedure btnOpenComClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCloseComClick(Sender: TObject);
    procedure btnSendDataClick(Sender: TObject);
    procedure btnReceiveDataClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  CommHandle:THandle;
  PostEvent:THandle;
  ReadOs : Toverlapped;
  Connected:Boolean;
  Receive :Boolean;
  ReceiveData : Dword;

procedure AddToMemo(Str:PChar;Len:Dword); // 接收的数据送入显示区Memo2
begin
  //接收厚的字符串为NULL终止
  str[Len]:=#0;
  Form1.Memo2.Text:=Form1.Memo2.Text+StrPas(str);
end;


procedure CommWatch(Ptr:Pointer);stdcall; // 通讯监视线程
var
  dwEvtMask,dwTranser : Dword;
  PostMsgFlag: Boolean;
  overlapped : Toverlapped;

begin
  Receive :=True;
  FillChar(overlapped,SizeOf(overlapped),0);
  overlapped.hEvent :=CreateEvent(nil,True,False,nil); // 创建重叠读事件对象
  if overlapped.hEvent=null then
  begin
    MessageBox(0,'overlapped.Event Create Error !','Notice',MB_OK);
    Exit;
  end;

  //进入串口监视状态，直到全局变量Receive置为False停止
  while(Receive) do
  begin
    dwEvtMask:=0;
    // 等待串口事件发生
    if not WaitCommEvent(CommHandle,dwEvtMask,@overlapped) then
    begin
      if ERROR_IO_PENDING=GetLastError then
        GetOverLappedResult(CommHandle,overlapped,dwTranser,True)
      end;

      //串口读事件发布消息 
      if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then
      begin
        // 等待允许传递WM_COMMNOTIFY通讯消息
        WaitForSingleObject(Postevent,INFINITE);
        // 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
        ResetEvent(PostEvent);
        // 传递WM_COMMNOTIFY通讯消息，告知主线程调用读串口的过程
        PostMsgFlag:=PostMessage(Form1.Handle,WM_COMMNOTIFY,CommHandle,0);
        if (not PostMsgFlag) then
        begin
          MessageBox(0,'PostMessage Error !','Notice',MB_OK);
          Exit;
        end;
      end;
    end;
    CloseHandle(overlapped.hEvent); // 关闭重叠读事件对象
end;


procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数
var
  CommState : ComStat;
  dwNumberOfBytesRead : Dword;
  ErrorFlag : Dword;
  InputBuffer : Array [0..1024] of Char;

begin
  if not ClearCommError(CommHandle,ErrorFlag,@CommState) then
  begin
    MessageBox(0,'ClearCommError !','Notice',MB_OK);
    PurgeComm(CommHandle,Purge_Rxabort or Purge_Rxclear);
    Exit;
  end;

  if CommState.cbInQue>0 then
  begin
    fillchar(InputBuffer,CommState.cbInQue,#0);
    // 接收通讯数据
    if (not ReadFile( CommHandle,InputBuffer,CommState.cbInQue,
                 dwNumberOfBytesRead,@ReadOs )) then
    begin
      ErrorFlag := GetLastError();
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
      begin
        MessageBox(0,'ReadFile Error!','Notice',MB_OK);
        Receive :=False;
        CloseHandle(ReadOs.hEvent);
        CloseHandle(PostEvent);
        CloseHandle(CommHandle);
        Exit;
      end
      else begin
        WaitForSingleObject(CommHandle,INFINITE); // 等待操作完成
        GetOverlappedResult(CommHandle,ReadOs,dwNumberOfBytesRead,False);
      end;
    end;
    if dwNumberOfBytesRead>0 then
    begin
      ReadOs.Offset :=ReadOs.Offset+dwNumberOfBytesRead;
      ReceiveData := ReadOs.Offset;
      // 处理接收的数据
      AddToMemo(InputBuffer,dwNumberOfBytesRead);
    end;
  end;
  // 允许发送下一个WM_COMMNOTIFY消息
  SetEvent(PostEvent);
end;


procedure TForm1.btnOpenComClick(Sender: TObject);
var
    CommTimeOut : TCOMMTIMEOUTS;
    DCB : TDCB;

begin
    StatusBar1.SimpleText := '连接中...';

    //发送消息的句柄
    PostEvent:=CreateEvent(nil,True,True,nil);
    if PostEvent=null then
    begin
        MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
        StatusBar1.SimpleText := '串口打开失败';
        Exit;
    end;

    //Overlapped Read建立句柄
    ReadOs.hEvent :=CreateEvent(nil,true,False,nil);
    if ReadOs.hEvent=null then
    begin
        MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
        CloseHandle(PostEvent);
        StatusBar1.SimpleText := '串口打开失败';
        Exit;
    end;

    //建立串口句柄
    CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_WRITE or GENERIC_READ,
             0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL,0);

    if CommHandle = INVALID_HANDLE_VALUE then
    begin
        CloseHandle(PostEvent);
        CloseHandle(ReadOs.hEvent);
        MessageBox(0,'串口打开失败!','Notice',MB_OK);
        StatusBar1.SimpleText := '串口打开失败';
        Exit;
    end;
    StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接！';

    //设置超时
    CommTimeOut.ReadIntervalTimeout := MAXDWORD;
    CommTimeOut.ReadTotalTimeoutMultiplier := 0;
    CommTimeOut.ReadTotalTimeoutConstant := 0;
    SetCommTimeouts(CommHandle, CommTimeOut);

    //设置读写缓存
    SetupComm(CommHandle,4096,1024);

    //对串口进行指定配置
    GetCommState(CommHandle,DCB);
    DCB.BaudRate := StrToInt(ComboBox2.Text);
    DCB.ByteSize := StrToInt(ComboBox3.Text);
    DCB.Parity := ComboBox4.ItemIndex;;
    DCB.StopBits := ComboBox5.ItemIndex;
    Connected := SetCommState(CommHandle, DCB);

    //关系串口的读事件
    if (not SetCommMask(CommHandle,EV_RXCHAR)) then
    begin
      MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
      Exit;
    end;

    if (Connected) then
    begin
        btnOpenCom.Enabled :=False;
    end
    else begin
        CloseHandle(CommHandle);
        StatusBar1.SimpleText := '设置串口失败';
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Connected:=False;
    ComboBox1.ItemIndex:=0;
    ComboBox2.ItemIndex:=0;
    ComboBox3.ItemIndex:=4;
    ComboBox4.ItemIndex:=0;
    ComboBox5.ItemIndex:=0;      
end;

procedure TForm1.btnCloseComClick(Sender: TObject);
begin
    if not Connected then
    begin
        StatusBar1.SimpleText := '未打开串口';
        Exit;
    end;
    Receive :=False;
    //取消事件监视，此时监视线程中的WaitCommEvent将返回
    SetCommMask(CommHandle,0);
    //等待监视线程结束
    WaitForSingleObject(PostEvent,INFINITE);
     //关闭事件句柄
    CloseHandle(PostEvent);
    //停止发送和接收数据，并清除发送和接收缓冲区
    PurgeComm(CommHandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
     //关闭其他的句柄
    CloseHandle(ReadOs.hEvent);
    CloseHandle(CommHandle);    
    btnOpenCom.Enabled :=True;
    Connected:=False;
    StatusBar1.SimpleText := '串口已经关闭';
end;

procedure TForm1.btnSendDataClick(Sender: TObject);
var
    Str:String;
    i:Integer;
    writeoverlapped:TOverlapped;
    ByteToWrite,BytesWritten,AllBytesWritten:DWORD;
    ErrorCode,ErrorFlag:DWORD;
    CommStat:COMSTAT;

begin
    if not Connected then
    begin
        StatusBar1.SimpleText := '未打开串口';
        Exit;
    end;

    if (Memo1.GetTextLen=0) then
    begin
        StatusBar1.SimpleText := '缓冲区为空';
        Exit;
    end;

    AllBytesWritten:=0;
    for i:=0 to memo1.Lines.Count-1 do
    begin
        Str:=memo1.Lines[i];
        ByteToWrite:=length(Str);
        if  ByteToWrite=0 then continue;
        try
            StatusBar1.SimpleText := '正在发送数据';
            //初始化一步读写结构
            FillChar(writeoverlapped,Sizeof(writeoverlapped),0);
             //避免贡献资源冲突
            writeoverlapped.hEvent:=CreateEvent(nil,True,False,nil);
            //发送数据
            if not WriteFile(Commhandle,Str[1],ByteToWrite,BytesWritten,@writeoverlapped) then
            begin
                ErrorCode:=GetLastError;
                if ErrorCode<>0 then
                begin
                    if ErrorCode=ERROR_IO_PENDING then
                    begin
                        StatusBar1.SimpleText := '端口忙，正在等待...';
                        while not GetOverlappedResult(Commhandle,writeoverlapped,BytesWritten,True) do
                        begin
                            ErrorCode:=GetLastError;
                            if ErrorCode=ERROR_IO_PENDING then
                                continue
                            else begin
                                ClearCommError(Commhandle,ErrorFlag,@CommStat);
                                showmessage('发送数据出错');
                                CloseHandle(WriteOverlapped.hEvent);
                                CloseHandle(Commhandle);
                                btnOpenCom.Enabled :=True;
                                Exit;
                            end;
                         end;
                         AllBytesWritten:=AllBytesWritten+BytesWritten;
                    end
                    else begin
                        ClearCommError(Commhandle,ErrorFlag,@CommStat);
                        showmessage('发送数据出错');
                        CloseHandle(WriteOverlapped.hEvent);
                        Receive :=False;
                        CloseHandle(Commhandle);
                        CloseHandle(PostEvent);
                        btnOpenCom.Enabled :=True;
                        Exit;
                    end;
                end;
            end;
        finally
            CloseHandle(writeoverlapped.hEvent);
        end;
    end;
    StatusBar1.SimpleText:='已经发送了Byte个数：'+IntToStr(ALLBytesWritten);
end;

procedure TForm1.btnReceiveDataClick(Sender: TObject);
var
    com_thread: Thandle;
    ThreadID:DWORD;

begin
    if not connected then
    begin
        StatusBar1.SimpleText := '未打开串口';
        Exit;
    end;

    ReceiveData :=0;
    Memo2.Clear;
    FillChar(ReadOs,SizeOf(ReadOs),0);
    ReadOs.Offset := 0;
    ReadOs.OffsetHigh := 0;

    // 建立通信监视线程
    Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
    if (Com_Thread=0) then
        MessageBox(Handle,'No CreateThread!',nil,mb_OK);
        
    //设置DTR信号线
    EscapeCommFunction(Commhandle,SETDTR);
    StatusBar1.SimpleText := '正在接收数据...';
end;

end.