mycommut.pas

自已写的串口通信程序, delphi 7开发

unit MyCommUt;

interface

uses
  Windows, Messages, Classes, Forms, SysUtils;

Const
  Wm_CommNotify = WM_User + 63;

Type
  TComRecvThd = class;
  
  TMyComm = class
    FHandle:    THandle;
    FBaud:      Integer;  //波特率
    FComPtNum:  byte;     //Com口索引，如com1,com2...

    FComRecvThd: TComRecvThd;
    procedure ProcessCommMessage(var Msg: TMessage);
   protected
    { Protected declarations }
    procedure WndProc(var Msg: TMessage);
  public
    { Public declarations }
    Constructor Create;
    Destructor Destroy; override;
    Function Open(aBaud: Integer; aComPtNum: byte): boolean;
    Function Close :boolean ;
    Function SendStr(const Str:String):Boolean; //发送字符串数据
  end;

  TComRecvThd = class(TThread)
  
  private
    { Private declarations }

  protected
    procedure Execute; override;
    
  public
    FMyComm : TMyComm;
  end;
  

var hCom, Post_Event: Thandle;
    LpolW, LpolR: TOverlapped;
    MyComm: TMyComm;

implementation

constructor TMyComm.Create;
begin
  FHandle := Classes.AllocateHwnd(WndProc);
end;

destructor TMyComm.Destroy;
begin
  CloseHandle(LpolR.hEvent);
  CloseHandle(LpolW.hEvent);
  FComRecvThd.Terminate;
  SetEvent(Post_Event);
  CloseHandle(Post_Event);
  CloseHandle(hcom);
  hcom := INVALID_HANDLE_VALUE;
  Classes.DeallocateHWnd(FHandle);
  inherited;
end;

procedure TMyComm.WndProc(var Msg: TMessage);
begin
  try
    if Msg.Msg = Wm_CommNotify then
    begin
      ProcessCommMessage(Msg);
    end else msg.Result := DefWindowProc(FHandle, Msg.msg, Msg.wParam, Msg.lParam);
  except
    Application.HandleException(Self);
  end;
end;

//------------------------------------------------------------------------------
//设置端口超时时间
//入口参数:hCom -- 端口句柄, Timeout:超时秒数
//出口参数:True -- 成功  False -- 失败
function _SetCommTimeout(hCom: Thandle; TimeOut: integer): LongBool;
var
  commtimeouts :TCommTimeouts;
  ret :LongBool;
begin
  ret := False;
  try
    try
      commtimeouts.ReadIntervalTimeout         := TimeOut * 1000;
      commtimeouts.ReadTotalTimeoutMultiplier  := 0;
      commtimeouts.ReadTotalTimeoutConstant    := 0;
      commtimeouts.WriteTotalTimeoutMultiplier := 0;
      commtimeouts.WriteTotalTimeoutConstant   := 0;
      ret := SetCommTimeouts(hCom, commtimeouts);
    except
    end;
  finally
    Result := ret;
  end;
end;

//------------------------------------------------------------------------------
//功能:设置端口参数
//入口参数:hCom -- 端口句柄
//出口参数:1 --  成功   0  -- 失败
function _SetCommState(ahCom: Thandle; aBaud: Integer): LongBool;
var
  dcb: TDCB;
  ret: LongBool;
begin
  ret := False;
  try
    try
      GetCommState(ahCom,dcb);
      if BuildCommDCB(PChar('baud=' + IntToStr(aBaud) + ' parity=N data=8 stop=1'), dcb) then  //填充dcb数据
        ret := SetCommState(ahCom, dcb);
    except
      end;
  finally
    Result := ret;
  end;
end;

//------------------------------------------------------------------------------
function _Send(ahCom: THandle; OutPutBuffer: PChar; OutPutLength: Integer): LongBool;
var
  DwError, dwWrited: DWORD;
  Stat: TComStat;
  ret: LongBool;
