unit Comm32;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Misc;

const
 PWM_GOTCOMMDATA = WM_USER + 1;
 PWM_REQUESTHANGUP = WM_USER + 2;

type
 ECommsError = class( Exception );

 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;
   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;
    function WriteComm( pDataToWrite: LPCSTR; dwSizeofDataToWrite: DWORD ): Boolean;
    procedure PostHangupCall;
   end;

   TReceiveDataEvent = procedure(Sender:TObject; Buffer: Pointer; BufferLength: Word ) of object;

   TComm32 = class( TComponent )
    private
    { Private declarations }
     ReadThread:      TReadThread;
     WriteThread:     TWriteThread;
     FCommsLogFileName,
     FCommPort:	       string;
     hCloseEvent:      THandle;
     FOnReceiveData:   TReceiveDataEvent;
     FOnRequestHangup: TNotifyEvent;
     FHWnd:	       THandle;
     FBaudRate:	       DWORD;
     FBits:	       DWORD;
     FStopBits:	       DWORD;
     FReadInterval:Integer;
     procedure SetCommsLogFileName( LogFileName: string );
     function GetReceiveDataEvent: TReceiveDataEvent;
     procedure SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
     function GetRequestHangupEvent: TNotifyEvent;
     procedure SetRequestHangupEvent( ARequestHangupEvent: TNotifyEvent );
     procedure CommWndProc( var msg: TMessage );
    protected
     { Protected declarations }
     procedure CloseReadThread;
     procedure CloseWriteThread;
     procedure ReceiveData( Buffer: PChar; BufferLength: Word );
     procedure RequestHangup;
    public
     { Public declarations }
     hCommFile: THandle;
     constructor Create( AOwner: TComponent ); override;
     destructor Destroy; override;
     function StartComm: Boolean;
     procedure StopComm;
     function WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
    published
     { Published declarations }
     property BaudRate: DWORD read FBaudRate write FBaudRate;
     property Bits: DWORD read FBits write FBits;
     property StopBits: DWORD read FStopBits write FStopBits;
     property CommPort: string read FCommPort write FCommPort;
     property CommsLogFileName: string read FCommsLogFileName write SetCommsLogFileName;
     property OnReceiveData: TReceiveDataEvent read GetReceiveDataEvent write SetReceiveDataEvent;
     property OnRequestHangup: TNotifyEvent read GetRequestHangupEvent write SetRequestHangupEvent;
     property ReadInterval: Integer read FReadInterval write FReadInterval default 20;
    end;

const
	PWM_COMMWRITE = WM_USER+1;
	INPUTBUFFERSIZE = 2048;

var
	CommsLogFile:	Text;

procedure LogDebugInfo( outstr: PChar );
procedure LogDebugLastError( dwLastError: DWORD; szPrefix: LPSTR );
procedure Register;

implementation

var
 CommsLogName: string; 

constructor TComm32.Create( AOwner: TComponent );
begin
 inherited Create( AOwner );
 FCommPort := 'COM2';
 FCommsLogFileName := '';
 CommsLogName := '';
 ReadThread := nil;
 WriteThread := nil;
 hCommFile := 0;
 if not (csDesigning in ComponentState) then
 	FHWnd := AllocateHWnd(CommWndProc);
 FReadInterval:=25;
end;

destructor TComm32.Destroy;
begin
	if not (csDesigning in ComponentState) then
	begin
		DeallocateHWnd(FHwnd);
	end;
	inherited Destroy;
end;

function TComm32.StartComm: Boolean;
var
	commtimeouts:	TCommTimeouts;
	dcb:				Tdcb;
	commprop:		TCommProp;
	fdwEvtMask:		DWORD;
	hNewCommFile: THandle;
