umain.~pas

Windows API 实现串口通信 用API制作的串口调试器。 供大家学习串口相关的API函数。 有兴趣可以与我联系。

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls;
const
  WM_OMMNOTIFY = WM_USER + 100;

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

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

var
  Form1: TForm1;
procedure CommWatch(Ptr:Pointer);stdcall;

procedure AddToMemo(Str:PChar;Len:Dword);

implementation

{$R *.dfm}

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.btnOpenComClick(Sender: TObject);
var
  CommTimeOut: TCOMMTIMEOUTS;
  DCB: TDCB;
begin
  StatusBar1.SimpleText :='Connecting...';
  PostEvent := CreateEvent(nil,True,True,nil);
  if PostEvent = null then
  begin
    MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
    StatusBar1.SimpleText := 'Open Failed!';
    Exit;
  end;
  ReadOs.hEvent :=CreateEvent(nil,true,False,nil);
  if ReadOs.hEvent = null then
  begin
    MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
    CloseHandle(PostEvent);
    StatusBar1.SimpleText := 'Open Failed';
    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, 'Open Failed!','Notice',MB_OK);
    StatusBar1.SimpleText:= 'Open Failed';
    Exit;
  end;
  StatusBar1.SimpleText := 'System Has Connected to ' + ComboBox1.Text;

  //Set Timeout
  CommTimeOut.ReadIntervalTimeout := MAXDWORD;
  CommTimeOut.ReadTotalTimeoutMultiplier := 0;
  CommTimeOut.ReadTotalTimeoutConstant := 0;
  SetCommTimeouts(CommHandle, CommTimeOut);

  //Set I/O Buffer
  SetupComm(CommHandle,4096, 1024);

  //Set COM
  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);

  //Close COM's Read Event
  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 := 'Set COM Failed!';
  end;
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 := 'Port is not Open';
    Exit;
  end;
  if (Memo1.GetTextLen = 0) then
  begin
    StatusBar1.SimpleText := 'Buffer is Empty!';
    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 := 'Sending Data...';

      //Init I/O Structure
      FillChar(writeoverlapped,Sizeof(writeoverlapped),0);
      writeoverlapped.hEvent := CreateEvent(nil,True,False,nil);
      if not WriteFile(Commhandle,Str[I],ByteToWrite,BytesWritten,@writeoverlapped) then
      begin
        ErrorCode := GetLastError;
        if ErrorCode <> 0 then
        begin
          if Errorcode=ERROR_IO_PENDING then
          begin
            StatusBar1.SimpleText := 'COM Port is busying, Waiting...';
            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('Send Failed!');
                CloseHandle(WriteOverlapped.hEvent);
                CloseHandle(CommHandle);
                btnOpenCom.Enabled :=True;
                Exit;
              end;    //if  ErrorCode=ERROR_IQPENDTNG
            end; //while not GetOverlappedResult
            AllBytesWritten:=AllBytesWritten+BytesWritten;
          end //if Errorcode=ERROR_IO_PENDING
          else begin
            ClearCommError(CommHandle,ErrorFlag,@Commstat);
            showmessage('Send Failed!');
            CloseHandle(WriteOverlapped.hEvent);
            Receive :=False; CloseHandle(Commhandle);
            CloseHandle(PostEvent);
            btnOpenCom.Enabled :=True;
            Exit;
          end;
        end;
      end;
    finally
      CloseHandle(writeoverlapped.hEvent);
    end;
  end;
  StatusBar1.SimpleText:= 'System has Sended ' + IntToStr(ALLBytesWritten) + ' Bytes';
end;

procedure TForm1.WMCOMMNOTIFY(var Message: TMessage);
var
  CommState: ComStat;
  dwNumberOfBytesRead: Dword;
  myErrorFlag : Dword;
  InputBuffer: Array [0.. 1024] of Char;
