tcommclass_unit.pas

这是一个非常实用的实时串口通讯程序

unit TCommClass_Unit;

interface

uses Windows;

type
     TCommDriverClass = Class
     public
         function  SendData(lpBuf:pByte;Maxlen : DWORD): Integer;       
         function  ReceiveData(lpBuf:PByte;MaxLen:DWORD):Integer;
         function  InitPort: Boolean;
         Procedure InitVar(PortNo:Byte=1;BaudRate:DWORD=9600;ByteSize:Byte=8;Parity:Byte=0;StopBits:Byte=0);
         Procedure ClearInfo;
     public
         constructor Create;
         destructor  Destroy;override;
     private
         m_PortName     : PChar;        //串口名称
         m_hCom         : THandle;      //端口句柄
         m_TimeOuts     : TCOMMTIMEOUTS;
         m_ReadOlp      : TOverlapped;
         m_WriteOlp     : TOverlapped;
         m_Port         : Byte;         //端口号
         m_StopBits     : Byte;         //当前使用的停止位数
         m_ByteSize     : Byte;         //端口当前使用的数据位数
         m_Parity       : Byte;         //当前使用的奇偶校验方法
         m_BaudRate     : Cardinal;     //当前使用的数据传输率
         m_dcb          : TDCB;         //设备控制块
     End;

implementation

constructor TCommDriverClass.Create;
begin
   m_PortName   := PChar('');
   m_hCom       := 0;
   FillMemory(@m_TimeOuts,sizeof(TCOMMTIMEOUTS),0);
   FillMemory(@m_ReadOlp,sizeof(TOverlapped),0);
   FillMemory(@m_WriteOlp,sizeof(TOverlapped),0);
   m_Port       := 0;
   m_StopBits   := 0;
   m_ByteSize   := 0;
   m_Parity     := 0;
   m_BaudRate   := 0;
   FillMemory(@m_dcb,SizeOf(TDCB),0);
end;

destructor  TCommDriverClass.Destroy;
begin
   ClearInfo;
end;

function  TCommDriverClass.SendData(lpBuf:pByte;Maxlen : DWORD): Integer;
var
   bWrite       : Boolean;
   dwLen        : DWORD;
   comstat      : TCOMSTAT;
   dWrite       : DWORD;
   dwError      : DWORD;   
begin
(*
   利用Windows API发送数据。
*)
   dwLen  := 0;
   dWrite := 0;
   ClearCommError(m_hCom,dwError,@comstat);
   bWrite :=WRITEFILE(m_hCom,lpBuf^,Maxlen,dwLen,@m_WriteOlp);
   if Not bWrite then
      begin
         if (GetLastError=ERROR_IO_PENDING) then
            begin
               While (Not GetOverlappedResult(m_hCom,m_WriteOlp,dWrite,True)) do
                  begin
                     if (GetLastError=ERROR_IO_INCOMPLETE) then
                        begin
                           dwLen := dwLen + dWrite;
                           Continue;
                        end
                     else
                        begin
                           ClearCommError(m_hCom,dwError,@comstat);
                           Break;
                        end;
                  end;
               dwLen := dwLen + dWrite;
            end
         else
            begin
               ClearCommError(m_hCom,dwError,@comstat);
            end;
      end;
   Result := dwLen;
end;

function TCommDriverClass.ReceiveData(lpBuf:pByte;Maxlen : DWORD): Integer;
var
   bRead        : Boolean;
   comstat      : TCOMSTAT;
   dwError,dwLen,dwRead : DWORD;
begin
try
   dwError := 0;
   dwLen   := 0;
   dwRead  := 0;
   ClearCommError(m_hCom,dwError,@comstat);
   if (comstat.cbInQue=0) then
      begin
         Result := 0;
         Exit;
      end;
   if (comstat.cbInQue>Maxlen) then
      begin
         dwLen := Maxlen;
      end
   else
      begin
         dwLen := comstat.cbInQue;
      end;
   if (dwLen>0) then
      begin
         bRead :=READFILE(m_hCom,lpBuf^,dwLen,dwLen,@m_ReadOlp);
         if Not bRead then
            begin
               if (GetLastError=ERROR_IO_PENDING) then
                  begin
                     While (Not GetOverlappedResult(m_hCom,m_ReadOlp,dwRead,True)) do
                        begin
                           if (GetLastError=ERROR_IO_INCOMPLETE) then
                              begin
                                 dwLen := dwLen + dwRead;
                                 Continue;
                              end
                           else
                              begin
                                 ClearCommError(m_hCom,dwError,@comstat);
                                 Break;
                              end;
                        end;
                  end
               else
                  begin
                     ClearCommError(m_hCom,dwError,@comstat);
                  end;
            end;
      end;
   Result := dwLen;
