userial.pas

一个通用的串口通讯类

{-----------------------------------------------------------------------------
  单元名: USerial
  作  者: 
  目  的: 实现串口通讯
-----------------------------------------------------------------------------}


unit USerial;

interface
uses
  Windows, SysUtils, Classes, Messages;

const
  IN_BUFFER_SIZE = 4096;
  VALID_BAUD: array[0..16] of Integer = (75, 110, 134, 150, 600, 1200, 1800,
                                         2400, 4800, 7200, 9600, 14400, 19200,
                                         38400, 57600, 15200, 128000);

type
    TValideBaud = (vb75, vb110, vb134, vb150, vb600, vb1200, vb1800, {有效的波特率}
                 vb2400, vb4800, vb7200, vb9600, vb14400, vb19200,
                 vb38400, vb57600, vb15200, vb128000);

{This follow class (TSerial) was created by Liyunqi on 2005_1_5}
{This is the Comm Base class for Port Communitions}
  TSerial = class
  private
    m_hCommFile:              THandle;
    m_OverlappedRead:         TOverlapped;
    m_OverlappedWrite:        TOverlapped;
    m_bOpened:                Boolean;

    function  WriteCommByte(btChar :Byte): Boolean;
  protected

  public
    constructor Create;
    destructor  Destroy; override;
    function    StartComm(Port: String; Baud: Integer): Boolean;
    procedure   StopComm;
    function    ClearBuf: Boolean;
    function    IsOpened: Boolean;
    function    WaitReadingData: Integer;
    function    SendData(const sdData: String): Integer;
    function    ReadData(var rdData: String; Count: Integer = -1): Integer;
  end;                 
implementation
{ TSerial }

function TSerial.ClearBuf: Boolean;
var
  S: String;
begin
  Result := PurgeComm(m_hCommFile, PURGE_TXCLEAR or PURGE_RXCLEAR);
  ReadData(S);
end;

constructor TSerial.Create;
begin
  FillChar(m_OverlappedRead, Sizeof(m_OverlappedRead), 0 );
  FillChar(m_OverlappedRead, Sizeof(m_OverlappedRead), 0 );
  m_hCommFile := 0;
  m_bOpened   := False;
end;

destructor TSerial.Destroy;
begin
  if m_bOpened then
     StopComm;
  inherited;
end;

function TSerial.IsOpened: Boolean;
begin
  Result := m_bOpened;
end;

function TSerial.ReadData(var rdData: String; Count: Integer = -1): Integer;
var
  bReadStatus: Boolean;
  dwBytesRead, dwErrorFlags: DWORD;
  ComStat: TComStat;
  btData: array[0..IN_BUFFER_SIZE - 1] of Char;
  I: Integer;
begin
  rdData := '';
  Result := 0;
  if Count < 0 then begin   //读入所有数据
    if (m_hCommFile <> 0) and m_bOpened then begin
       ClearCommError(m_hCommFile, dwErrorFlags, @ComStat);
       dwBytesRead := ComStat.cbInQue;
       if dwBytesRead = 0 then Exit;  {There is no data to Read}
       bReadStatus := ReadFile(
                                  m_hCommFile, btData, dwBytesRead,
                                  dwBytesRead, @m_OverlappedRead
                              );
       if not bReadStatus then begin
          if GetLastError = ERROR_IO_PENDING then begin
             WaitForSingleObject( m_OverlappedRead.hEvent, 2000 );
             Result := dwBytesRead;
          end else
            Exit;
       end else
          Result := dwBytesRead;
    end;
    for I:= 0 to dwBytesRead - 1 do rdData := rdData + Char(btData[I]);
  end else begin
    if (m_hCommFile <> 0) and m_bOpened then begin
       ClearCommError(m_hCommFile, dwErrorFlags, @ComStat);
       dwBytesRead := ComStat.cbInQue;
       if dwBytesRead = 0 then Exit;  {There is no data to Read}
       if Integer(dwBytesRead) > Count then
          dwBytesRead := Count;
       bReadStatus := ReadFile(
                                  m_hCommFile, btData, dwBytesRead,
                                  dwBytesRead, @m_OverlappedRead
                              );
       if not bReadStatus then begin
          if GetLastError = ERROR_IO_PENDING then begin
             WaitForSingleObject( m_OverlappedRead.hEvent, 2000 );
             Result := dwBytesRead;
          end else
            Exit;
       end else
          Result := dwBytesRead;
    end;
    for I:= 0 to dwBytesRead - 1 do rdData := rdData + Char(btData[I]);
  end;

{
  S := '';
  for I:= 1 to Length(rdData) do
    S := S + IntToHex(Byte(rdData[I]),2) + ' ';
  test_a.Add(TimeToStr(Now) + ',Receive: ' + S);     }
