1945 lines
60 KiB
Plaintext
1945 lines
60 KiB
Plaintext
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<6F> : 小豬工作室 Small-Pig Team in Taiwan R.O.C.
|
||
// Email : spigteam@vlsi.ice.cycu.edu.tw
|
||
// Date <20> : 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 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
|
||
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 := PChar( 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('System', [TComm])
|
||
end;
|
||
|
||
end.
|