except
end;   
end;

function  TCommDriverClass.InitPort: Boolean;
begin
//调用初始化端口函数之前，必须先调用变量初始化函数给变量进行初始化。
   m_ReadOlp.Offset := 0;
   m_ReadOlp.OffsetHigh := 0;
   m_ReadOlp.hEvent := CreateEvent(Nil,FALSE,FALSE,Nil);
   if (m_ReadOlp.hEvent=0) then
      begin
         ClearInfo;
         Result :=False;
         exit;
      end;
   m_WriteOlp.Offset := 0;
   m_WriteOlp.OffsetHigh := 0;
   m_WriteOlp.hEvent := CreateEvent(Nil,FALSE,FALSE,Nil);
   if (m_WriteOlp.hEvent=0) then
      begin
         ClearInfo;
         Result :=False;
         Exit;
      end;
   m_hCom := CREATEFILE(m_PortName,GENERIC_READ OR GENERIC_WRITE,0,Nil,
                        OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL OR FILE_FLAG_OVERLAPPED,0);
   if (m_hCom=INVALID_HANDLE_VALUE) then
      begin
         ClearInfo;
         Result :=False;
         Exit;
      end
   else
      begin
         m_TimeOuts.ReadIntervalTimeout := 1000;
         m_TimeOuts.ReadTotalTimeoutConstant := 1000;
         m_TimeOuts.ReadTotalTimeoutMultiplier := 500;
         m_TimeOuts.WriteTotalTimeoutConstant := 1000;
         m_TimeOuts.WriteTotalTimeoutMultiplier := 500;

         if (SetCommTimeOuts(m_hCom,m_TimeOuts)) then
            begin
               SetupComm(m_hCom,4096,4096);
               PurgeComm(m_hCom,PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR);
               m_dcb.DCBlength := SizeOf(TDCB);
               if (GetCommState(m_hCom,m_dcb)) then
                  begin
                     m_dcb.BaudRate := m_BaudRate;
                     m_dcb.StopBits := m_StopBits;
                     m_dcb.ByteSize := m_ByteSize;
                     m_dcb.Parity   := m_Parity;
                     if (SetCommState(m_hCom,m_dcb)) then
                        begin
                           Result := True;
                           Exit;
                        end
                     else
                        begin
                           ClearInfo;
                           Result := False;
                           Exit;
                        end;
                  end
               else
                  begin
                     ClearInfo;
                     Result := False;
                     Exit;
                  end;
            end
         else
            begin
               ClearInfo;
               Result := False;
               Exit;
            end;

      end;

end;

Procedure TCommDriverClass.InitVar(PortNo:Byte;BaudRate:DWORD;ByteSize:Byte;Parity:Byte;StopBits:Byte);
begin
   m_BaudRate   := BaudRate;
   m_ByteSize   := ByteSize;
   m_Parity     := Parity;
   m_Port       := PortNo;
   m_StopBits   := StopBits;
   Case PortNo of
      1:
        begin
           m_PortName :='COM1';
        end;
      2:
        begin
           m_PortName :='COM2';
        end;
      3:
        begin
           m_PortName :='COM3';
        end;
      4:
        begin
           m_PortName :='COM4';
        end;
      else
        begin
           m_PortName :='COM1';
        end;  
   End;
end;

Procedure TCommDriverClass.ClearInfo;
begin
   if (m_hCom<>INVALID_HANDLE_VALUE) then
      begin
         SetCommMask(m_hCom,0);
         PurgeComm(m_hCom,PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR);
         if (m_hCom<>0) then
            begin
               CloseHandle(m_hCom);
            end;
         m_hCom := 0;
      end
   else
      begin
         if (m_hCom<>0) then
            begin
               CloseHandle(m_hCom);
            end;
         m_hCom := 0;
      end;
   if (m_ReadOlp.hEvent<>0) then
      begin
         CloseHandle(m_ReadOlp.hEvent);
         m_ReadOlp.hEvent := 0;
      end;

   if (m_WriteOlp.hEvent<>0) then
      begin
         CloseHandle(m_WriteOlp.hEvent);
         m_WriteOlp.hEvent := 0;
      end;
   m_PortName   := PChar('');
   m_hCom       := 0;
   FillMemory(@m_TimeOuts,SizeOf(TCOMMTIMEOUTS),0);
   FillMemory(@m_ReadOlp,SizeOf(TOverlapped),0);
   FillMemory(@m_WriteOlp,SizeOf(TOverlapped),0);
   m_Port       := 0;
   m_StopBits   := 0;
   m_ByteSize   := 0;
   m_Parity     := 0;
   m_BaudRate   := 0;
   FillMemory(@m_dcb,SizeOf(TDCB),0);
end;

end.