?? spcomm.pas
字號:
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -