www.pudn.com > Spcomm.rar > SPCOMM.PAS, change:2013-10-19,size:63095b


unit SPComm; 
// 
// 這是一個序列埠通訊元件, 供 Delphi 2.0 應用程式使用. 適合用來做工業控制及 
// 簡單傳輸. 此元件呼叫 Win32 API 來達成所需功能, 請見Communications部份。 
// 
// 此元件參考 David Wann. 所製作的 COMM32.PAS Version 1.0。原始說明如下: 
// This Communications Component is implemented using separate Read and Write 
// threads. Messages from the threads are posted to the Comm control which is 
// an invisible window. To handle data from the comm port, simply 
// attach a handler to 'OnReceiveData'. There is no need to free the memory 
// buffer passed to this handler. If TAPI is used to open the comm port, some 
// changes to this component are needed ('StartComm' currently opens the comm 
// port). The 'OnRequestHangup' event is included to assist this. 
// 
// David Wann 
// Stamina Software 
// 28/02/96 
// davidwann@hunterlink.net.au 
// 
// 
// 這個元件完全免費, 歡迎拷貝' 修改或做任何其它用途. 除了單獨販賣此元件. 
// This component is totally free(copyleft), you can do anything in any 
// purpose EXCEPT SELL IT ALONE. 
// 
// 
// Author?: 小豬工作室 Small-Pig Team         in Taiwan R.O.C. 
// Email   : spigteam@vlsi.ice.cycu.edu.tw 
// Date ? : 1997/5/9 
// 
// Version 1.01     1996/9/4 
//                  - Add setting Parity, Databits, StopBits 
//                  - Add setting Flowcontrol:Dtr-Dsr, Cts-Rts, Xon-Xoff 
//                  - Add setting Timeout information for read/write 
// 
// Version 1.02     1996/12/24 
//                  - Add Sender parameter to TReceiveDataEvent 
// 
// Version 2.0      1997/4/15 
//                  - Support separatly DTR/DSR and RTS/CTS hardware flow control setting 
//                  - Support separatly OutX and InX software flow control setting 
//                  - Log file(for debug) may used by many comms at the same time 
//                  - Add DSR sensitivity property 
//                  - You can set error char. replacement when parity error 
//                  - Let XonLim/XoffLim and XonChar/XoffChar setting by yourself 
//                  - You may change flow-control when comm is still opened 
//                  - Change TComm32 to TComm 
//                  - Add OnReceiveError event handler 
//                  - Add OnReceiveError event handler when overrun, framing error, 
//                    parity error 
//                  - Fix some bug 
// 
// Version 2.01     1997/4/19 
//                  - Support some property for modem 
//                  - Add OnModemStateChange event hander when RLSD(CD) change state 
// 
// Version 2.02     1997/4/28 
//                  - Bug fix: When receive XOFF character, the system FAULT!!!! 
// 
// Version 2.5      1997/5/9 
//                  - Add OnSendDataEmpty event handler when all data in buffer 
//                    are sent(send-buffer become empty) this handler is called. 
//                    You may call send data here. 
//                  - Change the ModemState parameters in OnModemStateChange 
//                    to ModemEvent to indicate what modem event make this call 
//                  - Add RING signal detect. When RLSD changed state or 
//                    RING signal was detected, OnModemStateChange handler is called 
//                  - Change XonLim and XoffLim from 100 to 500 
//                  - Remove TWriteThread.WriteData member 
//                  - PostHangupCall is re-design for debuging function  
//                  - Add a boolean property SendDataEmpty, True when send buffer 
//                    is empty 
// 
 
interface 
 
uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 
 
const 
     // messages from read/write threads 
     PWM_GOTCOMMDATA = WM_USER + 1; 
     PWM_RECEIVEERROR = WM_USER + 2; 
     PWM_REQUESTHANGUP = WM_USER + 3; 
     PWM_MODEMSTATECHANGE = WM_USER + 4; 
     PWM_SENDDATAEMPTY = WM_USER + 5; 
 
type 
    TParity = ( None, Odd, Even, Mark, Space ); 
    TStopBits = ( _1, _1_5, _2 ); 
    TByteSize = ( _5, _6, _7, _8 ); 
    TDtrControl = ( DtrEnable, DtrDisable, DtrHandshake ); 
    TRtsControl = ( RtsEnable, RtsDisable, RtsHandshake, RtsTransmissionAvailable ); 
 
    ECommsError = class( Exception ); 
    TReceiveDataEvent = procedure(Sender: TObject; Buffer: Pointer; 
                                  BufferLength: Word) of object; 
    TReceiveErrorEvent = procedure(Sender: TObject; EventMask : DWORD) of object; 
    TModemStateChangeEvent = procedure(Sender: TObject; ModemEvent : DWORD) of object; 
    TSendDataEmptyEvent = procedure(Sender: TObject) of object; 
 
const 
     // 
     // Modem Event Constant 
     // 
     ME_CTS = 1; 
     ME_DSR = 2; 
     ME_RING = 4; 
     ME_RLSD = 8; 
 