begin
  if not ClearCommError(Commhandle,myErrorFlag, @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);
    //Receive COMM Data
    if (not ReadFile(CommHandle,InputBuffer,CommState.cbInQue, dwNumberOfBytesRead, @ReadOs )) then
    begin
      myErrorFlag := GetLastError;
      if (myErrorFlag <>0 ) and (myErrorFlag <> 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
        //Wait for Operation End
        WaitForSingleObject(CommHandle,INFINITE);
        GetOverlappedResult(CommHandle,ReadOs,dwNumberOfBytesRead,False);
      end;
    end;
    if dwNumberOfBytesRead > 0 then
    begin
      ReadOs.Offset := ReadOs.Offset + dwNumberOfBytesRead;
      ReceiveData := ReadOs.Offset;
      //Deal with Data received
      AddToMemo(InputBuffer,dwNumberOfBytesRead);
    end;
  end;
  //Allow to send next WM_COMMNOTIFY message;
  SetEvent(PostEvent);
end;

procedure AddToMemo(Str:PChar;Len:Dword);
begin
  //Add NULL to the DataEnds
  Str[Len] := #0;
  Form1.Memo2.Text := StrPas(str);
end;

procedure CommWatch(Ptr:Pointer);
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.hEvent Create Error !','Notice',MB_OK);
    Exit;
  end;
  // Start COMM Watch Until Recieve = False
  while(Receive) do
  begin
    dwEvtMask:=0;
    //Wait for COMM Event
    if not WaitCommEvent(CommHandle,dwEvtMask,@overlapped) then
    begin
      if ERROR_IO_PENDING = GetLastError then
        GetOverLappedResult(CommHandle,overlapped,dwTranser,True)
    end;
    //COMM Read Event happens
    if ( (dwEvtMask and EV_RXCHAR) = EV_RXCHAR) then
    begin
      // Wait for WM_COMMNOTIFY
      WaitForSingleObject(Postevent,INFINITE);
      //Deal with WM_COMMNOTIFY, and do not send WM_COMMNOTIFY message at all
      ResetEvent(PostEvent);
      //Send WM_COMMNOTIFY message, tell Primary Process to call ReadCOMM procedure.
      PostMsgFlag := PostMessage(Form1.Handle,WM_COMMNOTIFY,CommHandle,0);
      if (not PostMsgFlag) then
      begin
        MessageBox(0, 'PostMessage Error !','Notice',MB_OK);
        Exit;
      end;
    end; //if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR)
  end;  //while(Receive)
  CloseHandle(overlapped.hEvent);
  //Close 'overlapped'end;
end;

procedure TForm1.btnReceiveDataClick(Sender: TObject);
var
  com_thread: Thandle;
  ThreadID:DWORD;
begin
  if not connected then
  begin
    StatusBar1.SimpleText := 'Port is not Opened';
    Exit;
  end;
  ReceiveData := 0;
  Memo2.Clear;
  FillChar(ReadOs,SizeOf(ReadOs),0);
  ReadOs.Offset := 0;
  ReadOs.OffsetHigh := 0;
  //Start COMMWatch Thread
  Com_Thread := CreateThread(nil,0, @CommWatch,nil,0,ThreadID);
  if (Com_Thread=0) then
    MessageBox(Handle,'No CreateThread!',nil,mb_OK);
  //Set DTR Line
  EscapeCommFunction(Commhandle,SETDTR);
  StatusBar1.SimpleText := 'Receiving Data...';
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  if not Connected then
  begin
    StatusBar1.SimpleText := 'Port is not Open!';
    Exit;
  end;
  Receive := False;
  //Cancle Watch, then Thread WaitCOMMEvent will return
  SetCommMask(CommHandle,0);
  //Waitfor Watchthread terminate
  WaitForSingleObject(PostEvent,INFINITE);
  //Close PostEvent handle
  CloseHandle(PostEvent);
  PurgeComm(CommHandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
  //Close Ohter Handle
  CloseHandle(ReadOs.hEvent);
  CloseHandle(Commhandle);
  btnOpenCom.Enabled :=True;
  Connected := False;
  StatusBar1.SimpleText := 'Port is Closed!';
end;

end.