最近也在搞这些东东，不过用的是GSM MODEM之类的进行发送。
贴出一个让大家参考参考！！！[
]
unit SMSDriver_Commdrv;
interface
uses
Windows, Messages,Classes,SysUtils,Forms;
//for delphi5
// Windows, Messages,Classes,SysUtils;
//for delphi6 because func AllocateHwnd
// now defined in Classes too. So If use delphi6 ,need not include 'Forms'.
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;
type
TParity = ( None, Odd, Even, Mark, Space );
TStopBits = ( sb_1, sb_1_5, sb_2 );
TByteSize = ( db_5,db_6, db_7, db_8 );
TBaudRate = (br_110, br_300, br_600, br_1200, br_2400,br_4800, br_9600, br_14400,
br_19200, br_38400, br_56000, br_128000, br_256000);
TDtrControl = ( DtrEnable, DtrDisable, DtrHandshake );
TRtsControl = ( RtsEnable, RtsDisable, RtsHandshake, RtsTransmissionAvailable );
TCommError = (ceOpen,ceRead,ceWrite);
//通信错误：打开错误、读错误、写错误
ECommsError = class( Exception );
TReceiveDataEvent = procedure(Sender: TObject;
Buffer: Pointer;
BufferLength: Word) of object;
TModemStateChangeEvent = procedure(Sender: TObject;
ModemEvent : DWORD) of object;
TSendDataEmptyEvent = procedure(Sender: TObject) of object;
TCommErrorEvent = procedure(Sender:TObject;CommError:TCommError) 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;
TComm = class( TObject )
private
ReadThread: TReadThread;
hCommFile: THandle;
hCloseEvent: THandle;
FHWnd: THandle;
FCommName: String;
FBaudRate: TBaudRate;
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;
FOnModemStateChange:TModemStateChangeEvent;
FOnSendDataEmpty: TSendDataEmptyEvent;
FOnCommError : TCommErrorEvent;
//add By jim 2001-07-25
procedure SetBaudRate( Rate : TBaudRate );
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 ReceiveData(Buffer: PChar;
BufferLength: Word);
procedure ReceiveError( EvtMask : DWORD );
procedure ModemStateChange( ModemEvent : DWORD );
procedure RequestHangup;
public
{ Public declarations }
constructor Create;
destructor Destroy;override;
property Handle: THandle read hCommFile;
function WriteCommData( pDataToWrite: PChar;
dwSizeofDataToWrite: Word ): Boolean;
function GetModemState : DWORD;
function Open:Boolean;
procedure Close;
property CommName: String read FCommName write FCommName;
property BaudRate: TBaudRate 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 OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
property OnRequestHangup: TNotifyEvent
read FOnRequestHangup write FOnRequestHangup;
property OnSendDataEmpty: TSendDataEmptyEvent
read FOnSendDataEmpty write FOnSendDataEmpty;
property OnCommError:TCommErrorEvent
read FOnCommError write FOnCommError;
end;
const
// Default size of the Input Buffer used by this code.
INPUTBUFFERSIZE = 2048;
implementation
(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)
constructor TComm.Create;
begin
ReadThread := nil;
hCommFile := 0;
hCloseEvent := 0;
FCommName := 'COM1';
FBaudRate := br_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 := db_8;
FParity := None;
FStopBits := sb_1;
FXonChar := chr($11);
// Ctrl-Q
FXoffChar := chr($13);
// Ctrl-S
FReplacedChar := chr(0);
FReadIntervalTimeout := 100;
FReadTotalTimeoutMultiplier := 0;
FReadTotalTimeoutConstant := 0;
FWriteTotalTimeoutMultiplier := 0;
FWriteTotalTimeoutConstant := 0;
end;
destructor TComm.Destroy;
begin
inherited Destroy;
end;
//
// FUNCTION: Open
//
// 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.
//
//
function TComm.Open:Boolean;
var
hNewCommFile: THandle;
begin
Result := False;
// Are we alreadydo
ing comm?
if (hCommFile <> 0) then
begin
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'This serial port already opened' );
exit;
end;
FHWnd := AllocateHWnd(CommWndProc);
//2001-07-26
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
begin
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'Error opening serial port' );
exit;
end;
// Is this a valid comm handle?
if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then
begin
CloseHandle( hNewCommFile );
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'File handle is not a comm handle ' );
exit;
end;
if not SetupComm( hNewCommFile, 4096, 4096 ) then
begin
CloseHandle( hCommFile );
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'Cannot setup comm buffer' );
exit;
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 ) ;
// 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;
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'Unable to create event' );
exit;
end;
try
ReadThread := TReadThread.Create( True {suspended} );
except
ReadThread := nil;
CloseHandle( hCloseEvent );
CloseHandle( hCommFile );
hCommFile := 0;
if Assigned(FOnCommError) then
FOnCommError(self,ceOpen)
else
raise ECommsError.Create( 'Unable to create read thread' );
exit;
end;
ReadThread.hCommFile := hCommFile;
ReadThread.hCloseEvent := hCloseEvent;
ReadThread.hComm32Window := FHWnd;
// Comm threads should have a higher base priority than the UI thread.
// If theydo
n't, then
any temporary priority boost the UI thread gains
// could cause the COMM threads to loose data.
ReadThread.Priority := tpHighest;
ReadThread.Resume;
Result := True;
// Everything was created ok. Ready to go!
end;
//
// FUNCTION: Close
//
// 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;
procedure TComm.Close;
begin
// No need to continue if we're not communicating.
if hCommFile = 0 then
Exit;
// Close the threads.
CloseReadThread;
// Not needed anymore.
CloseHandle( hCloseEvent );
// Now close the comm port handle.
CloseHandle( hCommFile );
hCommFile := 0;
DeallocateHWnd(FHwnd);
//2001-07-26
end;
//
// 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
// thatdo
esn'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}
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 )
if Assigned(FOnCommError) then
FOnCommError(self,ceRead);
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;
{** Set Baud Rate **}
case FBaudRate of
br_110: DCB.BaudRate := CBR_110;
br_300: DCB.BaudRate := CBR_300;
br_600: DCB.BaudRate := CBR_600;
br_1200: DCB.BaudRate := CBR_1200;
br_2400: DCB.BaudRate := CBR_2400;
br_4800: DCB.BaudRate := CBR_4800;
br_9600: DCB.BaudRate := CBR_9600;
br_14400: DCB.BaudRate := CBR_14400;
br_19200: DCB.BaudRate := CBR_19200;
br_38400: DCB.BaudRate := CBR_38400;
br_56000: DCB.BaudRate := CBR_56000;
br_128000: DCB.BaudRate := CBR_128000;
br_256000: DCB.BaudRate := CBR_256000;
end;
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 : TBaudRate );
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
// eventuallydo
ne 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 Truedo
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
{??? GetOverlappedResultdo
es 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;
//--------------------------------------------------------------------
//
// 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 threaddo
esn't exist.
//
// COMMENTS:
//
// This is a wrapper function so that other modulesdo
n't care that
// Comm writing isdo
ne 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;
overlappedWrite: TOverLapped;
dwLastError,
dwNumberOfBytesWritten,
dwWhereToStartWriting,
dwHandleSignaled: DWORD;
HandleToWaitFor: THandle;
label WriteError, //写串口错误
WriteOK, //写串口成功
GetOut;
//exit
begin
// Result := False;
// if dwSizeofDataToWrite <= 0 then
exit;
//2001-08-30 修改了在Win2000中无法写串口的错误
FillChar( overlappedWrite, Sizeof(overlappedWrite), 0 );
// Lets put an event in the Write overlapped structure.
overlappedWrite.hEvent := CreateEvent( nil, True, True, nil);
//2001-08-30 modi end
if dwSizeofDataToWrite <= 0 then
goto WriteError;
Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
dwNumberOfBytesWritten := 0;
dwWhereToStartWriting := 0;
// Start at the begin
ning.
HandleToWaitFor := overlappedWrite.hEvent;
// Keep looping until all characters have been written.
repeat
// Start the overlapped I/O.
if not WriteFile( hCommFile,
pDataToWrite[ dwWhereToStartWriting ],
dwSizeofDataToWrite, dwNumberOfBytesWritten,
@OverlappedWrite ) then
{ if not WriteFile( hCommFile,
pDataToWrite[ dwWhereToStartWriting ],
dwSizeofDataToWrite, dwNumberOfBytesWritten,
nil ) then
} begin
{WriteFile failure}
dwLastError := GetLastError;
// WriteFile failed. Expected;
lets handle it.
// 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;
// if dwLastError <> ERROR_IO_PENDING then
Exit;
if dwLastError = ERROR_INVALID_HANDLE then
goto WriteError;
if dwLastError <> ERROR_IO_PENDING then
goto WriteError;
// This is the expected ERROR_IO_PENDING case.
dwHandleSignaled := WaitForSingleObject(HandleToWaitFor,INFINITE);
case dwHandleSignaled of
WAIT_OBJECT_0: // CloseEvent signaled!
begin
// Time to get the results of the WriteFile
if not GetOverlappedResult(hCommFile,OverlappedWrite,
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;
if dwLastError = ERROR_INVALID_HANDLE then
goto WriteError;
end;
end;
else
//Default deal of case
// Exit;
goto WriteError;
end;
{case}
end;
{WriteFile failure}
// Some data was written. Make sure it all got written.
Dec( dwSizeofDataToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten )
until (dwSizeofDataToWrite <= 0);
// Write the whole thing!
WriteOK:
// Wrote the whole string.
Result := True;
if Assigned(FOnSendDataEmpty) then
FOnSendDataEmpty(Self);
goto GetOut;
WriteError:
Result := False;
if Assigned(FOnCommError) then
FOnCommError(self,ceWrite);
goto GetOut;
//2001-08-30 修改了在Win2000中无法写串口的错误
GetOut:
CloseHandle(overlappedWrite.hEvent);
exit;
//2001-08-30 modi end
end;
end.