type 
    TReadThread = class( TThread ) 
    protected 
      procedure Execute; override; 
    public 
      hCommFile:          THandle; 
      hCloseEvent:        THandle; 
      hComm32Window:      THandle; 
 
      function SetupCommEvent( lpOverlappedCommEvent: POverlapped; 
                               var lpfdwEvtMask: DWORD ): Boolean; 
      function SetupReadEvent( lpOverlappedRead: POverlapped; 
                               lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD; 
                               var lpnNumberOfBytesRead: DWORD ): Boolean; 
      function HandleCommEvent( lpOverlappedCommEvent: POverlapped; 
                                var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean; 
      function HandleReadEvent( lpOverlappedRead: POverlapped; 
                                lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD; 
                                var lpnNumberOfBytesRead: DWORD ): Boolean; 
      function HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean; 
      function ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL; 
      function ReceiveError( EvtMask : DWORD ): BOOL; 
      function ModemStateChange( ModemEvent : DWORD ) : BOOL; 
      procedure PostHangupCall; 
    end; 
 
    TWriteThread = class( TThread ) 
    protected 
      procedure Execute; override; 
      function HandleWriteData( lpOverlappedWrite: POverlapped; 
                                pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean; 
    public 
      hCommFile:          THandle; 
      hCloseEvent:        THandle; 
      hComm32Window:      THandle; 
      pFSendDataEmpty:    ^Boolean; 
      procedure PostHangupCall; 
    end; 
 
    TComm = class( TComponent ) 
    private 
      { Private declarations } 
      ReadThread:         TReadThread; 
      WriteThread:        TWriteThread; 
      hCommFile:          THandle; 
      hCloseEvent:        THandle; 
      FHWnd:              THandle; 
      FSendDataEmpty:     Boolean;            // True if send buffer become empty 
 
      FCommName:          String; 
      FBaudRate:          DWORD; 
      FParityCheck:       Boolean; 
      FOutx_CtsFlow:      Boolean; 
      FOutx_DsrFlow:      Boolean; 
      FDtrControl:        TDtrControl; 
      FDsrSensitivity:    Boolean; 
      FTxContinueOnXoff:  Boolean; 
      FOutx_XonXoffFlow:  Boolean; 
      FInx_XonXoffFlow:   Boolean; 
      FReplaceWhenParityError:    Boolean; 
      FIgnoreNullChar:    Boolean; 
      FRtsControl:        TRtsControl; 
      FXonLimit:          WORD; 
      FXoffLimit:         WORD; 
      FByteSize:          TByteSize; 
      FParity:            TParity; 
      FStopBits:          TStopBits; 
      FXonChar:           AnsiChar; 
      FXoffChar:          AnsiChar; 
      FReplacedChar:      AnsiChar; 
 
      FReadIntervalTimeout: DWORD; 
      FReadTotalTimeoutMultiplier: DWORD; 
      FReadTotalTimeoutConstant: DWORD; 
      FWriteTotalTimeoutMultiplier: DWORD; 
      FWriteTotalTimeoutConstant: DWORD; 
      FOnReceiveData:     TReceiveDataEvent; 
      FOnRequestHangup:   TNotifyEvent; 
      FOnReceiveError:    TReceiveErrorEvent; 
      FOnModemStateChange:TModemStateChangeEvent; 
      FOnSendDataEmpty: TSendDataEmptyEvent; 
 
      procedure SetBaudRate( Rate : DWORD ); 
      procedure SetParityCheck( b : Boolean ); 
      procedure SetOutx_CtsFlow( b : Boolean ); 
      procedure SetOutx_DsrFlow( b : Boolean ); 
      procedure SetDtrControl( c : TDtrControl ); 
      procedure SetDsrSensitivity( b : Boolean ); 
      procedure SetTxContinueOnXoff( b : Boolean ); 
      procedure SetOutx_XonXoffFlow( b : Boolean ); 
      procedure SetInx_XonXoffFlow( b : Boolean ); 
      procedure SetReplaceWhenParityError( b : Boolean ); 
      procedure SetIgnoreNullChar( b : Boolean ); 
      procedure SetRtsControl( c : TRtsControl ); 
      procedure SetXonLimit( Limit : WORD ); 
      procedure SetXoffLimit( Limit : WORD ); 
      procedure SetByteSize( Size : TByteSize ); 
      procedure SetParity( p : TParity ); 
      procedure SetStopBits( Bits : TStopBits ); 
      procedure SetXonChar( c : AnsiChar ); 
      procedure SetXoffChar( c : AnsiChar ); 
      procedure SetReplacedChar( c : AnsiChar ); 
 
      procedure SetReadIntervalTimeout( v : DWORD ); 
      procedure SetReadTotalTimeoutMultiplier( v : DWORD ); 
      procedure SetReadTotalTimeoutConstant( v : DWORD ); 
      procedure SetWriteTotalTimeoutMultiplier( v : DWORD ); 
      procedure SetWriteTotalTimeoutConstant( v : DWORD ); 
 
      procedure CommWndProc( var msg: TMessage ); 
      procedure _SetCommState; 
      procedure _SetCommTimeout; 
    protected 
      { Protected declarations } 
      procedure CloseReadThread; 
      procedure CloseWriteThread; 
      procedure ReceiveData(Buffer: PChar; BufferLength: Word); 
      procedure ReceiveError( EvtMask : DWORD ); 
      procedure ModemStateChange( ModemEvent : DWORD ); 
      procedure RequestHangup; 
      procedure _SendDataEmpty; 
    public 
      { Public declarations } 
      property Handle: THandle read hCommFile; 
      property SendDataEmpty : Boolean read FSendDataEmpty; 
      constructor Create( AOwner: TComponent ); override; 
      destructor Destroy; override; 
      procedure StartComm; 
      procedure StopComm; 
      function WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean; 
      function GetModemState : DWORD; 
    published 
      { Published declarations } 
      property CommName: String read FCommName write FCommName; 
      property BaudRate: DWORD read FBaudRate write SetBaudRate; 
      property ParityCheck: Boolean read FParityCheck write SetParityCheck; 
      property Outx_CtsFlow: Boolean read FOutx_CtsFlow write SetOutx_CtsFlow; 
      property Outx_DsrFlow: Boolean read FOutx_DsrFlow write SetOutx_DsrFlow; 
      property DtrControl: TDtrControl read FDtrControl write SetDtrControl; 
      property DsrSensitivity: Boolean read FDsrSensitivity write SetDsrSensitivity; 
      property TxContinueOnXoff: Boolean read FTxContinueOnXoff write SetTxContinueOnXoff; 
      property Outx_XonXoffFlow: Boolean read FOutx_XonXoffFlow write SetOutx_XonXoffFlow; 
      property Inx_XonXoffFlow: Boolean read FInx_XonXoffFlow write SetInx_XonXoffFlow; 
      property ReplaceWhenParityError: Boolean read FReplaceWhenParityError write SetReplaceWhenParityError; 
      property IgnoreNullChar: Boolean read FIgnoreNullChar write SetIgnoreNullChar; 
      property RtsControl: TRtsControl read FRtsControl write SetRtsControl; 
      property XonLimit: WORD read FXonLimit write SetXonLimit; 
      property XoffLimit: WORD read FXoffLimit write SetXoffLimit; 
      property ByteSize: TByteSize read FByteSize write SetByteSize; 
      property Parity: TParity read FParity write FParity; 
      property StopBits: TStopBits read FStopBits write SetStopBits; 
      property XonChar: AnsiChar read FXonChar write SetXonChar; 
      property XoffChar: AnsiChar read FXoffChar write SetXoffChar; 
      property ReplacedChar: AnsiChar read FReplacedChar write SetReplacedChar; 
 
      property ReadIntervalTimeout: DWORD         read FReadIntervalTimeout         write SetReadIntervalTimeout; 
      property ReadTotalTimeoutMultiplier: DWORD  read FReadTotalTimeoutMultiplier  write SetReadTotalTimeoutMultiplier; 
      property ReadTotalTimeoutConstant: DWORD    read FReadTotalTimeoutConstant    write SetReadTotalTimeoutConstant; 
      property WriteTotalTimeoutMultiplier: DWORD read FWriteTotalTimeoutMultiplier write SetWriteTotalTimeoutMultiplier; 
      property WriteTotalTimeoutConstant: DWORD   read FWriteTotalTimeoutConstant   write SetWriteTotalTimeoutConstant; 
 
      property OnReceiveData: TReceiveDataEvent 
               read FOnReceiveData write FOnReceiveData; 
      property OnReceiveError: TReceiveErrorEvent 
               read FOnReceiveError write FOnReceiveError; 
      property OnModemStateChange: TModemStateChangeEvent 
               read FOnModemStateChange write FOnModemStateChange; 
      property OnRequestHangup: TNotifyEvent 
               read FOnRequestHangup write FOnRequestHangup; 
      property OnSendDataEmpty: TSendDataEmptyEvent 
               read FOnSendDataEmpty write FOnSendDataEmpty; 
    end; 
 
const 
// This is the message posted to the WriteThread 
// When we have something to write. 
     PWM_COMMWRITE = WM_USER+1; 
 
// Default size of the Input Buffer used by this code. 
     INPUTBUFFERSIZE = 2048; 
 
procedure Register; 
 
implementation 
 
(******************************************************************************) 
//   TComm PUBLIC METHODS 
(******************************************************************************) 
 
constructor TComm.Create( AOwner: TComponent ); 
begin 
     inherited Create( AOwner ); 
 
     ReadThread := nil; 
     WriteThread := nil; 
     hCommFile := 0; 
     hCloseEvent := 0; 
     FSendDataEmpty := True; 
 
     FCommName := 'COM2'; 
     FBaudRate := 9600; 
     FParityCheck := False; 
     FOutx_CtsFlow := False; 
     FOutx_DsrFlow := False; 
     FDtrControl := DtrEnable; 
     FDsrSensitivity := False; 
     FTxContinueOnXoff := True; 
     FOutx_XonXoffFlow := True; 
     FInx_XonXoffFlow := True; 
     FReplaceWhenParityError := False; 
     FIgnoreNullChar := False; 
     FRtsControl := RtsEnable; 
     FXonLimit := 500; 
     FXoffLimit := 500; 
     FByteSize := _8; 
     FParity := None; 
     FStopBits := _1; 
     FXonChar := chr($11);      // Ctrl-Q 
     FXoffChar := chr($13);     // Ctrl-S 
     FReplacedChar := chr(0); 
     FReadIntervalTimeout         := 100; 
     FReadTotalTimeoutMultiplier  := 0; 
     FReadTotalTimeoutConstant    := 0; 
     FWriteTotalTimeoutMultiplier := 0; 
     FWriteTotalTimeoutConstant   := 0; 
 
     if not (csDesigning in ComponentState) then 
        FHWnd := AllocateHWnd(CommWndProc) 
end; 
 
destructor TComm.Destroy; 
begin 
     if not (csDesigning in ComponentState) then 
        DeallocateHWnd(FHwnd); 
         
     inherited Destroy; 
end; 
 
// 
//  FUNCTION: StartComm 
// 
//  PURPOSE: Starts communications over the comm port. 
// 
//  PARAMETERS: 
//    hNewCommFile - This is the COMM File handle to communicate with. 
//                   This handle is obtained from TAPI. 
// 
//  Output: 
//    Successful: Startup the communications. 
//    Failure: Raise a exception 
// 
//  COMMENTS: 
// 
//    StartComm makes sure there isn't communication in progress already, 
//    creates a Comm file, and creates the read and write threads.  It 
//    also configures the hNewCommFile for the appropriate COMM settings. 
// 
//    If StartComm fails for any reason, it's up to the calling application 
//    to close the Comm file handle. 
// 
// 
procedure TComm.StartComm; 
var 
   hNewCommFile:   THandle; 
begin 
     // Are we already doing comm? 
     if (hCommFile <> 0) then 
        raise ECommsError.Create( 'This serial port already opened' ); 
 
     hNewCommFile := CreateFile( PChar(FCommName), 
                                 GENERIC_READ or GENERIC_WRITE, 
                                 0, {not shared} 
                                 nil, {no security ??} 
                                 OPEN_EXISTING, 
                                 FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 
                                 0 {template} ); 
 
     if hNewCommFile = INVALID_HANDLE_VALUE then 
        raise ECommsError.Create( 'Error opening serial port' ); 
 
     // Is this a valid comm handle? 
     {  郅瞳粹 妏剞攜揹諳  褫蚚 
     if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then 
     begin 
          CloseHandle( hNewCommFile ); 
          raise ECommsError.Create( 'File handle is not a comm handle ' ) 
     end; 
      } 
     if not SetupComm( hNewCommFile, 4096, 4096 ) then 
     begin 
          CloseHandle( hCommFile ); 
          raise ECommsError.Create( 'Cannot setup comm buffer' ) 
     end; 
 
     // It is ok to continue. 
 
     hCommFile := hNewCommFile; 
 
     // purge any information in the buffer 
 
     PurgeComm( hCommFile, PURGE_TXABORT or PURGE_RXABORT or 
                           PURGE_TXCLEAR or PURGE_RXCLEAR ) ; 
     FSendDataEmpty := True; 
 
     // Setting the time-out value 
     _SetCommTimeout; 
 
     // Querying then setting the comm port configurations. 
     _SetCommState; 
 
     // Create the event that will signal the threads to close. 
     hCloseEvent := CreateEvent( nil, True, False, nil ); 
 
     if hCloseEvent = 0 then 
     begin 
          CloseHandle( hCommFile ); 
          hCommFile := 0; 
          raise ECommsError.Create( 'Unable to create event' ) 
     end; 
 
     // Create the Read thread. 
     try 
        ReadThread := TReadThread.Create( True {suspended} ); 
     except 
           ReadThread := nil; 
           CloseHandle( hCloseEvent ); 
           CloseHandle( hCommFile ); 
           hCommFile := 0; 
           raise ECommsError.Create( 'Unable to create read thread' ) 
     end; 
     ReadThread.hCommFile := hCommFile; 
     ReadThread.hCloseEvent := hCloseEvent; 
     ReadThread.hComm32Window := FHWnd; 
 
     // Comm threads should have a higher base priority than the UI thread. 
     // If they don't, then any temporary priority boost the UI thread gains 
     // could cause the COMM threads to loose data. 
     ReadThread.Priority := tpHighest; 
 
     // Create the Write thread. 
     try 
        WriteThread := TWriteThread.Create( True {suspended} ); 
     except 
           CloseReadThread; 
           WriteThread := nil; 
           CloseHandle( hCloseEvent ); 
           CloseHandle( hCommFile ); 
           hCommFile := 0; 
           raise ECommsError.Create( 'Unable to create write thread' ) 
     end; 
     WriteThread.hCommFile := hCommFile; 
     WriteThread.hCloseEvent := hCloseEvent; 
     WriteThread.hComm32Window := FHWnd; 
     WriteThread.pFSendDataEmpty := @FSendDataEmpty; 
 
     WriteThread.Priority := tpHigher; 
 
     ReadThread.Resume; 
     WriteThread.Resume 
 
     // Everything was created ok.  Ready to go! 
end; {TComm.StartComm} 
 
// 
//  FUNCTION: StopComm 
// 
//  PURPOSE: Stop and end all communication threads. 
// 
//  PARAMETERS: 
//    none 
// 
//  RETURN VALUE: 
//    none 
// 
//  COMMENTS: 
// 
//    Tries to gracefully signal all communication threads to 
//    close, but terminates them if it has to. 
// 
// 
procedure TComm.StopComm; 
begin 
     // No need to continue if we're not communicating. 
     if hCommFile = 0 then 
        Exit; 
 
     // Close the threads. 
     CloseReadThread; 
     CloseWriteThread; 
 
     // Not needed anymore. 
     CloseHandle( hCloseEvent ); 
 
     // Now close the comm port handle. 
     CloseHandle( hCommFile ); 
     hCommFile := 0 
end; {TComm.StopComm} 
 
// 
//  FUNCTION: WriteCommData(PChar, Word) 
// 
//  PURPOSE: Send a String to the Write Thread to be written to the Comm. 
// 
//  PARAMETERS: 
//    pszStringToWrite     - String to Write to Comm port. 
//    nSizeofStringToWrite - length of pszStringToWrite. 
// 
//  RETURN VALUE: 
//    Returns TRUE if the PostMessage is successful. 
//    Returns FALSE if PostMessage fails or Write thread doesn't exist. 
// 
//  COMMENTS: 
// 
//    This is a wrapper function so that other modules don't care that 
//    Comm writing is done via PostMessage to a Write thread.  Note that 
//    using PostMessage speeds up response to the UI (very little delay to 
//    'write' a string) and provides a natural buffer if the comm is slow 
//    (ie: the messages just pile up in the message queue). 
// 
//    Note that it is assumed that pszStringToWrite is allocated with 
//    LocalAlloc, and that if WriteCommData succeeds, its the job of the 
//    Write thread to LocalFree it.  If WriteCommData fails, then its 
//    the job of the calling function to free the string. 
// 
// 
function TComm.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean; 
var 
   Buffer: Pointer; 
begin 
     if (WriteThread <> nil) and (dwSizeofDataToWrite <> 0) then 
     begin 
          Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 )); 
          Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite ); 
          if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE, 
                                WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then 
          begin 
               FSendDataEmpty := False; 
               Result := True; 
               Exit 
          end 
     end; 
 
     Result := False 
