在WIN32中的串口通讯（Delphi）

在WIN32中的串口通讯（Delphi）
由在WIN32操作系统中禁止应用程序象DOS中那样直接访问计算机硬件，因此，无法象以前那样采用中断读写串口。但是在WIN32中我们可发采用两种方法访问串口：1、使用VB中的MSCOMM串口控件；2、采用API函数，本文主要介绍采用API函数实现串口通讯。
由于WM_COMMNOTIFY消息已被取消，故本文自定义了WM_COMMNOTIFY消息，在WIN32中几个常用的串口通信API函数如下：
CreateFile    打开串口
CloseHandle  关闭句柄，用于释放内存
SetComm     设置缓冲区大小
ReadFile     读串口
WriteFile     写串口
SetCommState  设置通信参数
GetCommState  获取通信参数
ClearCommError 清除串口错误并获取读、写缓冲区当前字节数
SetCommMask 设置串口屏蔽事件
PurgeComm  消除串口读写缓冲区的所有字符，用以终止悬而未决的读写操作。
PostMessage 发送消息
WaitCommEvent 等待串口事件发生

由于采用多线程操作串口，还用到以下API函数

CreateEvent  建立同步事件
ResetEvent   同步事件复位
SetEvent     同步事件置位
WaitForSingleObject 等待同步事件
GetOverLappedResult 获取并行操作的结果]
GetLastError 获取错误代码

由于WIN32取消了WM_COMMNOTIFY，所以必须自己创建，如果编写串口控件，那么应该在串口事件发生时即WaitCommEvent返回True时或GetLastError返回结果为Error_IO_Pending，且GetOverLappedResult返回True时触发读串口事件。比如：串口控件为Tcomm,那么在串口事件发生时调用Tcomm.RXChar方法，Tcomm.RXChar定义如下：
Procedure Tcomm.RXChar;
begin
if Assigned(FOnRXChar) then FonRxChar(self);
SetEvent(Post_Event);
End;

Delphi的强大和多线程支持，使得实现串口通信非常方便简单，首先，用CreateFile打开串口,其次，通过GetCommState获取串口参数，并用SetCommState设置串口参数，然后创建线程用以监视串口，此后就可以进行串口通信了，最后用Closehandle 释放所有资源（切记，以免死机）。
在这其中，使用到一个重要的结构DCB，其常用的一些定义如下：
BaudRate:波特率，可直接设为110、300、600、1200、2400、4800、9600、19200等值。
ByteBits：数据位长度，可高为4-8。
Parity：奇偶校验方式，0-4分别为无、偶、奇、空
StopBits:停止位长度，0，1，2分别为1、1.5、2位
其余详细说明请参考Win32.hlp、MSDN、以及Delphi5/Source/RTL/win/Windows.pas。
具体程序见如下，本程序用Delphi 5.0编制，在Windows98编译通过，并两台PC上可稳定运行，源程序绝对完整无删节，绝不象某人所说的可以运行却无发送部分，且无法接收数据。
如要调试本程序，请到163.com上下载一个串口程序来协助调试。
本人欢迎来信讨论，Email:[e-mail]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
Const
Wm_CommNotify=WM_User+12;
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  Procedure CommInitialize;
  Procedure MsgComm(Var Msg:Tmessage); Message WM_CommNotify;
  Function  WriteStr(const Str:String):Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;
  TComm=Class(TThread)
  Protected
  Procedure Execute;override;
  end;

var
  Form1: TForm1;
  Hcom,Post_Event:Thandle;
  LpolW,LpolR:Poverlapped;
  RXComm:TComm;
implementation

{$R *.DFM}

Procedure TComm.Execute;
var
dwEvtmask,dwOvres,bb:Dword;
RXFinish:Bool;
begin
  while true do
  begin
    DwEvtMask:=0;
    RXFinish:=WaitCommEvent(hcom,dwevtmask,LpolR);   //等待串口事件EV_RXCHAR
    if not RXFinish then               //如果返回True,已立即完成，否则继续判断
      if GetLastError()=ERROR_IO_PENDING then //正在接收数据
      begin
        bb:=WaitForSingleObject(LpolR^.hEvent,500);//等待500ms
        Case bb of
          Wait_Object_0:  RXFinish:=GetOverLappedResult(hcom,LpolR^,dwOvRes,False);
                           //返回False,出错
          Wait_TimeOut:  RXFinish:=False;//定时溢出
          else RXFinish:=False;   //出错
        end;
      end else RXFinish:=False;
    if RXFinish then
    begin
      if WaitForsingleobject(Post_Event,infinite)=Wait_Object_0 then  //等待同步事件置位
      begin
        resetEvent(Post_Event);      //同步事件复位
        PostMessage(Form1.handle,WM_CommNotify,0,0);  //发送消息