begin
 if (hCommFile <> 0) then
  raise ECommsError.Create( 'Порт уже открыт' );

 if CommsLogFileName <> '' then
  begin
   AssignFile( CommsLogFile, fCommsLogFileName );
   Rewrite( CommsLogFile );
  end;

 hNewCommFile := CreateFile(PChar(fCommPort),GENERIC_READ+GENERIC_WRITE,0,nil,OPEN_EXISTING,
		{FILE_ATTRIBUTE_NORMAL+}FILE_FLAG_OVERLAPPED,0 );
 if hNewCommFile = INVALID_HANDLE_VALUE then
	raise ECommsError.Create( 'Ошибка открытия порта' );

 if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then
 	raise ECommsError.Create( 'Неверный указатель. ' );

 hCommFile := hNewCommFile;

 GetCommState( hNewCommFile, dcb );
 GetCommProperties( hNewCommFile, commprop );
 GetCommMask( hCommFile, fdwEvtMask );
 GetCommTimeouts( hCommFile, commtimeouts );

 commtimeouts.ReadIntervalTimeout         := FReadInterval;
 commtimeouts.ReadTotalTimeoutMultiplier  := 0;
 commtimeouts.ReadTotalTimeoutConstant    := 0;
 commtimeouts.WriteTotalTimeoutMultiplier := 0;
 commtimeouts.WriteTotalTimeoutConstant   := 0;

 SetCommTimeouts( hCommFile, commtimeouts );

 dcb.BaudRate := FBaudRate;
 dcb.StopBits:=ONESTOPBIT;
 dcb.ByteSize:=FBits;
 SetCommState( hNewCommFile, dcb );

 GetCommState( hNewCommFile, dcb );
 dcb.ByteSize:=8;

 hCloseEvent := CreateEvent( nil, True, False, nil );

 if hCloseEvent = 0 then
  begin
   LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
   hCommFile := 0;
   Result := False;
   Exit
  end;

 try
  ReadThread := TReadThread.Create( True {suspended} );
 except
  LogDebugLastError( GetLastError, 'Unable to create Read thread' );
  raise ECommsError.Create( 'Unable to create Read thread' );
 end;

 ReadThread.hCommFile := hCommFile;
 ReadThread.hCloseEvent := hCloseEvent;
 ReadThread.hComm32Window := FHWnd;
 ReadThread.Resume;

 ReadThread.Priority := tpHighest;

 try
  WriteThread := TWriteThread.Create( True {suspended} );
 except
  LogDebugLastError( GetLastError, 'Unable to create Write thread' );
  raise ECommsError.Create( 'Unable to create Write thread' );
 end;
 WriteThread.hCommFile := hCommFile;
 WriteThread.hCloseEvent := hCloseEvent;
 WriteThread.hComm32Window := FHWnd;
 WriteThread.Resume;

 ReadThread.Priority := tpHigher;

 Result := True;
end;

procedure TComm32.StopComm;
begin
	if hCommFile = 0 then
		Exit;

	LogDebugInfo( 'Stopping the Comm' );

	CloseReadThread;
	CloseWriteThread;

	CloseHandle( hCloseEvent );

	CloseHandle( hCommFile );
	hCommFile := 0;
	if fCommsLogFileName <> '' then
		CloseFile( CommsLogFile );
end;

function TComm32.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
	Buffer:	Pointer;
begin
	if WriteThread <> nil then
	begin
		Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
		Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
		if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
					 WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
		begin
			Result := true;
			Exit;
		end
		else
			LogDebugInfo( 'Failed to Post to Write thread. ' );
	end
	else
		LogDebugInfo( 'Write thread not created' );

	Result := False;
end; {TComm32.WriteCommData}

procedure TComm32.CloseReadThread;
begin
	// If it exists...
	if ReadThread <> nil then
	begin
		LogDebugInfo( 'Closing Read Thread ');

		// 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, 5000) = WAIT_TIMEOUT) then
		begin
			LogDebugInfo( 'Read thread not exiting.  Terminating it.' );
			ReadThread.Terminate;
		end;
		ReadThread.Free;
		ReadThread := nil;
	end;
end; {TComm32.CloseReadThread}