end; {TComm.WriteCommData} 
 
// 
//  FUNCTION: GetModemState 
// 
//  PURPOSE: Read the state of modem input pin right now 
// 
//  PARAMETERS: 
//     none 
// 
//  RETURN VALUE: 
// 
//     A DWORD variable containing one or more of following codes: 
// 
//     Value       Meaning 
//     ----------  ----------------------------------------------------------- 
//     MS_CTS_ON   The CTS (clear-to-send) signal is on. 
//     MS_DSR_ON   The DSR (data-set-ready) signal is on. 
//     MS_RING_ON  The ring indicator signal is on. 
//     MS_RLSD_ON  The RLSD (receive-line-signal-detect) signal is on. 
// 
//     If this comm have bad handle or not yet opened, the return value is 0 
// 
//  COMMENTS: 
// 
//    This member function calls GetCommModemStatus and return its value. 
//    Before calling this member function, you must have a successful 
//    'StartOpen' call. 
// 
// 
function TComm.GetModemState : DWORD; 
var 
   dwModemState : DWORD; 
begin 
     if not GetCommModemStatus( hCommFile, dwModemState ) then 
        Result := 0 
     else 
         Result := dwModemState 
end; 
 
 
(******************************************************************************) 
//  TComm PROTECTED METHODS 
(******************************************************************************) 
 