begin
  ret := False;
  try
    try
      //清空串口
      ClearCommError(ahCom, dwError, @Stat);
      if dwError > 0 then PurgeComm(ahCom, PURGE_TXABORT or PURGE_TXCLEAR);
      //开始发送
      if not WriteFile(ahCom, OutPutBuffer^, OutPutLength, dwWrited, @LpolW) then
      begin
        if GetLastError = ERROR_IO_PENDING then
        begin
          if WaitForSingleObject( LpolW.hEvent, 50 ) = WAIT_OBJECT_0 then
          //超过50msec ,此函数将返回一个值, 如果是 WAIT_OBJECT_0(即指定的对象处于有信号状态。)
             GetOverlappedResult( ahCom, LpolW, dwWrited, False ); //dwwrited是用于容纳传输字节数量的一个变量
         // 最后一个参数bWait表明是否等待异步操作结束时才返回，如果设置为TRUE就可以等待文件读写完成时返回，否则就会马上返回
        end;
      end;
      ret := dwWrited <> 0;
    except
    end;
  finally
    Result := ret;
  end;
end;


Function TMyComm.SendStr(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;   //数据发送完成
          resetEvent(LpolW.hEvent);
       end;
    end; 
  end; 
  Result:=Bres; 
end;

//初始化串口
Function TMyComm.Open(aBaud: Integer; aComPtNum: byte): boolean;
begin
  Result := False;
  FBaud     := aBaud;          //波特率
  FComPtNum := aComPtNum;      //Com口索引

  hcom := createFile(Pchar('com' + IntTostr(FComPtNum)),   //串口名，可为com1-com5
                    GENERIC_READ or GENERIC_WRITE,         //访问模式
                    0,                                     //共享模式,必须为0
                    nil,                                   //安全属性指针
                    open_existing,                         //找开方式必须为open_existing
                    FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,//文件属性,本文设为交迭标志
                    0);                                    //临时文件句柄,必须为0
  //失败退出
  if hcom = INVALID_HANDLE_VALUE then exit;

  //是否为串口
  if GetFileType(hcom) <> FILE_TYPE_CHAR then
  begin
    CloseHandle(hcom);
    Exit;
  end;

  //设置串口输入输出缓冲区，缓冲设为32K
  if not SetupComm(hcom, 32768, 32768) then
  begin
    CloseHandle(hCom);
    Exit;
  end;

  //清空缓冲区PurgeComm（） 这个 API 可以用来终止目前正在进行的读或写的动作,
  //也可以 flush 掉 I/O buffer 内等待读或写的资料.
  PurgeComm(hCom, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR );

  //设置超时时间
  if not _SetCommTimeout(hCom, 5) then
  begin
    CloseHandle(hCom);
    Exit;
  end;

  //设置串口参数
  if not _SetCommState(hCom, FBaud) then
  begin
    CloseHandle(hCom);
    Exit;
  end;

  SetCommMask(hCom, ev_Rxchar);  //设置串口事件屏蔽，有哪些事情需要监视

  //初始化LapOver，读和写
  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);

  Post_Event := Createevent(nil,true,true,nil);

  FComRecvThd := TComRecvThd.Create(False);
  FComRecvThd.FMyComm := Self;
  Result := True;
end;

Function TMyComm.Close :boolean ;
begin
  CloseHandle(LpolR.hEvent);
  CloseHandle(LpolW.hEvent);
  FComRecvThd.Terminate;
  SetEvent(Post_Event);
  CloseHandle(Post_Event);
  CloseHandle(hcom);
  hcom := INVALID_HANDLE_VALUE;
  Result := True;
end;


procedure TMyComm.ProcessCommMessage(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);     //同步事件置位
   //comstr := comstr + s;
   //Memo1.Lines.Add(S);
 end; 
end;


//------ 接收线程 ------------------------------------------------
procedure TComRecvThd.Execute;
var
  dwEvtmask, dwOvres, bb: Dword;
  RXFinish: Bool;
begin
  while not self.Terminated 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
        PostMessage(FMyComm.FHandle, WM_CommNotify, 0, 0);  //发送消息,在这里可以触发串口接收事件
        resetEvent(Post_Event);      //同步事件复位
       end;
    end;
  end;
end;

end.