procedure TComm32.CloseWriteThread;
begin
	// If it exists...
	if WriteThread <> nil then
	begin
		LogDebugInfo( 'Closing Write Thread' );

		// Signal the event to close the worker threads.
		SetEvent(hCloseEvent);

		// Purge all outstanding writes.
		PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);

		// Wait 10 seconds for it to exit.  Shouldn't happen.
		if WaitForSingleObject( WriteThread.Handle, 5000 ) = WAIT_TIMEOUT then
		begin
			LogDebugInfo( 'Write thread not exiting.  Terminating it.' );
			WriteThread.Terminate;
		end;
		WriteThread.Free;
		WriteThread := nil;
	end;
end; {TComm32.CloseWriteThread}

procedure TComm32.ReceiveData( Buffer: PChar; BufferLength: Word );
var
 Str:String;
begin
 Str:=Buffer;
 if copy(Str,1,10)='Comm Event' then exit;
	if Assigned(FOnReceiveData) then
		FOnReceiveData(self, Buffer, BufferLength );
end;

procedure TComm32.RequestHangup;
begin
	if Assigned(FOnRequestHangup) then
		FOnRequestHangup( Self );
end;

(******************************************************************************)
//									TCOMM32 PRIVATE METHODS
(******************************************************************************)

procedure TComm32.SetCommsLogFileName( LogFileName: string );
begin
	CommsLogName := LogFileName;
	FCommsLogFileName := LogFileName;
end;

procedure TComm32.CommWndProc( var msg: TMessage );
begin
	case msg.msg of
		PWM_GOTCOMMDATA:
		begin
			ReceiveData( PChar(msg.LParam), msg.WParam );
			LocalFree( msg.LParam );
		end;
		PWM_REQUESTHANGUP:
			RequestHangup;
	end;
end;

function TComm32.GetReceiveDataEvent: TReceiveDataEvent;
begin
	Result := FOnReceiveData;
end;

procedure TComm32.SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
begin
	FOnReceiveData := AReceiveDataEvent;
end;

function TComm32.GetRequestHangupEvent: TNotifyEvent;
begin
	Result := FOnRequestHangup;
end;

procedure TComm32.SetRequestHangupEvent( ARequestHangupEvent: TNotifyEvent );
begin
	FOnRequestHangup := ARequestHangupEvent;
end;


procedure TReadThread.Execute;
var
	 szInputBuffer:	array[0..INPUTBUFFERSIZE-1] of Char;
	 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
		 LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
		 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
		 LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
		 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) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetCommMask: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// Start waiting for CommEvents (Errors)
	if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetupCommEvent1: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// Start waiting for Read events.
	if not SetupReadEvent( @overlappedRead,
					szInputBuffer, INPUTBUFFERSIZE,
					 nNumberOfBytesRead ) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetupReadEvent: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// 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);

                if dwHandleSignaled=WAIT_TIMEOUT then
                 begin
                  PostHangupCall;
                 end; 

		 // Which event occured?
		case dwHandleSignaled of
			WAIT_OBJECT_0:     // Signal to end the thread.
			begin
				// Time to exit.
				OutputDebugString( 'Time to Exit' );
				goto EndReadThread;
			end;

			WAIT_OBJECT_0 + 1: // CommEvent signaled.
			begin
				// Handle the CommEvent.
				if not HandleCommEvent( @overlappedCommEvent,  fdwEvtMask, TRUE ) then
				begin
					PostHangupCall;
					LogDebugLastError( GetLastError, 'Unable HandleCommEvent: ' );
					goto EndReadThread;
				end;

				// Start waiting for the next CommEvent.
				if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
				begin
					PostHangupCall;
					LogDebugLastError( GetLastError, 'Unable to SetupCommEvent2: ' );
					goto EndReadThread;
				end;
				{break;??}
			end;

			WAIT_OBJECT_0 + 2: // Read Event signaled.
			begin
				// Get the new data!
				if not HandleReadEvent( @overlappedRead,
									szInputBuffer, INPUTBUFFERSIZE,
									 nNumberOfBytesRead ) then
				begin
					PostHangupCall;
					LogDebugLastError( GetLastError, 'Unable to HandleReadEvent: ' );
					goto EndReadThread;
				end;

				// Wait for more new data.
				if not SetupReadEvent( @overlappedRead,
									szInputBuffer, INPUTBUFFERSIZE,
									 nNumberOfBytesRead ) then
				begin
					PostHangupCall;
					goto EndReadThread;
				end;
				{break;}
			end;

			WAIT_FAILED:       // Wait failed.  Shouldn't happen.
			begin
				LogDebugLastError( GetLastError, 'Read WAIT_FAILED: ' );
				PostHangupCall;
				goto EndReadThread;
			end;

			else    // This case should never occur.
			begin
				LogDebugInfo( PChar('Unexpected Wait return value '+
							IntToStr(dwHandleSignaled)) );
				PostHangupCall;
				goto EndReadThread;
			end;
		end; {case dwHandleSignaled}
	end; {while True}

	// Time to clean up Read Thread.
 EndReadThread:

	LogDebugInfo( 'Read thread shutting down' );
	PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR );
	CloseHandle( overlappedRead.hEvent );
	CloseHandle( overlappedCommEvent.hEvent );
