unit Comm32;
interface

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

const
	PWM_GOTCOMMDATA = WM_USER + 1;
	PWM_REQUESTHANGUP = WM_USER + 2;
	PWM_THREADREADY = WM_USER +3;
        PWM_COMMEVENT = WM_USER + 4;
type
	ECommsError = class( Exception );

        TFlowControl=(fcNone,fcHardware,fcSoftware);
	TParity = (pNone,pOdd,pEven,pMark,pSpace);
	TStopBits = (sb1_0,sb1_5,sb2_0);
	TBytesize = (sz_4,sz_5,sz_6,sz_7,sz_8);
	TReadThread = class( TThread )
	protected
		procedure Execute; override;
	public
		hCommFile:		THandle;
		hCloseEvent:		THandle;
		hComm32Window:		THandle;
               	dwErrors:               DWORD;
		function SetupCommEvent( lpOverlappedCommEvent: POverlapped;
						var dwEventMask: DWORD ): Boolean;
		function SetupReadEvent( lpOverlappedRead: POverlapped;
						szInputBuffer: PChar; dwSizeofBuffer: DWORD;
						var NumberOfBytesRead: DWORD ): Boolean;
		function HandleCommEvent( lpOverlappedCommEvent: POverlapped;
						var dwEventMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
		function HandleReadEvent( lpOverlappedRead: POverlapped;
						szInputBuffer: PChar; dwSizeofBuffer: DWORD;
						var NumberOfBytesRead: DWORD ): Boolean;
		function HandleReadData( szInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
		function ReceiveData( lpNewString: PChar; 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( Buffer: Pointer; BufferLength: Word ) of object;
        TErrorEvent=procedure (ErrorCode:DWORD)of object;
	TComm32 = class( TComponent )
	private
		{ Private declarations }
		ReadThread:				TReadThread;
		WriteThread:			TWriteThread;
//		ThreadError,
		WriteCreated,
		ReadCreated:			Boolean;
		FCommPort:				string;
		hCommFile: 				THandle;
		hCloseEvent:			THandle;
		FOnReceiveData: 		TReceiveDataEvent;
		FOnRequestHangup:		TNotifyEvent;
		FHWnd:				THandle;

                fEvent:                         TNotifyEvent;
                fErrorEvent:                         TErrorEvent;
                fBreak:                         TNotifyEvent;
                fChCTS:                         TNotifyEvent;
                fChDSR:                         TNotifyEvent;
                fPERR:                          TNotifyEvent;
                fChRing:                        TNotifyEvent;
                fChRLSD:                        TNotifyEvent;
                fRX80FULL:                      TNotifyEvent;
                fTXEMPTY:                       TNotifyEvent;
                fSetCTS:                        TNotifyEvent;
                fSetDSR:                        TNotifyEvent;
                fSetRING:                       TNotifyEvent;
                fSetRLSD:                       TNotifyEvent;
                fClearCTS:                      TNotifyEvent;
                fClearDSR:                      TNotifyEvent;
                fClearRING:                     TNotifyEvent;
                fClearRLSD:                     TNotifyEvent;
                fEVENTCHAR:                     TNotifyEvent;
                fdummy:DWORD;
                fActive:boolean;
                fInQueue,fOutQueue:DWORD;
                ConfigDCB:TDCB; //DCB
                fLineStatus:DWORD;                
                fModemLineStatus:DWORD;
                function FGetModemLineStatus:DWORD;
		function GetReceiveDataEvent: TReceiveDataEvent;
		procedure SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
		function GetRequestHangupEvent: TNotifyEvent;
		procedure SetRequestHangupEvent( ARequestHangupEvent: TNotifyEvent );
		procedure CommWndProc( var msg: TMessage );
                procedure fOUTSIGNAL(St:DWORD);
                function FGetBaudRate:DWORD;
                procedure FPutBaudRate(BR:DWORD);
                function FGetByteSize:TByteSize;
                procedure FPutByteSize(Bs:TByteSize);
                function FGetParity:TParity;
                procedure FPutParity(Parity:TParity);
                function FGetStopBits:TStopBits;
                procedure FPutStopBits(Sb:TStopBits);
                function FGetFlowControl:TFlowControl;
                procedure FPutFlowControl(FC:TFlowControl);
                procedure fPutInQueue(Sz:DWORD);
                procedure fPutOutQueue(Sz:DWORD);
                procedure fPutEventChar(EC:Char);
                function fGetEventChar:Char;
	protected
		{ Protected declarations }
		procedure CloseReadThread;
		procedure CloseWriteThread;
		procedure ReceiveData( Buffer: PChar; BufferLength: Word );
		procedure RequestHangup;

	public
		{ Public declarations }
                property LineStatus:DWORD read fLineStatus;
                property ModemLineStatus:DWORD read FGetModemLineStatus;
                property Active:Boolean read fActive;
                property OutSignal:DWORD read fdummy write fOUTSIGNAL;
{Example: Comm321.OutSignal:=CLRDTR;
CLRDTR	Clears the DTR (data-terminal-ready) signal.
CLRRTS	Clears the RTS (request-to-send) signal.
SETDTR	Sends the DTR (data-terminal-ready) signal.
SETRTS	Sends the RTS (request-to-send) signal.
SETXOFF	Causes transmission to act as if an XOFF character has been received.
SETXON	Causes transmission to act as if an XON character has been received.
SETBREAK	Suspends character transmission and places the transmission line in a break state until the ClearCommBreak function is called (or EscapeCommFunction is called with the CLRBREAK extended function code). The SETBREAK extended function code is identical to the SetCommBreak function. Note that this extended function does not flush data that has not been transmitted.
CLRBREAK
}
                constructor Create( AOwner: TComponent ); override;
		destructor Destroy; override;
		function StartComm: Boolean;
		procedure StopComm;
		function WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
                procedure SetBreak;
                procedure ClearBreak;
                procedure SetConfig(NewConfig:TCommConfig);
                function  GetConfig:TCommConfig;
                procedure ClearTxBuffer;
                procedure ClearRxBuffer;
	published
		{ Published declarations }
		property BaudRate: DWORD read FGetBaudRate write FPutBaudRate default 9600;
		property ByteSize: TByteSize read FGetByteSize write FPutByteSize default sz_8;
		property Parity: TParity read FGetParity write FPutParity default pNone;
		property StopBits: TStopBits read FGetStopBits write FPutStopBits default sb1_0;
		property CommPort: string read FCommPort write FCommPort;
                property FlowControl:TFlowControl read fGETFLOWCONTROL write fPUTFLOWCONTROL;
                property RxQueue:DWORD read fInQueue write fPutInQueue default 4096;
                property TxQueue:DWORD read fOutQueue write fPutOutQueue default 4096;
                property EventChar:Char read fGetEventChar write fPutEventChar;
		property OnReceiveData: TReceiveDataEvent read GetReceiveDataEvent write SetReceiveDataEvent;
                property OnCommEvent:TNotifyEvent read fEvent write fEvent;
                property OnBreak:TNotifyEvent read fBreak write fBreak;
                property OnChangeCTS:TNotifyEvent read fChCTS write fChCTS;
                property OnChangeDSR:TNotifyEvent read fChDSR write fChDSR;
                property OnPERR:TNotifyEvent read fPERR write fPERR;
                property OnChangeRing:TNotifyEvent read fChRing write fChRing;
                property OnChangeRLSD:TNotifyEvent read fChRLSD write fChRLSD;
                property OnRX80FULL:TNotifyEvent read fRX80FULL write fRX80FULL;
                property OnTXEMPTY:TNotifyEvent read fTXEMPTY write fTXEMPTY;
                property OnSetCTS:TNotifyEvent read fSetCTS write fSetCTS;
                property OnSetDSR:TNotifyEvent read fSetDSR write fSetDSR;
                property OnSetRing:TNotifyEvent read fSetRING write fSetRING;
                property OnSetRLSD:TNotifyEvent read fSetRLSD write fSetRLSD;

                property OnClearCTS:TNotifyEvent read fClearCTS write fClearCTS;
                property OnClearDSR:TNotifyEvent read fClearDSR write fClearDSR;
                property OnClearRing:TNotifyEvent read fClearRING write fClearRING;
                property OnClearRLSD:TNotifyEvent read fClearRLSD write fClearRLSD;
                property OnError:TErrorEvent read fErrorEvent write fErrorEvent;
                property OnEventChar:TNotifyEvent read fEventChar write fEventChar;
   	        property OnRequestHangup: TNotifyEvent
				read GetRequestHangupEvent write SetRequestHangupEvent;
	end;

const
	PWM_COMMWRITE = WM_USER+1;

	INPUTBUFFERSIZE = 32768;

//	MAXOUTPUTSTRINGLENGTH = 4096;



procedure Register;

implementation
function TComm32.FGetModemLineStatus:DWORD;
begin
if Active then begin
 GetCommModemStatus(hCommFile,fModemLineStatus);
end;
Result:=fModemLineStatus;
end;
procedure TComm32.fPutEventChar(EC:Char);
begin
 ConfigDCB.EvtChar:=EC;
 if Active then
  SetCommState(hCommFile,ConfigDCB);
end;

function  TComm32.fGetEventChar;
begin
 Result:=ConfigDCB.EvtChar;
end;

procedure TComm32.ClearTxBuffer;
begin
 if Active then
  PurgeComm(hCommFile,PURGE_TXCLEAR);
end;
procedure TComm32.ClearRxBuffer;
begin
 if Active then
  PurgeComm(hCommFile,PURGE_RXCLEAR);
end;
procedure TComm32.fPutInQueue(Sz:DWORD);
begin
 fInQueue:=Sz;
 if Active then
  SetUpComm(hCommFile,fInQueue,fOutQueue)
end;

procedure TComm32.fPutOutQueue(Sz:DWORD);
begin
 fInQueue:=Sz;
 if Active then
  SetUpComm(hCommFile,fInQueue,fOutQueue)
end;

function  TComm32.FGetStopBits:TStopBits;
begin
 Result:=TStopBits(configDCB.StopBits);
end;

procedure TComm32.FPutStopBits(Sb:TStopBits);
begin
 ConfigDCB.StopBits:=ORD(StopBits);
 if hCommFile<>0 then
  SetCommState(hCommFile,ConfigDCB);
end;

function  TComm32.FGetParity:TParity;
begin
 Result:=TParity(configDCB.Parity);
end;

procedure TComm32.FPutParity(Parity:TParity);
begin
 ConfigDCB.Parity:=Ord(Parity);
 if hCommFile<>0 then
  SetCommState(hCommFile,ConfigDCB);
end;

function  TComm32.FGetByteSize:TByteSize;
begin
 Result:=TByteSize(configDCB.ByteSize-4);
end;

procedure TComm32.FPutByteSize(Bs:TByteSize);
begin
 ConfigDCB.ByteSize:=Ord(Bs)+4;
 if hCommFile<>0 then
  SetCommState(hCommFile,ConfigDCB);
end;

function  TComm32.FGetBaudRate:DWORD;
begin
 Result:=ConfigDCB.BaudRate;
end;

procedure TComm32.FPutBaudRate(BR:DWORD);
begin
 ConfigDCB.BaudRate:=BR;
 if hCommFile<>0 then
  SetCommState(hCommFile,ConfigDCB);
end;

procedure TComm32.SetConfig(NewConfig:TCommConfig);
begin
  ConfigDCB:=NewConfig.dcb;
  if Active then
   SetCommState(hCommFile,ConfigDCB);
end;

function  TComm32.GetConfig:TCommConfig;
var CC:TCommConfig;
begin
 FillChar(CC,SizeOf(CC),0);
 CC.dwSize:=SizeOf(CC);
 CC.wVersion:=256;
 CC.dcb:= ConfigDCB;
 CC.dwProviderSubType:=1;
 CC.dwProviderOffset:=0;
 CC.dwProviderSize:=0;
 Result:=CC;
end;
constructor TComm32.Create( AOwner: TComponent );
begin
	inherited Create( AOwner );
	FCommPort := 'COM2';
        ConfigDCB.DCBlength:=SizeOf(TDCB);
        ConfigDCB.BaudRate:=9600;
        ConfigDCB.Flags:=1;
        ConfigDCB.ByteSize:=8;
        ConfigDCB.Parity:=0;
        ConfigDCB.StopBits:=0;
	ReadThread := nil;
	WriteThread := nil;
	hCommFile := 0;
        fOutQueue:=4096;
        fInQueue:=4096;
	if not (csDesigning in ComponentState) then
		FHWnd := AllocateHWnd(CommWndProc);
end;

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

procedure TComm32.SetBreak;
begin
if active then
 SetCommBreak(hCommFile);
end;

procedure TComm32.ClearBreak;
begin
if active then
 ClearCommBreak(hCommFile);
end;

function  TComm32.FGetFlowControl:TFlowControl;
begin
 if (ConfigDCB.Flags and 8196)=8196 then
  Result:=fcHardware
 else
  if (ConfigDCB.Flags and 768)=768 then
   Result:=fcSoftware
  else
   Result:=fcNone; 
end;
procedure TComm32.fPUTFLOWCONTROL(FC:TFlowControl);
begin
case FC of
       fcNone:begin
               ConfigDCB.Flags:=ConfigDCB.Flags and not DWORD(768);
               ConfigDCB.Flags:=ConfigDCB.Flags and not DWORD(8196);
              end;
   fcHardware:begin
               ConfigDCB.Flags:=ConfigDCB.Flags and not DWORD(768);
               ConfigDCB.Flags:=ConfigDCB.Flags or 8196;
              end;
   fcSoftware:begin
               ConfigDCB.Flags:=ConfigDCB.Flags and not DWORD(8196);
               ConfigDCB.Flags:=ConfigDCB.Flags or 768;
              end;
end;
 if hCommFile<>0 then begin
  SetCommState(hCommFile,ConfigDCB);
 end;
end;

function TComm32.StartComm: Boolean;
var
	commtimeouts:	TCommTimeouts;
	fdwEvtMask:		DWORD;
	hNewCommFile: THandle;
        DCB:TDCB;
begin
	if (hCommFile <> 0) then
		raise ECommsError.Create( 'Already have a comm file open' );

	hNewCommFile := CreateFile(
							PChar(fCommPort),
							GENERIC_READ+GENERIC_WRITE,
							0, {not shared}
							nil, {no security ??}
							OPEN_EXISTING,
							{FILE_ATTRIBUTE_NORMAL+}FILE_FLAG_OVERLAPPED,
							0 {template} );
	if hNewCommFile = INVALID_HANDLE_VALUE then
		raise ECommsError.Create( 'Error opening com port' );

	if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then
		raise ECommsError.Create( 'File handle is not a comm handle. ' );
                             //DCB
	hCommFile := hNewCommFile;
        GetCommState(hCommFile,DCB);
        DCB.BaudRate:=ConfigDCB.BaudRate;
        DCB.Flags:=ConfigDCB.Flags or 1;//11000000010001
        DCB.ByteSize:=ConfigDCB.ByteSize;
        DCB.Parity:=ConfigDCB.Parity;
        DCB.StopBits:=ConfigDCB.StopBits;
        DCB.EvtChar:=ConfigDCB.EvtChar;
        ConfigDCB:=DCB;
	GetCommMask( hCommFile, fdwEvtMask );
	GetCommTimeouts( hCommFile, commtimeouts );
	commtimeouts.ReadIntervalTimeout         := 1;//250!!!!!!!
	commtimeouts.ReadTotalTimeoutMultiplier  := 0;
	commtimeouts.ReadTotalTimeoutConstant    := 0;
	commtimeouts.WriteTotalTimeoutMultiplier := 0;
	commtimeouts.WriteTotalTimeoutConstant   := 0;
	SetCommTimeouts( hCommFile, commtimeouts );
        fActive:=true;
	if not SetCommState( hNewCommFile, Configdcb ) then begin
         CloseHandle( hCommFile );
         hCommFile:=0;
         fActive:=false;
         raise ECommsError.Create( 'Wrong comm parametrs!!!' );
         exit;
        end;
        SetupComm(hCommFile,fInQueue,fOutQueue);
	hCloseEvent := CreateEvent( nil, True, False, nil );
	if hCloseEvent = 0 then
	begin
		 hCommFile := 0;
		 Result := False;
		 Exit
	end;

	// Create the Read thread.
	try
		ReadThread := TReadThread.Create( True {suspended} );
	except
		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;

	ReadThread.Resume;


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

(*	while not ((WriteCreated and ReadCreated) or ThreadError) do
		{Thread Error not Implemented as yet - use a timeout?}
		Application.ProcessMessages;*)

	// Everything was created ok.  Ready to go!
	Result := True;
end; {TComm32.StartComm}

procedure TComm32.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 );
        fActive:=false;
	hCommFile := 0;
end; {TComm32.StopComm}

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

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

procedure TComm32.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
		begin
			ReadThread.Terminate;
		end;
		ReadThread.Free;
		ReadThread := nil;
	end;
end; {TComm32.CloseReadThread}
procedure TComm32.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);

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

procedure TComm32.ReceiveData( Buffer: PChar; BufferLength: Word );
begin
	if Assigned(FOnReceiveData) then
		FOnReceiveData( Buffer, BufferLength );
end;

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

(******************************************************************************)
//									TComm32 PRIVATE METHODS
(******************************************************************************)


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;
		PWM_THREADREADY:            //SetCommMask
			if msg.WParam = 0 then
				ReadCreated := True
			else
				WriteCreated := True;
                PWM_COMMEVENT:begin
                  fLineStatus:=MSG.LParam and $FFFF;
                  fModemLineStatus:=(MSG.LParam shr 16)and $FFFF;
                  if Assigned(fEvent) then
                   fEvent(self);
                  if (fLineStatus and EV_ERR)<>0 then begin
                   if Assigned(fERROREvent) then
                    fERROREvent(ReadThread.dwErrors);
                  end;
                  if (fLineStatus and EV_RXFLAG)<>0 then begin
                   if Assigned(fEventChar) then
                    fEventChar(Self);
                  end;
                  if (fLineStatus and EV_BREAK) <> 0 then begin
                   if Assigned(fBreak)then
                    fBreak(Self)
                  end;

	          if (fLineStatus and EV_TXEMPTY) <> 0 then begin
                    if Assigned(fTXEMPTY)then
                     fTXEMPTY(Self);
                  end;

	          if (fLineStatus and EV_RX80FULL) <> 0 then begin
                   if Assigned(fRX80FULL)then
                    fRX80FULL(Self);
                  end;

	          if (fLineStatus and EV_PERR) <> 0 then begin
                   if Assigned(fPERR)then
                    fPERR(Self);
                  end;

	          if (fLineStatus and EV_CTS) <> 0 then begin
                   if Assigned(fChCTS)then
                    fChCTS(Self);
                   if (fModemLineStatus and MS_CTS_ON)<>0 then begin
                    if Assigned(fSetCTS)then
                     fSetCTS(Self)
                   end
                   else begin
                    if Assigned(fClearCTS)then
                     fClearCTS(Self)
                   end;
                  end;

	          if (fLineStatus and EV_DSR) <> 0 then begin
                   if Assigned(fChDSR)then
                    fChDSR(Self);
                   if (fModemLineStatus and MS_DSR_ON)<>0 then begin
                    if Assigned(fSetDSR)then
                     fSetDSR(Self)
                   end
                   else begin
                    if Assigned(fClearDSR)then
                     fClearDSR(Self)
                   end;
                  end;

	          if (fLineStatus and EV_RING) <> 0 then begin
                   if Assigned(fChRING)then
                    fChRING(Self);
                   if (fModemLineStatus and MS_RING_ON)<>0 then begin
                    if Assigned(fSetRING)then
                     fSetRING(Self)
                   end
                   else begin
                    if Assigned(fClearRING)then
                     fClearRING(Self)
                   end;
                  end;

	          if (fLineStatus and EV_RLSD) <> 0 then begin
                   if Assigned(fChRLSD)then
                    fChRLSD(Self);
                   if (fModemLineStatus and MS_RLSD_ON)<>0 then begin
                    if Assigned(fSetRLSD)then
                     fSetRLSD(Self)
                   end
                   else begin
                    if Assigned(fClearRLSD)then
                     fClearRLSD(Self)
                   end;
                  end;

                end;
	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 TComm32.fOUTSIGNAL(St:DWORD);
begin
 EscapeCommFunction(hCommFile,st);
end;

procedure TReadThread.Execute;
var
	 szInputBuffer:	array[0..INPUTBUFFERSIZE-1] of Char;
	 nNumberOfBytesRead:	DWORD;

	 HandlesToWaitFor:	array[0..2] of THandle;
	 dwHandleSignaled:	DWORD;

	 dwMS,dwEventMask:		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_BREAK or
                                      EV_CTS or
                                      EV_DSR or
                                      EV_RING or
                                      EV_RLSD or
                                      EV_TXEMPTY or
                                      EV_ERR or
                                      EV_RX80FULL or
                                      EV_RXFLAG or
                                      EV_PERR) then
	begin
		PostHangupCall;
		goto EndReadThread;
	end;
        dwMS:=0;
        dwEventMask:=0;
        GetCommModemStatus(hCommFile,dwMS);
        if dwMS<>0 then begin
         if dwMS and MS_CTS_ON<>0 then
          dwEventMask:=dwEventMask or EV_CTS;
         if dwMS and MS_DSR_ON<>0 then
          dwEventMask:=dwEventMask or EV_DSR;
         if dwMS and MS_RING_ON<>0 then
          dwEventMask:=dwEventMask or EV_RING;
         if dwMS and MS_RLSD_ON<>0 then
          dwEventMask:=dwEventMask or EV_RLSD;

         dwMS:=dwMS shl 16;
         PostMessage(hComm32Window,PWM_COMMEVENT,0,dwEventMask or dwMS);
        end;
	// Start waiting for CommEvents
        if not SetupCommEvent( @overlappedCommEvent,  dwEventMask ) then
	begin
		PostHangupCall;
		goto EndReadThread;
	end;

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

	// Everything ready - tell main thread
	PostMessage( hComm32Window, PWM_THREADREADY, 0, 0 );
	// 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,  dwEventMask, TRUE ) then
				begin
					PostHangupCall;
					goto EndReadThread;
				end;

				// Start waiting for the next CommEvent.
				if not SetupCommEvent( @overlappedCommEvent,  dwEventMask ) then
				begin
					PostHangupCall;
					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;
					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
				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 TReadThread.SetupReadEvent( lpOverlappedRead: POverlapped;
	 szInputBuffer: PChar; dwSizeofBuffer: DWORD;
	 var NumberOfBytesRead: 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,0) then
		 Exit;

	// Start the overlapped ReadFile.
	if ReadFile( hCommFile,
				szInputBuffer^, dwSizeofBuffer,
				NumberOfBytesRead, lpOverlappedRead ) then
	begin
		 // Handle the data.
		if not HandleReadData( szInputBuffer, NumberOfBytesRead ) 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
	begin
		 Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
	PostHangupCall;
