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.