end; {TReadThread.Execute}

function TReadThread.SetupReadEvent( lpOverlappedRead: POverlapped;
	 lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
	 var lpnNumberOfBytesRead: DWORD ): Boolean;
var
	 dwLastError: DWORD;
label
	StartSetupReadEvent;
begin

StartSetupReadEvent:

	Result := False;
	// Make sure the CloseEvent hasn't been signaled yet.
	// Check is needed because this function is potentially recursive.
	if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent, 10) 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.

		LogDebugInfo( 'Data waiting for ReadFile: ');

		 // 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
		 LogDebugInfo( 'Waiting for data from comm connection.' );
		 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
	begin
		 LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
			  'Likely that the Service Provider has closed the port.' );
		 Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
	LogDebugLastError( dwLastError, 'Unexpected ReadFile error: ' );

	PostHangupCall;
end; {TReadThread.SetupReadEvent}

function TReadThread.HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
var
	lpszPostedBytes: LPSTR;
	tempstr:				string;
begin
	Result := False;
	 // If we got data and didn't just time out empty...
	if dwSizeofBuffer <> 0 then
	begin
		tempstr := lpszInputBuffer;

		  // Do something with the bytes read.
		LogDebugInfo( 'Got something from Comm port!!!' );

		lpszPostedBytes := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );

		if lpszPostedBytes = nil{NULL} then
		begin
			LogDebugLastError( GetLastError, 'LocalAlloc: ' );
			Exit;
		end;

		Move( lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer );
		lpszPostedBytes[dwSizeofBuffer] := #0;

		Result := ReceiveData( lpszPostedBytes, dwSizeofBuffer );
	end;
end; {TReadThread.HandleReadData}

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
	begin
		LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
				'Likely that the Service Provider has closed the port.' );
		Exit;
	end;

	LogDebugLastError( dwLastError,
		  'Unexpected GetOverlappedResult Read Error: ' );

	PostHangupCall;
end; {TReadThread.HandleReadEvent}

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, 10 ) 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.

		LogDebugInfo( 'Event (Error) waiting before WaitCommEvent.' );

		if not HandleCommEvent( nil, lpfdwEvtMask, False ) then
		{??? GetOverlappedResult does not handle "NIL" as defined by Borland}
			Exit;

		// 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
		LogDebugInfo( 'Waiting for a CommEvent (Error) to occur.' );
		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
	begin
		LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
				'Likely that the Service Provider has closed the port.' );
		Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
	LogDebugLastError( dwLastError, 'Unexpected WaitCommEvent error: ' );
end; {TReadThread.SetupCommEvent}