// 
//  FUNCTION: CloseReadThread 
// 
//  PURPOSE: Close the Read Thread. 
// 
//  PARAMETERS: 
//    none 
// 
//  RETURN VALUE: 
//    none 
// 
//  COMMENTS: 
// 
//    Closes the Read thread by signaling the CloseEvent. 
//    Purges any outstanding reads on the comm port. 
// 
//    Note that terminating a thread leaks memory. 
//    Besides the normal leak incurred, there is an event object 
//    that doesn't get closed.  This isn't worth worrying about 
//    since it shouldn't happen anyway. 
// 
// 
procedure TComm.CloseReadThread; 
begin 
     // If it exists... 
     if ReadThread <> nil then 
     begin 
          // Signal the event to close the worker threads. 
          SetEvent( hCloseEvent ); 
 
          // Purge all outstanding reads 
          PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR ); 
 
          // Wait 10 seconds for it to exit.  Shouldn't happen. 
          if (WaitForSingleObject(ReadThread.Handle, 10000) = WAIT_TIMEOUT) then 
             ReadThread.Terminate; 
          ReadThread.Free; 
          ReadThread := nil 
     end 
end; {TComm.CloseReadThread} 
 
// 
//  FUNCTION: CloseWriteThread 
// 
//  PURPOSE: Closes the Write Thread. 
// 
//  PARAMETERS: 
//    none 
// 
//  RETURN VALUE: 
//    none 
// 
//  COMMENTS: 
// 
//    Closes the write thread by signaling the CloseEvent. 
//    Purges any outstanding writes on the comm port. 
// 
//    Note that terminating a thread leaks memory. 
//    Besides the normal leak incurred, there is an event object 
//    that doesn't get closed.  This isn't worth worrying about 
//    since it shouldn't happen anyway. 
// 
// 
procedure TComm.CloseWriteThread; 
begin 
     // If it exists... 
     if WriteThread <> nil then 
     begin 
          // Signal the event to close the worker threads. 
          SetEvent(hCloseEvent); 
 
          // Purge all outstanding writes. 
          PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR); 
          FSendDataEmpty := True; 
 
          // Wait 10 seconds for it to exit.  Shouldn't happen. 
          if WaitForSingleObject( WriteThread.Handle, 10000 ) = WAIT_TIMEOUT then 
             WriteThread.Terminate; 
          WriteThread.Free; 
          WriteThread := nil 
     end 
end; {TComm.CloseWriteThread} 
 
procedure TComm.ReceiveData(Buffer: PChar; BufferLength: Word); 
begin 
     if Assigned(FOnReceiveData) then 
        FOnReceiveData( self, Buffer, BufferLength ) 
end; 
 
procedure TComm.ReceiveError( EvtMask : DWORD ); 
begin 
     if Assigned(FOnReceiveError) then 
        FOnReceiveError( self, EvtMask ) 
end; 
 
procedure TComm.ModemStateChange( ModemEvent : DWORD ); 
begin 
     if Assigned(FOnModemStateChange) then 
        FOnModemStateChange( self, ModemEvent ) 
end; 
 
procedure TComm.RequestHangup; 
begin 
     if Assigned(FOnRequestHangup) then 
        FOnRequestHangup( Self ) 
end; 
 
procedure TComm._SendDataEmpty; 
begin 
     if Assigned(FOnSendDataEmpty) then 
        FOnSendDataEmpty( self ) 
end; 
 
(******************************************************************************) 
//  TComm PRIVATE METHODS 
(******************************************************************************) 
 
procedure TComm.CommWndProc( var msg: TMessage ); 
begin 
     case msg.msg of 
          PWM_GOTCOMMDATA: 
          begin 
               ReceiveData( PChar(msg.LParam), msg.WParam ); 
               LocalFree( msg.LParam ) 
          end; 
          PWM_RECEIVEERROR:    ReceiveError( msg.LParam ); 
          PWM_MODEMSTATECHANGE:ModemStateChange( msg.LParam ); 
          PWM_REQUESTHANGUP:   RequestHangup; 
          PWM_SENDDATAEMPTY:   _SendDataEmpty 
     end 
end; 
 
procedure TComm._SetCommState; 
var 
   dcb:            Tdcb; 
   commprop:       TCommProp; 
   fdwEvtMask:     DWORD; 
begin 
     // Configure the comm settings. 
     // NOTE: Most Comm settings can be set through TAPI, but this means that 
     //       the CommFile will have to be passed to this component. 
 
     GetCommState( hCommFile, dcb ); 
     GetCommProperties( hCommFile, commprop ); 
     GetCommMask( hCommFile, fdwEvtMask ); 
 
     // fAbortOnError is the only DCB dependancy in TapiComm. 
     // Can't guarentee that the SP will set this to what we expect. 
     {dcb.fAbortOnError := False; NOT VALID} 
 
     dcb.BaudRate := FBaudRate; 
 
     dcb.Flags := 1;         // Enable fBinary 
 
     if FParityCheck then 
        dcb.Flags := dcb.Flags or 2;          // Enable parity check 
 
     // setup hardware flow control 
 
     if FOutx_CtsFlow then 
        dcb.Flags := dcb.Flags or 4; 
 
     if FOutx_DsrFlow then 
        dcb.Flags := dcb.Flags or 8; 
 
     if FDtrControl = DtrEnable then 
        dcb.Flags := dcb.Flags or $10 
     else if FDtrControl = DtrHandshake then 
          dcb.Flags := dcb.Flags or $20; 
 
     if FDsrSensitivity then 
        dcb.Flags := dcb.Flags or $40; 
 
     if FTxContinueOnXoff then 
        dcb.Flags := dcb.Flags or $80; 
 
     if FOutx_XonXoffFlow then 
        dcb.Flags := dcb.Flags or $100; 
 
     if FInx_XonXoffFlow then 
        dcb.Flags := dcb.Flags or $200; 
 
     if FReplaceWhenParityError then 
        dcb.Flags := dcb.Flags or $400; 
 
     if FIgnoreNullChar then 
        dcb.Flags := dcb.Flags or $800; 
 
     if FRtsControl = RtsEnable then 
        dcb.Flags := dcb.Flags or $1000 
     else if FRtsControl = RtsHandshake then 
          dcb.Flags := dcb.Flags or $2000 
     else if FRtsControl = RtsTransmissionAvailable then 
          dcb.Flags := dcb.Flags or $3000; 
 
     dcb.XonLim := FXonLimit; 
     dcb.XoffLim := FXoffLimit; 
 
     dcb.ByteSize := Ord( FByteSize ) + 5; 
     dcb.Parity := Ord( FParity ); 
     dcb.StopBits := Ord( FStopBits ); 
 
     dcb.XonChar := FXonChar; 
     dcb.XoffChar := FXoffChar; 
 
     dcb.ErrorChar := FReplacedChar; 
 
     SetCommState( hCommFile, dcb ) 
end; 
 
procedure TComm._SetCommTimeout; 
var 
   commtimeouts:   TCommTimeouts; 
begin 
     GetCommTimeouts( hCommFile, commtimeouts ); 
 
     // The CommTimeout numbers will very likely change if you are 
     // coding to meet some kind of specification where 
     // you need to reply within a certain amount of time after 
     // recieving the last byte.  However,  If 1/4th of a second 
     // goes by between recieving two characters, its a good 
     // indication that the transmitting end has finished, even 
     // assuming a 1200 baud modem. 
 
     commtimeouts.ReadIntervalTimeout         := FReadIntervalTimeout; 
     commtimeouts.ReadTotalTimeoutMultiplier  := FReadTotalTimeoutMultiplier; 
     commtimeouts.ReadTotalTimeoutConstant    := FReadTotalTimeoutConstant; 
     commtimeouts.WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier; 
     commtimeouts.WriteTotalTimeoutConstant   := FWriteTotalTimeoutConstant; 
 
     SetCommTimeouts( hCommFile, commtimeouts ); 
end; 
 