end;

function TSerial.SendData(const sdData: String): Integer;
var
  I: Integer;
//  S: String;
begin
{  S := '';
  for I:= 1 to Length(sdData) do
    S := S + IntToHex(Byte(sdData[I]),2) + ' ';
  test_a.Add(TimeToStr(Now) + ',   Send: ' + S);    }

  Result := 0;
  if (m_hCommFile <> 0) and m_bOpened then begin
     for I := 1 to Length(sdData) do begin
         if not WriteCommByte( Byte(sdData[I]) ) then Break;
         Inc(Result);
     end;
  end;
end;

function TSerial.StartComm(Port: String; Baud: Integer): Boolean;
var
  dcb: TDCB;
  CommTimeOuts: TCOMMTIMEOUTS;
  dwInQueue: DWORD;
  dwOutQueue: DWORD;
begin
  Result := True;
  if m_bOpened then Exit;
  m_hCommFile := CreateFile(
                              PChar(Port), GENERIC_READ or GENERIC_WRITE,
                              0, nil, OPEN_EXISTING,
                              FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0
                           );
  if m_hCommFile = 0 then begin
     Result := False;
     Exit;
  end;
  
  FillChar(m_OverlappedRead, Sizeof(m_OverlappedRead), 0 );
  FillChar(m_OverlappedRead, Sizeof(m_OverlappedRead), 0 );

  CommTimeOuts.ReadIntervalTimeout           := $FFFFFFFF;
  CommTimeOuts.ReadTotalTimeoutMultiplier    := 0;
  CommTimeOuts.ReadTotalTimeoutConstant      := 0;
  CommTimeOuts.WriteTotalTimeoutMultiplier   := 0;
  CommTimeOuts.WriteTotalTimeoutConstant     := 5000;
  SetCommTimeouts(m_hCommFile, CommTimeOuts);
	
  m_OverlappedRead.hEvent  := CreateEvent(nil, True, False, nil);
  m_OverlappedWrite.hEvent := CreateEvent(nil, True, False, nil);
  if (m_OverlappedRead.hEvent = 0) or (m_OverlappedWrite.hEvent = 0) then begin
      Result := False;
      StopComm;
      Exit;
  end;
  
  dcb.DCBlength   := sizeof( DCB );
  GetCommState(m_hCommFile, dcb);
  dcb.BaudRate    := Baud;     {You can change the follow settings by}
  dcb.ByteSize    := 8;        {your own machine settings}
  dcb.Parity      := 0;
  dcb.StopBits    := 0;

  dwInQueue       := 128;
  dwOutQueue      := 128;

  if (not SetCommState( m_hCommFile, dcb )) or
     (not SetupComm(m_hCommFile, dwInQueue, dwOutQueue)) then begin
          Result := False;
          StopComm;
          Exit;
  end;
  EscapeCommFunction(m_hCommFile, CLRRTS); {This is because of dcb.Parity := 0}
  m_bOpened := True;
end;

procedure TSerial.StopComm;
begin
  if m_OverlappedRead.hEvent <> 0 then CloseHandle(m_OverlappedRead.hEvent);
  if m_OverlappedWrite.hEvent <> 0 then CloseHandle(m_OverlappedWrite.hEvent);
  if m_hCommFile <> 0 then CloseHandle(m_hCommFile);
  m_bOpened   := False;
  m_hCommFile := 0;
end;

function TSerial.WaitReadingData: Integer;
var
  dwErrorFlags: DWord;
  ComStat: TComStat;
begin
  Result := 0;
  if (m_hCommFile <> 0) and m_bOpened then begin
     ClearCommError(m_hCommFile, dwErrorFlags, @ComStat );
     Result := Integer(ComStat.cbInQue);
  end;
end;

function TSerial.WriteCommByte(btChar: Byte): Boolean;
var
  bWriteStat: Boolean;
  dwBytesWritten: DWORD;
begin
  Result := False;
  if (m_hCommFile = 0) or (not m_bOpened) then Exit;
  bWriteStat := WriteFile(
                                m_hCommFile, btChar, 1,
                                dwBytesWritten, @m_OverlappedWrite
                         );
  if (not bWriteStat) and (GetLastError = ERROR_IO_PENDING) then begin
   //  if Boolean(WaitForSingleObject( m_OverlappedWrite.hEvent, 1000)) then
   //     dwBytesWritten := 0
   //  else begin
     if WaitForSingleObject( m_OverlappedWrite.hEvent, 1000)=0 then
     begin
        GetOverlappedResult(m_hCommFile, m_OverlappedWrite, dwBytesWritten, False );
        Inc(m_OverlappedWrite.Offset, dwBytesWritten);
     end;
  end;
  Result := True;
end;
end.