function TReadThread.HandleCommEvent( lpOverlappedCommEvent: POverlapped;
	 var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
var
	dwDummy:			DWORD;
	lpszOutput:		LPSTR;
	szError:			array[0..127] of Char;
	dwErrors,
	nOutput,
	dwLastError:	DWORD;
begin
	Result := False;

	szError[0] := #0;

	lpszOutput := PChar(LocalAlloc( LPTR, 256 ));
	if lpszOutput = nil{NULL} then
	begin
		LogDebugLastError( GetLastError, 'LocalAlloc: ' );
		Exit;
	end;

	// 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
		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
			begin
				LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
						  'Likely that the Service Provider has closed the port.' );
				Exit;
			end;

			LogDebugLastError( dwLastError,
					 'Unexpected GetOverlappedResult for WaitCommEvent: ' );
			Exit;
		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
			begin
				LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
					  'Likely that the Service Provider has closed the port.' );
				Exit;
			end;

			LogDebugLastError( GetLastError,'ClearCommError: ' );
			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 dwErrors = 0 then
			strcat( szError, 'NULL Error' );

		if (dwErrors and CE_FRAME) <> 0 then
		begin
			if szError[0] <> #0 then
				strcat( szError, ' and ' );

			strcat( szError,'CE_FRAME' );
		end;

		if (dwErrors and CE_OVERRUN) <> 0 then
		begin
			if szError[0] <> #0 then
				strcat(szError, ' and ' );

			strcat( szError, 'CE_OVERRUN' );
		end;

		if (dwErrors and CE_RXPARITY) <> 0 then
		begin
			if szError[0] <> #0 then
				strcat( szError, ' and ' );

			strcat( szError, 'CE_RXPARITY' );
		end;

		if (dwErrors and not (CE_FRAME + CE_OVERRUN + CE_RXPARITY)) <> 0 then
		begin
			if szError[0] <> #0 then
				strcat( szError, ' and ' );

			strcat( szError, 'EV_ERR Unknown EvtMask' );
		end;

		nOutput := wsprintf(lpszOutput,
				PChar('Comm Event: '+szError+', EvtMask = '+IntToStr(dwErrors)) );

		ReceiveData( lpszOutput, nOutput );
		Result := True;
		Exit
	end;

	// Should not have gotten here.  Only interested in ERR conditions.

	LogDebugInfo( PChar('Unexpected comm event '+IntToStr(lpfdwEvtMask)) );
end; {TReadThread.HandleCommEvent}

function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
begin
	Result := PostMessage( hComm32Window, PWM_GOTCOMMDATA,
		  WPARAM(dwSizeofNewString), LPARAM(lpNewString) );
end;

procedure TReadThread.PostHangupCall;
begin
	PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 );
end;

procedure TWriteThread.Execute;
var
	 msg:	TMsg;
	 dwHandleSignaled:	DWORD;
	 overlappedWrite:		TOverLapped;
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
		  LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
		  PostHangupCall;
		  goto EndWriteThread;
	 end;

	 // 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.
				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
						  LogDebugLastError( GetLastError, 'Write WAIT_FAILED: ' );
						  PostHangupCall;
						  goto EndWriteThread;
					 end;

					 else                // This case should never occur.
					 begin
						  LogDebugInfo( PChar('Unexpected Wait return value '
														+IntToStr(dwHandleSignaled)) );
						  PostHangupCall;
						  goto EndWriteThread;
					 end;
				end;
		  end;

		  // Make sure the CloseEvent isn't signaled while retrieving messages.
		  if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent, 10) 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
					 LogDebugInfo( 'Writing to comm port' );

					 // 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;

					 // Data was sent in a LocalAlloc()d buffer.  Must free it.
					 LocalFree( HLOCAL(msg.lParam) );
				end;

				// What other messages could the thread get?
				else
				begin
					 LogDebugInfo( PChar('Unexpected message posted to Write thread: '+
						  IntToStr(msg.message)) );
					 {break;}
				end;
		  end; {case}
	 end; {main loop}

	 // Thats the end.  Now clean up.
  EndWriteThread:

	 LogDebugInfo( 'Write thread shutting down' );

	 PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);

	 CloseHandle(overlappedWrite.hEvent);