procedure TComm.SetBaudRate( Rate : DWORD ); 
begin 
     if Rate = FBaudRate then 
        Exit; 
 
     FBaudRate := Rate; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetParityCheck( b : Boolean ); 
begin 
     if b = FParityCheck then 
        Exit; 
 
     FParityCheck := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetOutx_CtsFlow( b : Boolean ); 
begin 
     if b = FOutx_CtsFlow then 
        Exit; 
 
     FOutx_CtsFlow := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetOutx_DsrFlow( b : Boolean ); 
begin 
     if b = FOutx_DsrFlow then 
        Exit; 
 
     FOutx_DsrFlow := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetDtrControl( c : TDtrControl ); 
begin 
     if c = FDtrControl then 
        Exit; 
 
     FDtrControl := c; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetDsrSensitivity( b : Boolean ); 
begin 
     if b = FDsrSensitivity then 
        Exit; 
 
     FDsrSensitivity := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetTxContinueOnXoff( b : Boolean ); 
begin 
     if b = FTxContinueOnXoff then 
        Exit; 
 
     FTxContinueOnXoff := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetOutx_XonXoffFlow( b : Boolean ); 
begin 
     if b = FOutx_XonXoffFlow then 
        Exit; 
 
     FOutx_XonXoffFlow := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetInx_XonXoffFlow( b : Boolean ); 
begin 
     if b = FInx_XonXoffFlow then 
        Exit; 
 
     FInx_XonXoffFlow := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetReplaceWhenParityError( b : Boolean ); 
begin 
     if b = FReplaceWhenParityError then 
        Exit; 
 
     FReplaceWhenParityError := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetIgnoreNullChar( b : Boolean ); 
begin 
     if b = FIgnoreNullChar then 
        Exit; 
 
     FIgnoreNullChar := b; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetRtsControl( c : TRtsControl ); 
begin 
     if c = FRtsControl then 
        Exit; 
 
     FRtsControl := c; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetXonLimit( Limit : WORD ); 
begin 
     if Limit = FXonLimit then 
        Exit; 
 
     FXonLimit := Limit; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetXoffLimit( Limit : WORD ); 
begin 
     if Limit = FXoffLimit then 
        Exit; 
 
     FXoffLimit := Limit; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetByteSize( Size : TByteSize ); 
begin 
     if Size = FByteSize then 
        Exit; 
 
     FByteSize := Size; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetParity( p : TParity ); 
begin 
     if p = FParity then 
        Exit; 
 
     FParity := p; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetStopBits( Bits : TStopBits ); 
begin 
     if Bits = FStopBits then 
        Exit; 
 
     FStopBits := Bits; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetXonChar( c : AnsiChar ); 
begin 
     if c = FXonChar then 
        Exit; 
 
     FXonChar := c; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetXoffChar( c : AnsiChar ); 
begin 
     if c = FXoffChar then 
        Exit; 
 
     FXoffChar := c; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetReplacedChar( c : AnsiChar ); 
begin 
     if c = FReplacedChar then 
        Exit; 
 
     FReplacedChar := c; 
 
     if hCommFile <> 0 then 
        _SetCommState 
end; 
 
procedure TComm.SetReadIntervalTimeout( v : DWORD ); 
begin 
     if v = FReadIntervalTimeout then 
        Exit; 
 
     FReadIntervalTimeout := v; 
 
     if hCommFile <> 0 then 
        _SetCommTimeout 
end; 
 
procedure TComm.SetReadTotalTimeoutMultiplier( v : DWORD ); 
begin 
     if v = FReadTotalTimeoutMultiplier then 
        Exit; 
 
     FReadTotalTimeoutMultiplier := v; 
 
     if hCommFile <> 0 then 
        _SetCommTimeout 
end; 
 
procedure TComm.SetReadTotalTimeoutConstant( v : DWORD ); 
begin 
     if v = FReadTotalTimeoutConstant then 
        Exit; 
 
     FReadTotalTimeoutConstant := v; 
 
     if hCommFile <> 0 then 
        _SetCommTimeout 
end; 
 
procedure TComm.SetWriteTotalTimeoutMultiplier( v : DWORD ); 
begin 
     if v = FWriteTotalTimeoutMultiplier then 
        Exit; 
 
     FWriteTotalTimeoutMultiplier := v; 
 
     if hCommFile <> 0 then 
        _SetCommTimeout 
end; 
 
procedure TComm.SetWriteTotalTimeoutConstant( v : DWORD ); 
begin 
     if v = FWriteTotalTimeoutConstant then 
        Exit; 
 
     FWriteTotalTimeoutConstant := v; 
 
     if hCommFile <> 0 then 
        _SetCommTimeout 
end; 
 
(******************************************************************************) 
//  READ THREAD 
(******************************************************************************) 
 
// 
//  PROCEDURE: TReadThread.Execute 
// 
//  PURPOSE: This is the starting point for the Read Thread. 
// 
//  PARAMETERS: 
//    None. 
// 
//  RETURN VALUE: 
//    None. 
// 
//  COMMENTS: 
// 
//    The Read Thread uses overlapped ReadFile and sends any data 
//    read from the comm port to the Comm32Window.  This is 
//    eventually done through a PostMessage so that the Read Thread 
//    is never away from the comm port very long.  This also provides 
//    natural desynchronization between the Read thread and the UI. 
// 
//    If the CloseEvent object is signaled, the Read Thread exits. 
// 
//        Separating the Read and Write threads is natural for a application 
//    where there is no need for synchronization between 
//    reading and writing.  However, if there is such a need (for example, 
//    most file transfer algorithms synchronize the reading and writing), 
//    then it would make a lot more sense to have a single thread to handle 
//    both reading and writing. 
// 
// 
procedure TReadThread.Execute; 
var 
   szInputBuffer: array[0..INPUTBUFFERSIZE-1] of AnsiChar; 
   nNumberOfBytesRead:    DWORD; 
 
   HandlesToWaitFor:      array[0..2] of THandle; 
   dwHandleSignaled:      DWORD; 
 
   fdwEvtMask:                    DWORD; 
 
   // Needed for overlapped I/O (ReadFile) 
   overlappedRead:                TOverlapped; 
 
   // Needed for overlapped Comm Event handling. 
   overlappedCommEvent:   TOverlapped; 
label 
     EndReadThread; 