//在这里可以触发串口接收事件
      end;
    end;
  end;
end;

Procedure TForm1.CommInitialize;
Var
Lpdcb:TDCB;
begin
  hcom:=createFile('com1',   //串口名，可为com1-com4
                 generic_read or Generic_write,//访问模式
                 0,           //共享模式,必须为0
                 nil,           //安全属性指针
                    open_existing,   ///找开方式必须为open_existing
                    File_Flag_Overlapped,//文件属性,本文设为交迭标志
                    0);                 //临时文件句柄,必须为0  
  if hcom<>invalid_Handle_Value then
  begin
     SetupComm(hcom,4096,4096);          //设置缓冲区长度
     getCommState(hcom,lpdcb);           //设置串口
     lpdcb.baudrate:=9600;
     lpdcb.stopbits:=0;
     lpdcb.bytesize:=8;
     lpdcb.parity:=0;
     setCommState(hcom,lpdcb);
     SetCommMask(Hcom,ev_Rxchar);         //设置串口事件屏蔽
  end else showMessage('无法打开串口！');
end;

Function TForm1.WriteStr(const Str:String):Boolean;            //发送数据
var
DwCharsWritten,DwRes:Dword;
S_DATA:String;
BRes:boolean;
Begin
  BRes:=False;
  S_Data:=Str;
  if hcom<>INVALID_HANDLE_VALUE then
  begin
    DwCharsWritten:=0;
    BRes:=WriteFile(Hcom,PChar(S_Data)^,Length(S_Data),
              DwCharsWritten,LpolW);     //返回True，数据立即发送完成
    if not BRes then
    begin
     if GetLastError()=Error_IO_Pending then
       begin   //正在发送数据
          DwRes:=WaitForSingleObject(LpolW^.hEvent,Infinite);
          if DwRes=Wait_Object_0 then  // 如果不相等，出错
             BRes:=GetOverLappedResult(hcom,LpolW^,DwCharsWritten,False)  //返回False,出错
          else BRes:=true;   //数据发送完成
       end;
    end;
  end;
  Result:=Bres;
end;

Procedure TForm1.MsgComm(Var Msg:Tmessage);      //接收数据
var
 clear:boolean;
 coms:TComStat;
 cbNum,Cbread,lpErrors:Dword;
 s:string;
begin
 clear:=clearCommerror(hcom,lperrors,@Coms);
 if clear then
 begin
   cbnum:=Coms.cbInQue;    //获取接收缓冲区待接收字节数
   setlength(s,cbnum+1);     //分配内存
   ReadFile(hcom,PChar(S)^,cbnum,Cbread,LpolR);   //读串口
   setlength(s,cbread);      //分配
   SetEvent(Post_Event);     //同步事件置位
   Memo1.Lines.Add(S);
 end;
end;


procedure TForm1.Button1Click(Sender: TObject);  //发送HEX码EB90EB90
Var
S_DATA:String;
begin
  S_Data:=Chr($eb)+Chr($90)+Chr($eb)+Chr($90);
  If  not WriteStr(S_Data) then  ShowMessage('无法发送数据')
  else ShowMessage('发送成功');
end;

procedure TForm1.FormDestroy(Sender: TObject);   //释放内存
begin
 CloseHandle(LpolW^.hEvent);
 CloseHandle(LpolR^.hEvent);
 dispose(lpolW);
 dispose(lpolR);
 LpolW:=Nil;
 LpolR:=Nil;
 RXComm.Terminate;
 SetEvent(Post_Event);
 CloseHandle(Post_Event);
 CloseHandle(hcom);
end;

procedure TForm1.FormCreate(Sender: TObject);    //初始化内存及串口
begin
  Comminitialize;
  New(lpolW);
  New(lpolR);
  LpolW^.Internal:=0;
  LpolW^.InternalHigh:=0;
  LpolW^.Offset:=0;
  LpolW^.OffsetHigh:=0;
  LpolW^.hEvent:=Createevent(nil,true,False,nil);
  Lpolr^.Internal:=0;
  Lpolr^.InternalHigh:=0;
  Lpolr^.Offset:=0;
  Lpolr^.OffsetHigh:=0;
  Lpolr^.hEvent:=Createevent(nil,true,False,nil);
  PurgeComm(Hcom,Purge_TxAbort or Purge_RxAbort or Purge_Txclear or Purge_Rxclear);
  Post_Event:=Createevent(nil,true,true,nil);
  RXComm:=Tcomm.Create(false);
end;

end.