end; {TWriteThread.Execute}

function TWriteThread.HandleWriteData( lpOverlappedWrite: POverlapped;
	 pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
var
	dwLastError,

	dwNumberOfBytesWritten,
	dwWhereToStartWriting,

	dwHandleSignaled:	DWORD;
	HandlesToWaitFor: array[0..1] of THandle;
begin
	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
				begin
					 LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
						  'Likely that the Service Provider has closed the port.' );
					 Result := False;
					 Exit;
				end;

				// Unexpected error.  No idea what.
				if dwLastError <> ERROR_IO_PENDING then
				begin
					 LogDebugLastError( dwLastError, 'Error to writing to CommFile' );

					 LogDebugInfo( 'Closing TAPI' );
					 PostHangupCall;
					 Result := False;
					 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, 5000);

				case dwHandleSignaled of
					 WAIT_OBJECT_0:     // CloseEvent signaled!
					 begin
						  // Time to exit.
						  Result := False;
						  Exit;
					 end;

					 WAIT_OBJECT_0 + 1: // Wait finished.
					 begin
						  // Time to get the results of the WriteFile
					 end;

					 WAIT_FAILED: // Wait failed.  Shouldn't happen.
					 begin
						  LogDebugLastError( GetLastError, 'Write WAIT_FAILED: ' );
						  PostHangupCall;
						  Result := False;
						  Exit
					 end;

					 else // This case should never occur.
					 begin
						  LogDebugInfo( PChar('Unexpected Wait return value '+
													IntToStr(dwHandleSignaled)) );
						  PostHangupCall;
						  Result := False;
						  Exit
					 end;
				end; {case}

				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
					 begin
						  LogDebugInfo('ERROR_INVALID_HANDLE, '+
								'Likely that the Service Provider has closed the port.');
						  Result := False;
						  Exit;
					 end;

					 // No idea what could cause another error.
					 LogDebugLastError( dwLastError, 'Error writing to CommFile while waiting');
					 LogDebugInfo('Closing TAPI');
					 PostHangupCall;
					 Result := False;
					 Exit;
				end;
		  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}

function TWriteThread.WriteComm( pDataToWrite: LPCSTR; dwSizeofDataToWrite: DWORD ): Boolean;
begin
	Result := PostThreadMessage( ThreadID, PWM_COMMWRITE,
					 WParam(dwSizeofDataToWrite), LParam(pDataToWrite) );
end;

procedure TWriteThread.PostHangupCall;
begin
	PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 );
end;

procedure LogDebugLastError( dwLastError: DWORD; szPrefix: LPSTR );
var
	szLastError: LPSTR;
	szOutputLastError: array[0..MAXOUTPUTSTRINGLENGTH-1] of Char;
begin
	if szPrefix = nil then
		szPrefix := '';

	// Pretty print the error.
	szLastError := FormatLastError(dwLastError, nil, 0);

	// The only reason FormatLastError should fail is "Out of memory".
	if szLastError = nil then
	begin
		wsprintf( szOutputLastError, PChar(szPrefix+'Out of memory') );

		LogDebugInfo( szOutputLastError );

		Exit;
	end;

	wsprintf( szOutputLastError,
			  PChar(szPrefix+'GetLastError returned: "'+szLastError+'"') );

	// Pointer returned from FormatLineError *must* be freed!
	LocalFree( HLOCAL(szLastError) );

	// Print it!
	LogDebugInfo( szOutputLastError );
end; {LogDebugLastError}

procedure LogDebugInfo( outstr: PChar );
begin
	if CommsLogName <> '' then
		Writeln( CommsLogFile, outstr );
end; {LogDebugInfo}

procedure Register;
begin
  RegisterComponents('CyD', [TComm32]);
end;

end.