begin 
     FillChar( overlappedRead, Sizeof(overlappedRead), 0 ); 
     FillChar( overlappedCommEvent, Sizeof(overlappedCommEvent), 0 ); 
 
     // Lets put an event in the Read overlapped structure. 
     overlappedRead.hEvent := CreateEvent( nil, True, True, nil); 
     if overlappedRead.hEvent = 0 then 
     begin 
          PostHangupCall; 
          goto EndReadThread 
     end; 
 
     // And an event for the CommEvent overlapped structure. 
     overlappedCommEvent.hEvent := CreateEvent( nil, True, True, nil); 
     if overlappedCommEvent.hEvent = 0 then 
     begin 
          PostHangupCall(); 
          goto EndReadThread 
     end; 
 
     // We will be waiting on these objects. 
     HandlesToWaitFor[0] := hCloseEvent; 
     HandlesToWaitFor[1] := overlappedCommEvent.hEvent; 
     HandlesToWaitFor[2] := overlappedRead.hEvent; 
 
     // Setup CommEvent handling. 
 
     // Set the comm mask so we receive error signals. 
     if not SetCommMask(hCommFile, EV_ERR or EV_RLSD or EV_RING ) then 
     begin 
          PostHangupCall; 
          goto EndReadThread 
     end; 
 
     // Start waiting for CommEvents (Errors) 
     if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then 
        goto EndReadThread; 
 
     // Start waiting for Read events. 
     if not SetupReadEvent( @overlappedRead, 
                            szInputBuffer, INPUTBUFFERSIZE, 
                            nNumberOfBytesRead ) then 
        goto EndReadThread; 
 
     // Keep looping until we break out. 
     while True do 
     begin 
          // Wait until some event occurs (data to read; error; stopping). 
          dwHandleSignaled := WaitForMultipleObjects(3, @HandlesToWaitFor, 
                              False, INFINITE); 
 
          // Which event occured? 
          case dwHandleSignaled of 
               WAIT_OBJECT_0:     // Signal to end the thread. 
               begin 
                    // Time to exit. 
                    goto EndReadThread 
               end; 
 
               WAIT_OBJECT_0 + 1: // CommEvent signaled. 
               begin 
                    // Handle the CommEvent. 
                    if not HandleCommEvent( @overlappedCommEvent, fdwEvtMask, TRUE ) then 
                       goto EndReadThread; 
 
                    // Start waiting for the next CommEvent. 
                    if not SetupCommEvent( @overlappedCommEvent, fdwEvtMask ) then 
                       goto EndReadThread 
                    {break;??} 
               end; 
 
               WAIT_OBJECT_0 + 2: // Read Event signaled. 
               begin 
                    // Get the new data! 
                    if not HandleReadEvent( @overlappedRead, 
                                            szInputBuffer, 
                                            INPUTBUFFERSIZE, 
                                            nNumberOfBytesRead ) then 
                       goto EndReadThread; 
 
                    // Wait for more new data. 
                    if not SetupReadEvent( @overlappedRead, 
                                           szInputBuffer, INPUTBUFFERSIZE, 
                                           nNumberOfBytesRead ) then 
                       goto EndReadThread 
                    {break;} 
               end; 
 
               WAIT_FAILED:       // Wait failed.  Shouldn't happen. 
               begin 
                    PostHangupCall; 
                    goto EndReadThread 
               end 
               else    // This case should never occur. 
               begin 
                    PostHangupCall; 
                    goto EndReadThread 
               end 
          end {case dwHandleSignaled} 
     end; {while True} 
 
        // Time to clean up Read Thread. 
 EndReadThread: 
 
     PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR ); 
     CloseHandle( overlappedRead.hEvent ); 
     CloseHandle( overlappedCommEvent.hEvent ) 
end; {TReadThread.Execute} 
 
// 
//  FUNCTION: SetupReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD) 
// 
//  PURPOSE: Sets up an overlapped ReadFile 
// 
//  PARAMETERS: 
//    lpOverlappedRead      - address of overlapped structure to use. 
//    lpszInputBuffer       - Buffer to place incoming bytes. 
//    dwSizeofBuffer        - size of lpszInputBuffer. 
//    lpnNumberOfBytesRead  - address of DWORD to place the number of read bytes. 
// 
//  RETURN VALUE: 
//    TRUE if able to successfully setup the ReadFile.  FALSE if there 
//    was a failure setting up or if the CloseEvent object was signaled. 
// 
//  COMMENTS: 
// 
//    This function is a helper function for the Read Thread.  This 
//    function sets up the overlapped ReadFile so that it can later 
//    be waited on (or more appropriatly, so the event in the overlapped 
//    structure can be waited upon).  If there is data waiting, it is 
//    handled and the next ReadFile is initiated. 
//    Another possible reason for returning FALSE is if the comm port 
//    is closed by the service provider. 
// 
// 
// 
function TReadThread.SetupReadEvent( lpOverlappedRead: POverlapped; 
         lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD; 
         var lpnNumberOfBytesRead: DWORD ): Boolean; 
var 
   dwLastError: DWORD; 
label 
     StartSetupReadEvent; 
begin 
     Result := False; 
 
StartSetupReadEvent: 
 
     // Make sure the CloseEvent hasn't been signaled yet. 
     // Check is needed because this function is potentially recursive. 
     if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then 
        Exit; 
 
     // Start the overlapped ReadFile. 
     if ReadFile( hCommFile, 
                  lpszInputBuffer^, dwSizeofBuffer, 
                  lpnNumberOfBytesRead, lpOverlappedRead ) then 
     begin 
          // This would only happen if there was data waiting to be read. 
 
          // Handle the data. 
          if not HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead ) then 
             Exit; 
 
          // Start waiting for more data. 
          goto StartSetupReadEvent 
     end; 
 
     // ReadFile failed.  Expected because of overlapped I/O. 
     dwLastError := GetLastError; 
 
     // LastError was ERROR_IO_PENDING, as expected. 
     if dwLastError = ERROR_IO_PENDING then 
     begin 
          Result := True; 
          Exit 
     end; 
 
     // Its possible for this error to occur if the 
     // service provider has closed the port.  Time to end. 
     if dwLastError = ERROR_INVALID_HANDLE then 
        Exit; 
 
     // Unexpected error come here. No idea what could cause this to happen. 
     PostHangupCall 
end; {TReadThread.SetupReadEvent} 
 
// 
//  FUNCTION: HandleReadData(LPCSTR, DWORD) 
// 
//  PURPOSE: Deals with data after its been read from the comm file. 
// 
//  PARAMETERS: 
//    lpszInputBuffer  - Buffer to place incoming bytes. 
//    dwSizeofBuffer   - size of lpszInputBuffer. 
// 
//  RETURN VALUE: 
//    TRUE if able to successfully handle the data. 
//    FALSE if unable to allocate memory or handle the data. 
// 
//  COMMENTS: 
// 
//    This function is yet another helper function for the Read Thread. 
//    It LocalAlloc()s a buffer, copies the new data to this buffer and 
//    calls PostWriteToDisplayCtl to let the EditCtls module deal with 
//    the data.  Its assumed that PostWriteToDisplayCtl posts the message 
//    rather than dealing with it right away so that the Read Thread 
//    is free to get right back to waiting for data.  Its also assumed 
//    that the EditCtls module is responsible for LocalFree()ing the 
//    pointer that is passed on. 
// 
// 
function TReadThread.HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean; 
var 
   lpszPostedBytes: LPSTR; 
begin 
     Result := False; 
 
     // If we got data and didn't just time out empty... 
     if dwSizeofBuffer <> 0 then 
     begin 
          // Do something with the bytes read. 
 
          lpszPostedBytes := PAnsiChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) ); 
 
          if lpszPostedBytes = nil{NULL} then 
          begin 
               // Out of memory 
                
               PostHangupCall; 
               Exit 
          end; 
 
          Move( lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer ); 
          lpszPostedBytes[dwSizeofBuffer] := #0; 
 
          Result := ReceiveData( lpszPostedBytes, dwSizeofBuffer ) 
     end 
end; {TReadThread.HandleReadData} 
 
// 
//  FUNCTION: HandleReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD) 
// 
//  PURPOSE: Retrieves and handles data when there is data ready. 
// 
//  PARAMETERS: 
//    lpOverlappedRead      - address of overlapped structure to use. 
//    lpszInputBuffer       - Buffer to place incoming bytes. 
//    dwSizeofBuffer        - size of lpszInputBuffer. 
//    lpnNumberOfBytesRead  - address of DWORD to place the number of read bytes. 
// 
//  RETURN VALUE: 
//    TRUE if able to successfully retrieve and handle the available data. 
//    FALSE if unable to retrieve or handle the data. 
// 
//  COMMENTS: 
// 
//    This function is another helper function for the Read Thread.  This 
//    is the function that is called when there is data available after 
//    an overlapped ReadFile has been setup.  It retrieves the data and 
//    handles it. 
// 
// 
function TReadThread.HandleReadEvent( lpOverlappedRead: POverlapped; 
         lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD; 
         var lpnNumberOfBytesRead: DWORD ): Boolean; 
var 
   dwLastError: DWORD; 
begin 
     Result := False; 
      
     if GetOverlappedResult( hCommFile, 
                             lpOverlappedRead^, lpnNumberOfBytesRead, False ) then 
     begin 
          Result := HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead ); 
          Exit 
     end; 
 
     // Error in GetOverlappedResult; handle it. 
 
     dwLastError := GetLastError; 
 
     // Its possible for this error to occur if the 
     // service provider has closed the port.  Time to end. 
     if dwLastError = ERROR_INVALID_HANDLE then 
        Exit; 
 
     // Unexpected error come here. No idea what could cause this to happen. 
     PostHangupCall 