end; {TReadThread.SetupReadEvent}


function TReadThread.HandleReadData( szInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
var
	lpszPostedBytes: PChar;
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 := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );
		if lpszPostedBytes = nil{NULL} then
		begin
			Exit;
		end;

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

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


function TReadThread.HandleReadEvent( lpOverlappedRead: POverlapped;
	 szInputBuffer: PChar; dwSizeofBuffer: DWORD;
	 var NumberOfBytesRead: DWORD ): Boolean;
var
	dwLastError: DWORD;
begin
	Result := False;
	if GetOverlappedResult( hCommFile,
			lpOverlappedRead^, NumberOfBytesRead, False ) then
	begin
		Result := HandleReadData( szInputBuffer, NumberOfBytesRead );
		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
		Exit;
	end;
	PostHangupCall;
end; {TReadThread.HandleReadEvent}

function TReadThread.SetupCommEvent( lpOverlappedCommEvent: POverlapped;
	 var dwEventMask: 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, dwEventMask, 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, dwEventMask, 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
		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
		Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
end; {TReadThread.SetupCommEvent}


function TReadThread.HandleCommEvent( lpOverlappedCommEvent: POverlapped;
	 var dwEventMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
var
	dwDummy:			DWORD;
	lpszOutput:		PChar;
	dwLastError,
        ModemStatus:	DWORD;
begin
	Result := False;


	lpszOutput := PChar(LocalAlloc( LPTR, 256 ));
	if lpszOutput = nil{NULL} then
	begin
		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
				Exit;
			end;

			Exit;
		end;

	// Was the event an error?
	if (dwEventMask 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
				Exit;
			end;

			Exit;
		end;
		Result := True;
	end;                           //SetCommMask

	if (dwEventMask and EV_BREAK) <> 0 then begin
         Result := True;
        end;
	if (dwEventMask and EV_CTS) <> 0 then begin
       	 Result := True;
        end;
	if (dwEventMask and EV_DSR) <> 0 then begin
	 Result := True;
        end;
	if (dwEventMask and EV_RING) <> 0 then begin
         Result := True;
        end;
	if (dwEventMask and EV_TXEMPTY) <> 0 then begin
         Result := True;
        end;
	if (dwEventMask and EV_RXFLAG) <> 0 then begin
         Result := True;
        end;

	if (dwEventMask and EV_RLSD) <> 0 then begin
         Result := True;
        end;
	if (dwEventMask and EV_RX80FULL) <> 0 then begin
         Result := True;
        end;
	if (dwEventMask and EV_PERR) <> 0 then begin
         Result := True;
        end;
        dwEventMask:=dwEventMask or EV_RING;
        if Result then begin
         GetCommModemStatus(hCommFile,ModemStatus);
         ModemStatus:=ModemStatus shl 16;
         PostMessage(hComm32Window,PWM_COMMEVENT,0,dwEventMask or ModemStatus);
         exit;
        end;
end; {TReadThread.HandleCommEvent}

function TReadThread.ReceiveData( lpNewString: PChar; 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;

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

	// Everything ready - tell main thread
	PostMessage( hComm32Window, PWM_THREADREADY, 1, 0 );

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

				 // 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
				 {break;}
			end;
		end; {case}
	end; {main loop}

	 // Thats the end.  Now clean up.
	EndWriteThread:
	 PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
	 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
	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
					 Result := False;
					 Exit;
				end;

				// Unexpected error.  No idea what.
				if dwLastError <> ERROR_IO_PENDING then
				begin
					 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, INFINITE);

				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
						  PostHangupCall;
						  Result := False;
						  Exit
					 end;

					 else // This case should never occur.
					 begin
						  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
						  Result := False;
						  Exit;
					 end;

					 // No idea what could cause another error.
					 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 Register;
begin
  RegisterComponents('System', [TComm32]);
end;

end.
