communate.pas

Delphi利用API函数进行串口通信

unit communate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
const
  WM_COMMNOTIFY=WM_USER+1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    RichEdit1: TRichEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
procedure WMCOMMNOTIFY(var Message:TMessage);
message WM_COMMNOTIFY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
  hNewCommFile,Post_Event:THandle;
  Read_os:Toverlapped;
  Receive:Boolean;
  ReceiveData:Dword;

procedure AddToMemo(Str:PChar;Len:Dword);begin
  str[Len]:=#0;
  Form1.RichEdit1.Text:=Form1.RichEdit1.Text+StrPas(str);
end;




procedure CommWatch(Ptr:Pointer);stdcall;
var
  dwEvtMask,dwTranser:Dword;
  OK:Boolean;
  Os:Toverlapped;
begin
  Receive:=True;
  FillChar(Os,SizeOf(Os),0);
  Os.hEvent:=CreateEvent(nil,True,False,nil);
  //创建重叠读事件对象
  if Os.hEvent=null then
    begin
      MessageBox(0,'Os.Event Create Error!','Notice',MB_OK);
      exit;
    end;
  if(not SetCommMask(hNewCommFile,EV_RXCHAR)) then
    begin
      MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
      exit;
    end;
  while(Receive) do
    begin
      dwEvtMask:=0;
      //等待设置好的通信事件发生，由于有个Os(Os:Toverlapped),
      //表示进行的是overlapped等待，不会被这个等待堵塞住
      if not WaitCommEvent(hNewCommFile,dwEvtMask,@Os) then
        begin
          if ERROR_IO_PENDING=GetLastError then
            GetOverLappedResult(hNewCommFile,Os,dwTranser,True)
        end;
      if((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then
        begin
          WaitForSingleObject(Post_event,INFINITE);
          //等待允许传递WM_COMMNOTIFY通信消息
          ResetEvent(Post_Event);
          //处理WM_COMMNOTIFY消息，不再发送WM_COMMNOTIFY消息
          OK:=PostMessage(Form1.Handle,WM_COMMNOTIFY,hNewCommFile,0);
          //传递WM_COMMNOTIFY通信消息
          if (not OK) then
            begin
              MessageBox(0,'PostMessage Error!','Notice',MB_OK);
              exit;
            end;
        end;


  end;
  CloseHandle(Os.hEvent);
      //关闭重叠读事件对象




end;



//消息处理函数
procedure TForm1.WMCOMMNOTIFY(var Message:TMessage);
var
  CommState:ComStat;
  dwNumberOfBytesRead:Dword;
  ErrorFlag:Dword;
  InputBuffer:Array[0..1024]of Char;
begin
  //ClearCommError回复通信错误信息并报告当前的通信设备状态。
  //当通信错误发生时调用此函数，它会清除附加的I/O操作的设备错误标志
  if not ClearCommError(hNewCommFile,ErrorFlag,@CommState) then
    begin
      MessageBox(0,'ClearCommError!','Notice',MB_OK);
      PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);
      exit;
    end;
  if(CommState.cbInQue>0)then
    begin
      fillchar(InputBuffer,CommState.cbInQue,#0);
      //接收通信数据
      if (not ReadFile(hNewCommFile,InputBuffer,CommState.cbInQue,
          dwNumberOfBytesRead,@Read_Os))then
          begin
            ErrorFlag:=GetLastError();
            if(ErrorFlag<>0)and(ErrorFlag<>ERROR_IO_PENDING)then
              begin
                MessageBox(0,'ReadFile Error!','Notice',MB_OK);
                Receive:=False;
                CloseHandle(Read_Os.hEvent);
                CloseHandle(Post_Event);
                CloseHandle(hNewCommFile);
                exit;
              end
            else
              begin
                WaitForSingleObject(hNewCommFile,INFINITE);
                //等待操作完成，等待设置好的Event的发生
                GetOverlappedResult(hNewCommFile,Read_Os,
                               dwNumberOfBytesRead,False);
              end;
            end;
          if dwNumberOfBytesRead>0 then
            begin
              Read_Os.Offset:=Read_Os.Offset+dwNumberOfBytesRead;
              ReceiveData:=Read_Os.Offset;
              AddToMemo(InputBuffer,dwNumberOfBytesRead);
              //处理接收的数据
            end;
    end;
      SetEvent(Post_Event);
      //允许发送下一个WM_COMMNOTIFY消息
    end;

//打开文件用于发送
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      Button3.Enabled:=False;
      Button4.Enabled:=False;
      RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
    end;
    Button1.Enabled:=False;
end;
//发送数据
procedure TForm1.Button2Click(Sender: TObject);
var
  dcb:TDCB;
  Error:Boolean;
  dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
          ErrorFlag,dwWhereToStartWriting:DWORD;
  pDataToWrite:PChar;
  Write_Os:Toverlapped;
begin
  Form1.Caption:='';
  hNewCommFile:=CreateFile('COM4',GENERIC_WRITE,0,nil,OPEN_EXISTING,
                               FILE_FLAG_OVERLAPPED,0);
  //打开通信端口COM4
  if hNewCommFile=INVALID_HANDLE_VALUE then
      MessageBox(0,'Error opening com port!','Notice',MB_OK);
  SetupComm(hNewCommFile,1024,1024);
  //设置缓冲区大小及主要通信参数
  GetCommState(hNewCommFile,dcb);
  //设置COM口的Data Control Block的属性
  dcb.BaudRate:=115200;
  dcb.ByteSize:=8;
  dcb.Parity:=NOPARITY;
  dcb.StopBits:=ONESTOPBIT;
  Error:=SetCommState(hNewCommFile,dcb);
  if(not Error)then
    MessageBox(0,'SetCommState Error!','Notice',MB_OK);
  dwWhereToStartWriting:=0;
  dwNumberOfBytesWritten:=0;
  dwNumberOfBytesToWrite:=RichEdit1.GetTextLen;
  if(dwNumberOfBytesToWrite=0)then
    begin
      ShowMessage('Text Buffer is Empty!');
      exit;
    end
  else
    begin
      pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
      try
        RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
        Label1.Font.Color:=clRed;
        FillChar(Write_Os,SizeOf(Write_Os),0);
        //为重叠写创建事件对象
        Write_Os.hEvent:=CreateEvent(nil,True,False,nil);
        SetCommMask(hNewCommFile,EV_TXEMPTY);
        //用来表示对EV_TXEMPTY事件感兴趣，有Char来到的时候系统会通知
        Label1.Caption:='正在发送数据...!';
        repeat
          Label1.Repaint;
          //发送通信数据
          if not WriteFile(hNewCommFile,pDataToWrite[dwWhereToStartWriting],
                dwNumberOfBytesToWrite,dwNumberOfBytesWritten,@Write_Os)then
          begin
            ErrorFlag:=GetLastError;
            if ErrorFlag<>0 then
              begin
                if ErrorFlag=ERROR_IO_PENDING then
                  begin
                    WaitForSingleObject(Write_Os.hEvent,INFINITE);
                    //等待设置好的Event的发生
                    GetOverlappedResult(hNewCommFile,Write_Os,
                              dwNumberOfBytesWritten,False);
                  end
                else
                  begin
                    MessageBox(0,'WriteFile 错误!','Notice',MB_OK);
                    Receive:=False;
                    CloseHandle(Read_Os.hEvent);
                    CloseHandle(Post_Event);
                    CloseHandle(hNewCommFile);
                    exit;
                  end;
              end;
            end;
          Dec(dwNumberOfBytesToWrite,dwNumberOfBytesWritten);
          Inc(dwWhereToStartWriting,dwNumberOfBytesWritten);
          //写整个事情(Write the whole thing)
        until(dwNumberOfBytesToWrite<=0);
        Form1.Caption:=IntToStr(dwWhereToStartWriting);
      finally
        StrDispose(pDataToWrite);
      end;
      CloseHandle(hNewCommFile);
    end;
  Label1.Font.Color:=clBlack;
  Label1.Caption:='发送成功';
  Button1.Enabled:=True;
  Button3.Enabled:=True;
  Button4.Enabled:=True;
end;

//接收处理
procedure TForm1.Button3Click(Sender: TObject);
var
  OK:Boolean;
  dcb:TDCB;
  com_thread:Thandle;
  ThreadID:DWORD;
begin
  ReceiveData:=0;
  Button1.Enabled:=False;
  Button2.Enabled:=False;
  RichEdit1.Clear;
  //打开COM4
  hNewCommFile:=CreateFile('COM4',GENERIC_READ,0,nil,OPEN_EXISTING,
                            FILE_FLAG_OVERLAPPED,0);
  if hNewCommFile=INVALID_HANDLE_VALUE then
    begin
      MessageBox(0,'打开COM端口错误!','Notice',MB_OK);
      exit;
    end;
  Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);
  if (not Ok)then
    begin
      MessageBox(0,'SetCommMask 错误!','Notice',MB_OK);
      exit;
    end;
  SetupComm(hNewCommFile,1024,1024);
  //设置缓冲区大小及主要通信参数
  GetCommState(hNewCommFile,dcb);
  dcb.BaudRate:=115200;
  dcb.ByteSize:=8;
  dcb.Parity:=NOPARITY;
  dcb.StopBits:=ONESTOPBIT;
  Ok:=SetCommState(hNewCommFile,dcb);
  if (not Ok)then
    MessageBox(0,'SetCommState 错误!','Notice',MB_OK);
  FillChar(Read_Os,SizeOf(Read_Os),0);
  Read_Os.Offset:=0;
  Read_Os.OffsetHigh:=0;
  //创建Overlapped Read事件
  Read_Os.hEvent:=CreateEvent(nil,true,False,nil);
  if Read_Os.hEvent=null then
    begin
      CloseHandle(hNewCommFile);
      MessageBox(0,'CreateEvent 错误!','Notice',MB_OK);
      exit;
    end;
  //创建PostMessage事件
  Post_Event:=CreateEvent(nil,True,True,nil);
  if Post_Event=null then
    begin
      CloseHandle(hNewCommFile);
      CloseHandle(Read_Os.hEvent);
      MessageBox(0,'CreateEvent 错误!','Notice',MB_OK);
      exit;
    end;
    Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
    //建立通信监视线程
    if(Com_Thread=0)then
      MessageBox(Handle,'CreateThread函数不起作用!',nil,MB_OK);
      EscapeCommFunction(hNewCommFile,SETDTR);
      Label1.Font.Color:=clRed;
      Label1.Caption:='正在接收数据...!';
  end;

//停止通信处理
procedure TForm1.Button4Click(Sender: TObject);
begin
  Label1.Font.Color:=clBlack;
  Label1.Caption:='已停止通信';
  Form1.Caption:=IntToStr(ReceiveData);
  Receive:=False;
  CloseHandle(Read_Os.hEvent);
  CloseHandle(Post_Event);
  CloseHandle(hNewCommFile);
  Button1.Enabled:=True;
  Button2.Enabled:=True;
end;
end.