end; {TReadThread.HandleReadEvent} 
 
// 
//  FUNCTION: SetupCommEvent(LPOVERLAPPED, LPDWORD) 
// 
//  PURPOSE: Sets up the overlapped WaitCommEvent call. 
// 
//  PARAMETERS: 
//    lpOverlappedCommEvent - Pointer to the overlapped structure to use. 
//    lpfdwEvtMask          - Pointer to DWORD to received Event data. 
// 
//  RETURN VALUE: 
//    TRUE if able to successfully setup the WaitCommEvent. 
//    FALSE if unable to setup WaitCommEvent, unable to handle 
//    an existing outstanding event or if the CloseEvent has been signaled. 
// 
//  COMMENTS: 
// 
//    This function is a helper function for the Read Thread that sets up 
//    the WaitCommEvent so we can deal with comm events (like Comm errors) 
//    if they occur. 
// 
// 
function TReadThread.SetupCommEvent( lpOverlappedCommEvent: POverlapped; 
         var lpfdwEvtMask: DWORD ): Boolean; 
var 
   dwLastError: DWORD; 
label 
     StartSetupCommEvent; 
begin 
     Result := False; 
      
StartSetupCommEvent: 
 
     // Make sure the CloseEvent hasn't been signaled yet. 
     // Check is needed because this function is potentially recursive. 
     if WAIT_TIMEOUT <> WaitForSingleObject( hCloseEvent,0 ) then 
        Exit; 
 
     // Start waiting for Comm Errors. 
     if WaitCommEvent( hCommFile, lpfdwEvtMask, lpOverlappedCommEvent ) then 
     begin 
          // This could happen if there was an error waiting on the 
          // comm port.  Lets try and handle it. 
 
          if not HandleCommEvent( nil, lpfdwEvtMask, False ) then 
          begin 
               {??? GetOverlappedResult does not handle "NIL" as defined by Borland} 
               Exit 
          end; 
 
          // What could cause infinite recursion at this point? 
          goto StartSetupCommEvent 
     end; 
 
     // We expect ERROR_IO_PENDING returned from WaitCommEvent 
     // because we are waiting with an overlapped structure. 
 
     dwLastError := GetLastError; 
 
     // LastError was ERROR_IO_PENDING, as expected. 
     if dwLastError = ERROR_IO_PENDING then 
     begin 
          Result := True; 
          Exit 
     end; 
 
     // Its possible for this error to occur if the 
     // service provider has closed the port.  Time to end. 
     if dwLastError = ERROR_INVALID_HANDLE then 
        Exit; 
 
     // Unexpected error. No idea what could cause this to happen. 
     PostHangupCall 
end; {TReadThread.SetupCommEvent} 
 
// 
//  FUNCTION: HandleCommEvent(LPOVERLAPPED, LPDWORD, BOOL) 
// 
//  PURPOSE: Handle an outstanding Comm Event. 
// 
//  PARAMETERS: 
//    lpOverlappedCommEvent - Pointer to the overlapped structure to use. 
//    lpfdwEvtMask          - Pointer to DWORD to received Event data. 
//     fRetrieveEvent       - Flag to signal if the event needs to be 
//                            retrieved, or has already been retrieved. 
// 
//  RETURN VALUE: 
//    TRUE if able to handle a Comm Event. 
//    FALSE if unable to setup WaitCommEvent, unable to handle 
//    an existing outstanding event or if the CloseEvent has been signaled. 
// 
//  COMMENTS: 
// 
//    This function is a helper function for the Read Thread that (if 
//    fRetrieveEvent == TRUE) retrieves an outstanding CommEvent and 
//    deals with it.  The only event that should occur is an EV_ERR event, 
//    signalling that there has been an error on the comm port. 
// 
//    Normally, comm errors would not be put into the normal data stream 
//    as this sample is demonstrating.  Putting it in a status bar would 
//    be more appropriate for a real application. 
// 
// 
function TReadThread.HandleCommEvent( lpOverlappedCommEvent: POverlapped; 
         var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean; 
var 
   dwDummy:        DWORD; 
   dwErrors:       DWORD; 
   dwLastError:    DWORD; 
   dwModemEvent:   DWORD; 
begin 
     Result := False; 
 
     // If this fails, it could be because the file was closed (and I/O is 
     // finished) or because the overlapped I/O is still in progress.  In 
     // either case (or any others) its a bug and return FALSE. 
     if fRetrieveEvent then 
     begin 
          if not GetOverlappedResult( hCommFile, 
                                      lpOverlappedCommEvent^, dwDummy, False ) then 
          begin 
               dwLastError := GetLastError; 
 
               // Its possible for this error to occur if the 
               // service provider has closed the port.  Time to end. 
               if dwLastError = ERROR_INVALID_HANDLE then 
                  Exit; 
 
               PostHangupCall; 
               Exit 
          end 
     end; 
 
     // Was the event an error? 
     if (lpfdwEvtMask and EV_ERR) <> 0 then 
     begin 
          // Which error was it? 
          if not ClearCommError( hCommFile, dwErrors, nil ) then 
          begin 
               dwLastError := GetLastError; 
 
               // Its possible for this error to occur if the 
               // service provider has closed the port.  Time to end. 
               if dwLastError = ERROR_INVALID_HANDLE then 
                  Exit; 
 
               PostHangupCall; 
               Exit 
          end; 
 
          // Its possible that multiple errors occured and were handled 
          // in the last ClearCommError.  Because all errors were signaled 
          // individually, but cleared all at once, pending comm events 
          // can yield EV_ERR while dwErrors equals 0.  Ignore this event. 
 
          if not ReceiveError( dwErrors ) then 
             Exit; 
 
          Result := True 
     end; 
 
     dwModemEvent := 0; 
 
     if ((lpfdwEvtMask and EV_RLSD) <> 0) then 
        dwModemEvent := ME_RLSD; 
     if ((lpfdwEvtMask and EV_RING) <> 0) then 
        dwModemEvent := dwModemEvent or ME_RING; 
 
     if dwModemEvent <> 0 then 
     begin 
          if not ModemStateChange( dwModemEvent ) then 
          begin 
               Result := False; 
               Exit 
          end; 
 
          Result := True 
     end; 
 
     if ((lpfdwEvtMask and EV_ERR)=0) and (dwModemEvent=0) then 
     begin 
          // Should not have gotten here. 
          PostHangupCall 
     end 
end; {TReadThread.HandleCommEvent} 
 
function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL; 
begin 
     Result := False; 
 
     if not PostMessage( hComm32Window, PWM_GOTCOMMDATA, 
                         WPARAM(dwSizeofNewString), LPARAM(lpNewString) ) then 
        PostHangupCall 
     else 
         Result := True 
end; 
 
function TReadThread.ReceiveError( EvtMask : DWORD ): BOOL; 
begin 
     Result := False; 
 
     if not PostMessage( hComm32Window, PWM_RECEIVEERROR, 0, LPARAM(EvtMask) ) then 
        PostHangupCall 
     else 
         Result := True 
end; 
 
function TReadThread.ModemStateChange( ModemEvent : DWORD ) : BOOL; 
begin 
     Result := False; 
 
     if not PostMessage( hComm32Window, PWM_MODEMSTATECHANGE, 0, LPARAM(ModemEvent) ) then 
        PostHangupCall 
     else 
         Result := True 
end; 
 
procedure TReadThread.PostHangupCall; 
begin 
     PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 ) 
end; 
 
(******************************************************************************) 
//  WRITE THREAD 
(******************************************************************************) 
 
// 
//  PROCEDURE: TWriteThread.Execute 
// 
//  PURPOSE: The starting point for the Write thread. 
// 
//  PARAMETERS: 
//    lpvParam - unused. 
// 
//  RETURN VALUE: 
//    DWORD - unused. 
// 
//  COMMENTS: 
// 
//    The Write thread uses a PeekMessage loop to wait for a string to write, 
//    and when it gets one, it writes it to the Comm port.  If the CloseEvent 
//    object is signaled, then it exits.  The use of messages to tell the 
//    Write thread what to write provides a natural desynchronization between 
//    the UI and the Write thread. 
// 
// 
procedure TWriteThread.Execute; 
var 
   msg:   TMsg; 
   dwHandleSignaled:      DWORD; 
   overlappedWrite:       TOverLapped; 
   CompleteOneWriteRequire : Boolean; 
