谁有SPCOMM控件，发一个给我，网上找了好久，都下载不了(100)

谁有SPCOMM控件，发一个给我，网上找了好久，都下载不了请发邮箱：iefang@163.com

這個怎麼粘附件呢我發給你吧．

装个 VB 就可以找到了, VB 里好像自带有

unit SPComm;//// 硂琌????梆硄癟じン, ㄑ Delphi 2.0 莱ノ祘Αㄏノ. 続?ノㄓ暗?穨北?の// 虏虫肚块. ?じン㊣? Win32 API ㄓ笷Θ┮惠??, 叫ǎCommunications场??//// ?じン把σ David Wann. ┮籹?? COMM32.PAS Version 1.0??﹍弧????// This Communications Component is implemented using separate Read and Write// threads. Messages from the threads are posted to the Comm control which is// an invisible window. To handle data from the comm port, simply// attach a handler to 'OnReceiveData'. There is no need to free the memory// buffer passed to this handler. If TAPI is used to open the comm port, some// changes to this component are needed ('StartComm' currently opens the comm// port). The 'OnRequestHangup' event is included to assist this.//// David Wann// Stamina Software// 28/02/96// davidwann@hunterlink.net.au////// 硂?じンЧ??禣, 舧??ī' ?э┪暗ヴ?ㄤウノ硚. 埃?虫縒砪芥?じン.// This component is totally free(copyleft), you can do anything in any// purpose EXCEPT SELL IT ALONE.////// Author?: ?睫??? Small-Pig Team in Taiwan R.O.C.// Email : spigteam@vlsi.ice.cycu.edu.tw// Date ? : 1997/5/9//// Version 1.01 1996/9/4// - Add setting Parity, Databits, StopBits// - Add setting Flowcontroltr-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//interfaceuses 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 := 0end; {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 := Falseend; {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 := dwModemStateend;(******************************************************************************)// 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 endend; {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 endend; {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 endend;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 _SetCommStateend;procedure TComm.SetParityCheck( b : Boolean );begin if b = FParityCheck then Exit; FParityCheck := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetOutx_CtsFlow( b : Boolean );begin if b = FOutx_CtsFlow then Exit; FOutx_CtsFlow := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetOutx_DsrFlow( b : Boolean );begin if b = FOutx_DsrFlow then Exit; FOutx_DsrFlow := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetDtrControl( c : TDtrControl );begin if c = FDtrControl then Exit; FDtrControl := c; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetDsrSensitivity( b : Boolean );begin if b = FDsrSensitivity then Exit; FDsrSensitivity := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetTxContinueOnXoff( b : Boolean );begin if b = FTxContinueOnXoff then Exit; FTxContinueOnXoff := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetOutx_XonXoffFlow( b : Boolean );begin if b = FOutx_XonXoffFlow then Exit; FOutx_XonXoffFlow := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetInx_XonXoffFlow( b : Boolean );begin if b = FInx_XonXoffFlow then Exit; FInx_XonXoffFlow := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetReplaceWhenParityError( b : Boolean );begin if b = FReplaceWhenParityError then Exit; FReplaceWhenParityError := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetIgnoreNullChar( b : Boolean );begin if b = FIgnoreNullChar then Exit; FIgnoreNullChar := b; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetRtsControl( c : TRtsControl );begin if c = FRtsControl then Exit; FRtsControl := c; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetXonLimit( Limit : WORD );begin if Limit = FXonLimit then Exit; FXonLimit := Limit; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetXoffLimit( Limit : WORD );begin if Limit = FXoffLimit then Exit; FXoffLimit := Limit; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetByteSize( Size : TByteSize );begin if Size = FByteSize then Exit; FByteSize := Size; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetParity( p : TParity );begin if p = FParity then Exit; FParity := p; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetStopBits( Bits : TStopBits );begin if Bits = FStopBits then Exit; FStopBits := Bits; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetXonChar( c : AnsiChar );begin if c = FXonChar then Exit; FXonChar := c; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetXoffChar( c : AnsiChar );begin if c = FXoffChar then Exit; FXoffChar := c; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetReplacedChar( c : AnsiChar );begin if c = FReplacedChar then Exit; FReplacedChar := c; if hCommFile <> 0 then _SetCommStateend;procedure TComm.SetReadIntervalTimeout( v : DWORD );begin if v = FReadIntervalTimeout then Exit; FReadIntervalTimeout := v; if hCommFile <> 0 then _SetCommTimeoutend;procedure TComm.SetReadTotalTimeoutMultiplier( v : DWORD );begin if v = FReadTotalTimeoutMultiplier then Exit; FReadTotalTimeoutMultiplier := v; if hCommFile <> 0 then _SetCommTimeoutend;procedure TComm.SetReadTotalTimeoutConstant( v : DWORD );begin if v = FReadTotalTimeoutConstant then Exit; FReadTotalTimeoutConstant := v; if hCommFile <> 0 then _SetCommTimeoutend;procedure TComm.SetWriteTotalTimeoutMultiplier( v : DWORD );begin if v = FWriteTotalTimeoutMultiplier then Exit; FWriteTotalTimeoutMultiplier := v; if hCommFile <> 0 then _SetCommTimeoutend;procedure TComm.SetWriteTotalTimeoutConstant( v : DWORD );begin if v = FWriteTotalTimeoutConstant then Exit; FWriteTotalTimeoutConstant := v; if hCommFile <> 0 then _SetCommTimeoutend;(******************************************************************************)// 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. PostHangupCallend; {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 ) endend; {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. PostHangupCallend; {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. PostHangupCallend; {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 endend; {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 := Trueend;function TReadThread.ReceiveError( EvtMask : DWORD ): BOOL;begin Result := False; if not PostMessage( hComm32Window, PWM_RECEIVEERROR, 0, LPARAM(EvtMask) ) then PostHangupCall else Result := Trueend;function TReadThread.ModemStateChange( ModemEvent : DWORD ) : BOOL;begin Result := False; if not PostMessage( hComm32Window, PWM_MODEMSTATECHANGE, 0, LPARAM(ModemEvent) ) then PostHangupCall else Result := Trueend;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 := Trueend; {TWriteThread.HandleWriteData}procedure TWriteThread.PostHangupCall;begin PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 )end;procedure Register;begin //RegisterComponents('System', [TComm]) RegisterComponents('Serial', [TComm])end;end.

勇者，老DELPHI工作者了，呵呵。