label 
     EndWriteThread; 
begin 
     // Needed for overlapped I/O. 
     FillChar( overlappedWrite, SizeOf(overlappedWrite), 0 );  {0, 0, 0, 0, NULL} 
 
     overlappedWrite.hEvent := CreateEvent( nil, True, True, nil ); 
     if overlappedWrite.hEvent = 0 then 
     begin 
          PostHangupCall; 
          goto EndWriteThread 
     end; 
 
     CompleteOneWriteRequire := True; 
 
     // This is the main loop.  Loop until we break out. 
     while True do 
     begin 
          if not PeekMessage( msg, 0, 0, 0, PM_REMOVE ) then 
          begin 
               // If there are no messages pending, wait for a message or 
               // the CloseEvent. 
 
               pFSendDataEmpty^ := True; 
 
               if CompleteOneWriteRequire then 
               begin 
                    if not PostMessage( hComm32Window, PWM_SENDDATAEMPTY, 0, 0 ) then 
                    begin 
                         PostHangupCall; 
                         goto EndWriteThread 
                    end 
               end; 
 
               CompleteOneWriteRequire := False; 
 
               dwHandleSignaled := MsgWaitForMultipleObjects(1, hCloseEvent, False, 
                                   INFINITE, QS_ALLINPUT); 
 
               case dwHandleSignaled of 
               WAIT_OBJECT_0:     // CloseEvent signaled! 
               begin 
                    // Time to exit. 
                    goto EndWriteThread 
               end; 
 
               WAIT_OBJECT_0 + 1: // New message was received. 
               begin 
                    // Get the message that woke us up by looping again. 
                    Continue 
               end; 
 
               WAIT_FAILED:       // Wait failed.  Shouldn't happen. 
               begin 
                    PostHangupCall; 
                    goto EndWriteThread 
               end 
                
               else                // This case should never occur. 
               begin 
                    PostHangupCall; 
                    goto EndWriteThread 
               end 
               end 
          end; 
 
          // Make sure the CloseEvent isn't signaled while retrieving messages. 
          if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then 
             goto EndWriteThread; 
 
          // Process the message. 
          // This could happen if a dialog is created on this thread. 
          // This doesn't occur in this sample, but might if modified. 
          if msg.hwnd <> 0{NULL} then 
          begin 
               TranslateMessage(msg); 
               DispatchMessage(msg); 
               Continue 
          end; 
 
          // Handle the message. 
          case msg.message of 
          PWM_COMMWRITE:  // New string to write to Comm port. 
          begin 
               // Write the string to the comm port.  HandleWriteData 
               // does not return until the whole string has been written, 
               // an error occurs or until the CloseEvent is signaled. 
               if not HandleWriteData( @overlappedWrite, 
                                       PChar(msg.lParam), DWORD(msg.wParam) ) then 
               begin 
                    // If it failed, either we got a signal to end or there 
                    // really was a failure. 
 
                    LocalFree( HLOCAL(msg.lParam) ); 
                    goto EndWriteThread 
               end; 
 
               CompleteOneWriteRequire := True; 
               // Data was sent in a LocalAlloc()d buffer.  Must free it. 
               LocalFree( HLOCAL(msg.lParam) ) 
          end 
          end 
     end; {main loop} 
 
     // Thats the end.  Now clean up. 
EndWriteThread: 
 
     PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR); 
     pFSendDataEmpty^ := True; 
     CloseHandle(overlappedWrite.hEvent) 
end; {TWriteThread.Execute} 
 
 
// 
//  FUNCTION: HandleWriteData(LPOVERLAPPED, LPCSTR, DWORD) 
// 
//  PURPOSE: Writes a given string to the comm file handle. 
// 
//  PARAMETERS: 
//    lpOverlappedWrite  - Overlapped structure to use in WriteFile 
//    pDataToWrite       - String to write. 
//    dwNumberOfBytesToWrite - Length of String to write. 
// 
//  RETURN VALUE: 
//    TRUE if all bytes were written.  False if there was a failure to 
//    write the whole string. 
// 
//  COMMENTS: 
// 
//    This function is a helper function for the Write Thread.  It 
//    is this call that actually writes a string to the comm file. 
//    Note that this call blocks and waits for the Write to complete 
//    or for the CloseEvent object to signal that the thread should end. 
//    Another possible reason for returning FALSE is if the comm port 
//    is closed by the service provider. 
// 
// 
function TWriteThread.HandleWriteData( lpOverlappedWrite: POverlapped; 
         pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean; 
var 
   dwLastError, 
 
   dwNumberOfBytesWritten, 
   dwWhereToStartWriting, 
 
   dwHandleSignaled:       DWORD; 
   HandlesToWaitFor: array[0..1] of THandle; 
begin 
     Result := False; 
 
     dwNumberOfBytesWritten := 0; 
     dwWhereToStartWriting := 0; // Start at the beginning. 
 
     HandlesToWaitFor[0] := hCloseEvent; 
     HandlesToWaitFor[1] := lpOverlappedWrite^.hEvent; 
 
     // Keep looping until all characters have been written. 
     repeat 
           // Start the overlapped I/O. 
           if not WriteFile( hCommFile, 
                             pDataToWrite[ dwWhereToStartWriting ], 
                             dwNumberOfBytesToWrite, dwNumberOfBytesWritten, 
                             lpOverlappedWrite ) then 
           begin 
                // WriteFile failed.  Expected; lets handle it. 
                dwLastError := GetLastError; 
 
                // Its possible for this error to occur if the 
                // service provider has closed the port.  Time to end. 
                if dwLastError = ERROR_INVALID_HANDLE then 
                   Exit; 
 
                // Unexpected error.  No idea what. 
                if dwLastError <> ERROR_IO_PENDING then 
                begin 
                     PostHangupCall; 
                     Exit 
                end; 
 
                // This is the expected ERROR_IO_PENDING case. 
 
                // Wait for either overlapped I/O completion, 
                // or for the CloseEvent to get signaled. 
                dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor, 
                                    False, INFINITE); 
 
                case dwHandleSignaled of 
                WAIT_OBJECT_0:     // CloseEvent signaled! 
                begin 
                     // Time to exit. 
                     Exit 
                end; 
 
                WAIT_OBJECT_0 + 1: // Wait finished. 
                begin 
                     // Time to get the results of the WriteFile 
                     if not GetOverlappedResult(hCommFile, 
                                           lpOverlappedWrite^, 
                                           dwNumberOfBytesWritten, True) then 
                     begin 
                          dwLastError := GetLastError; 
 
                          // Its possible for this error to occur if the 
                          // service provider has closed the port. 
                          if dwLastError = ERROR_INVALID_HANDLE then 
                             Exit; 
 
                          // No idea what could cause another error. 
                          PostHangupCall; 
                          Exit 
                     end 
                end; 
 
                WAIT_FAILED: // Wait failed.  Shouldn't happen. 
                begin 
                     PostHangupCall; 
                     Exit 
                end 
 
                else // This case should never occur. 
                begin 
                     PostHangupCall; 
                     Exit 
                end 
                end {case} 
           end; {WriteFile failure} 
 
           // Some data was written.  Make sure it all got written. 
 
           Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten ); 
           Inc( dwWhereToStartWriting, dwNumberOfBytesWritten ) 
     until (dwNumberOfBytesToWrite <= 0);  // Write the whole thing! 
 
     // Wrote the whole string. 
     Result := True 
end; {TWriteThread.HandleWriteData} 
 
procedure TWriteThread.PostHangupCall; 
begin 
     PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 ) 
end; 
 
procedure Register; 
begin 
     RegisterComponents('Custom', [TComm]) 
end; 
 
end.