DELPHI XE10 ´®¿Ú²Ù×÷µ¥Ôª ___delphi___

DELPHI XE10 ´®¿Ú²Ù×÷µ¥Ôª DELPHI XE10 ´®¿Ú²Ù×÷µ¥Ôª
Ò»¡¢´®¿Úµ¥Ôª

unit SPComm;
//{$WARN SYMBOL_DEPRECATED OFF}
//¦p¤U¡G
// 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.
//
//
// Version 1.01 1996/9/4
// - Add setting Parity, Databits, StopBits
// - Add setting Flowcontrol:Dtr-Dsr, Cts-Rts, Xon-Xoff
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, 2048, 1024 ) then
begin
CloseHandle( hCommFile );
raise ECommsError.Create( 'Cannot setup comm buffer' )
end;

// It is ok to continue.

hCommFile := hNewCommFile;

// purge any information in the buffer

PurgeComm( hCommFile, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
FSendDataEmpty := True;

// Setting the time-out value
_SetCommTimeout;

// Querying then setting the comm port configurations.
_SetCommState;

// Create the event that will signal the threads to close.
hCloseEvent := CreateEvent( nil, True, False, nil );

if hCloseEvent = 0 then
begin
CloseHandle( hCommFile );
hCommFile := 0;
raise ECommsError.Create( 'Unable to create event' )
end;

// Create the Read thread.
try
ReadThread := TReadThread.Create( True {suspended} );
except
ReadThread := nil;
CloseHandle( hCloseEvent );
CloseHandle( hCommFile );
hCommFile := 0;
raise ECommsError.Create( 'Unable to create read thread' )
end;
ReadThread.hCommFile := hCommFile;
ReadThread.hCloseEvent := hCloseEvent;
ReadThread.hComm32Window := FHWnd;

// Comm threads should have a higher base priority than the UI thread.
// If they don't, then any temporary priority boost the UI thread gains
// could cause the COMM threads to loose data.
ReadThread.Priority := tpHighest;

// Create the Write thread.
try
WriteThread := TWriteThread.Create( True {suspended} );
except
CloseReadThread;
WriteThread := nil;
CloseHandle( hCloseEvent );
CloseHandle( hCommFile );
hCommFile := 0;
raise ECommsError.Create( 'Unable to create write thread' )
end;
WriteThread.hCommFile := hCommFile;
WriteThread.hCloseEvent := hCloseEvent;
WriteThread.hComm32Window := FHWnd;
WriteThread.pFSendDataEmpty := @FSendDataEmpty;

WriteThread.Priority := tpHigher;

ReadThread.Resume;
WriteThread.Resume

// Everything was created ok. Ready to go!
end; {TComm.StartComm}

//
// FUNCTION: StopComm
//
// PURPOSE: Stop and end all communication threads.
//
// PARAMETERS:
// none
//
// RETURN VALUE:
// none
//
// COMMENTS:
//
// Tries to gracefully signal all communication threads to
// close, but terminates them if it has to.
//
//
procedure TComm.StopComm;
begin
// No need to continue if we're not communicating.
if hCommFile = 0 then
Exit;

// Close the threads.
CloseReadThread;
CloseWriteThread;

// Not needed anymore.
CloseHandle( hCloseEvent );

// Now close the comm port handle.
CloseHandle( hCommFile );
hCommFile := 0
end; {TComm.StopComm}

//
// FUNCTION: WriteCommData(PChar, Word)
//
// PURPOSE: Send a String to the Write Thread to be written to the Comm.
//
// PARAMETERS:
// pszStringToWrite - String to Write to Comm port.
// nSizeofStringToWrite - length of pszStringToWrite.
//
// RETURN VALUE:
// Returns TRUE if the PostMessage is successful.
// Returns FALSE if PostMessage fails or Write thread doesn't exist.
//
// COMMENTS:
//
// This is a wrapper function so that other modules don't care that
// Comm writing is done via PostMessage to a Write thread. Note that
// using PostMessage speeds up response to the UI (very little delay to
// 'write' a string) and provides a natural buffer if the comm is slow
// (ie: the messages just pile up in the message queue).
//
// Note that it is assumed that pszStringToWrite is allocated with
// LocalAlloc, and that if WriteCommData succeeds, its the job of the
// Write thread to LocalFree it. If WriteCommData fails, then its
// the job of the calling function to free the string.
//
//
function TComm.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
Buffer: Pointer;
begin
if (WriteThread <> nil) and (dwSizeofDataToWrite <> 0) then
begin
Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
FSendDataEmpty := False;
if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
begin
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
with msg do
case msg of
PWM_GOTCOMMDATA:
begin
ReceiveData( PChar(LParam), WParam );
LocalFree( LParam )
end;
PWM_RECEIVEERROR: ReceiveError( LParam );
PWM_MODEMSTATECHANGE:ModemStateChange( LParam );
PWM_REQUESTHANGUP: RequestHangup;
PWM_SENDDATAEMPTY: _SendDataEmpty;
else
Result := DefWindowProc(FHWnd, Msg, wParam, lParam);
end
end;

procedure TComm._SetCommState;
var
dcb: Tdcb;
commprop: TCommProp;
fdwEvtMask: DWORD;
begin
// Configure the comm settings.
// NOTE: Most Comm settings can be set through TAPI, but this means that
// the CommFile will have to be passed to this component.

GetCommState( hCommFile, dcb );
GetCommProperties( hCommFile, commprop );
GetCommMask( hCommFile, fdwEvtMask );

// fAbortOnError is the only DCB dependancy in TapiComm.
// Can't guarentee that the SP will set this to what we expect.
{dcb.fAbortOnError := False; NOT VALID}

dcb.BaudRate := FBaudRate;

dcb.Flags := 1; // Enable fBinary

if FParityCheck then
dcb.Flags := dcb.Flags or 2; // Enable parity check

// setup hardware flow control

if FOutx_CtsFlow then
dcb.Flags := dcb.Flags or 4;

if FOutx_DsrFlow then
dcb.Flags := dcb.Flags or 8;

if FDtrControl = DtrEnable then
dcb.Flags := dcb.Flags or $10
else if FDtrControl = DtrHandshake then
dcb.Flags := dcb.Flags or $20;

if FDsrSensitivity then
dcb.Flags := dcb.Flags or $40;

if FTxContinueOnXoff then
dcb.Flags := dcb.Flags or $80;

if FOutx_XonXoffFlow then
dcb.Flags := dcb.Flags or $100;

if FInx_XonXoffFlow then
dcb.Flags := dcb.Flags or $200;

if FReplaceWhenParityError then
dcb.Flags := dcb.Flags or $400;

if FIgnoreNullChar then
dcb.Flags := dcb.Flags or $800;

if FRtsControl = RtsEnable then
dcb.Flags := dcb.Flags or $1000
else if FRtsControl = RtsHandshake then
dcb.Flags := dcb.Flags or $2000
else if FRtsControl = RtsTransmissionAvailable then
dcb.Flags := dcb.Flags or $3000;

dcb.XonLim := FXonLimit;
dcb.XoffLim := FXoffLimit;

dcb.ByteSize := Ord( FByteSize ) + 5;
dcb.Parity := Ord( FParity );
dcb.StopBits := Ord( FStopBits );

dcb.XonChar := FXonChar;
dcb.XoffChar := FXoffChar;

dcb.ErrorChar := FReplacedChar;

SetCommState( hCommFile, dcb )
end;

procedure TComm._SetCommTimeout;
var
commtimeouts: TCommTimeouts;
begin
GetCommTimeouts( hCommFile, commtimeouts );

// The CommTimeout numbers will very likely change if you are
// coding to meet some kind of specification where
// you need to reply within a certain amount of time after
// recieving the last byte. However, If 1/4th of a second
// goes by between recieving two characters, its a good
// indication that the transmitting end has finished, even
// assuming a 1200 baud modem.

commtimeouts.ReadIntervalTimeout := FReadIntervalTimeout;
commtimeouts.ReadTotalTimeoutMultiplier := FReadTotalTimeoutMultiplier;
commtimeouts.ReadTotalTimeoutConstant := FReadTotalTimeoutConstant;
commtimeouts.WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier;
commtimeouts.WriteTotalTimeoutConstant := FWriteTotalTimeoutConstant;

SetCommTimeouts( hCommFile, commtimeouts );
end;

procedure TComm.SetBaudRate( Rate : DWORD );
begin
if Rate = FBaudRate then
Exit;

FBaudRate := Rate;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetParityCheck( b : Boolean );
begin
if b = FParityCheck then
Exit;

FParityCheck := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetOutx_CtsFlow( b : Boolean );
begin
if b = FOutx_CtsFlow then
Exit;

FOutx_CtsFlow := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetOutx_DsrFlow( b : Boolean );
begin
if b = FOutx_DsrFlow then
Exit;

FOutx_DsrFlow := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetDtrControl( c : TDtrControl );
begin
if c = FDtrControl then
Exit;

FDtrControl := c;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetDsrSensitivity( b : Boolean );
begin
if b = FDsrSensitivity then
Exit;

FDsrSensitivity := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetTxContinueOnXoff( b : Boolean );
begin
if b = FTxContinueOnXoff then
Exit;

FTxContinueOnXoff := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetOutx_XonXoffFlow( b : Boolean );
begin
if b = FOutx_XonXoffFlow then
Exit;

FOutx_XonXoffFlow := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetInx_XonXoffFlow( b : Boolean );
begin
if b = FInx_XonXoffFlow then
Exit;

FInx_XonXoffFlow := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetReplaceWhenParityError( b : Boolean );
begin
if b = FReplaceWhenParityError then
Exit;

FReplaceWhenParityError := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetIgnoreNullChar( b : Boolean );
begin
if b = FIgnoreNullChar then
Exit;

FIgnoreNullChar := b;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetRtsControl( c : TRtsControl );
begin
if c = FRtsControl then
Exit;

FRtsControl := c;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetXonLimit( Limit : WORD );
begin
if Limit = FXonLimit then
Exit;

FXonLimit := Limit;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetXoffLimit( Limit : WORD );
begin
if Limit = FXoffLimit then
Exit;

FXoffLimit := Limit;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetByteSize( Size : TByteSize );
begin
if Size = FByteSize then
Exit;

FByteSize := Size;

if hCommFile <> 0 then
_SetCommState
end;

{procedure TComm.SetParity( p : TParity );
begin
if p = FParity then
Exit;
FParity := p;
if hCommFile <> 0 then
_SetCommState
end;}

procedure TComm.SetStopBits( Bits : TStopBits );
begin
if Bits = FStopBits then
Exit;

FStopBits := Bits;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetXonChar( c : AnsiChar );
begin
if c = FXonChar then
Exit;

FXonChar := c;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetXoffChar( c : AnsiChar );
begin
if c = FXoffChar then
Exit;

FXoffChar := c;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetReplacedChar( c : AnsiChar );
begin
if c = FReplacedChar then
Exit;

FReplacedChar := c;

if hCommFile <> 0 then
_SetCommState
end;

procedure TComm.SetReadIntervalTimeout( v : DWORD );
begin
if v = FReadIntervalTimeout then
Exit;

FReadIntervalTimeout := v;

if hCommFile <> 0 then
_SetCommTimeout
end;

procedure TComm.SetReadTotalTimeoutMultiplier( v : DWORD );
begin
if v = FReadTotalTimeoutMultiplier then
Exit;

FReadTotalTimeoutMultiplier := v;

if hCommFile <> 0 then
_SetCommTimeout
end;

procedure TComm.SetReadTotalTimeoutConstant( v : DWORD );
begin
if v = FReadTotalTimeoutConstant then
Exit;

FReadTotalTimeoutConstant := v;

if hCommFile <> 0 then
_SetCommTimeout
end;

procedure TComm.SetWriteTotalTimeoutMultiplier( v : DWORD );
begin
if v = FWriteTotalTimeoutMultiplier then
Exit;

FWriteTotalTimeoutMultiplier := v;

if hCommFile <> 0 then
_SetCommTimeout
end;

procedure TComm.SetWriteTotalTimeoutConstant( v : DWORD );
begin
if v = FWriteTotalTimeoutConstant then
Exit;

FWriteTotalTimeoutConstant := v;

if hCommFile <> 0 then
_SetCommTimeout
end;

function TComm.GetConnected: Boolean;
begin
Result := (ComHandle <> 0); // HDW 2013/11/06
end;

procedure TComm.SetCommName(const Value: String);
function NormalizedCommName(ACommName: string): string;
begin
if Pos('\\.\', ACommName) <= 0 then
Result := '\\.\' + StringReplace(ACommName, ':', '', [rfReplaceAll])
else
Result := ACommName;
end;

begin
if (FCommName <> Value) then
begin
FCommName := NormalizedCommName(Value); // HDW 2013/11/06
end;
end;

(******************************************************************************)
// READ THREAD
(******************************************************************************)

//
// PROCEDURE: TReadThread.Execute
//
// PURPOSE: This is the starting point for the Read Thread.
//
// PARAMETERS:
// None.
//
// RETURN VALUE:
// None.
//
// COMMENTS:
//
// The Read Thread uses overlapped ReadFile and sends any data
// read from the comm port to the Comm32Window. This is
// eventually done through a PostMessage so that the Read Thread
// is never away from the comm port very long. This also provides
// natural desynchronization between the Read thread and the UI.
//
// If the CloseEvent object is signaled, the Read Thread exits.
//
// Separating the Read and Write threads is natural for a application
// where there is no need for synchronization between
// reading and writing. However, if there is such a need (for example,
// most file transfer algorithms synchronize the reading and writing),
// then it would make a lot more sense to have a single thread to handle
// both reading and writing.
//
//
procedure TReadThread.Execute;
var
szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
nNumberOfBytesRead: DWORD;

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

fdwEvtMask: DWORD;

// Needed for overlapped I/O (ReadFile)
overlappedRead: TOverlapped;

// Needed for overlapped Comm Event handling.
overlappedCommEvent: TOverlapped;
label
EndReadThread;
begin
FillChar( overlappedRead, Sizeof(overlappedRead), 0 );
FillChar( overlappedCommEvent, Sizeof(overlappedCommEvent), 0 );

// Lets put an event in the Read overlapped structure.
overlappedRead.hEvent := CreateEvent( nil, True, True, nil);
if overlappedRead.hEvent = 0 then
begin
PostHangupCall;
goto EndReadThread
end;

// And an event for the CommEvent overlapped structure.
overlappedCommEvent.hEvent := CreateEvent( nil, True, True, nil);
if overlappedCommEvent.hEvent = 0 then
begin
PostHangupCall();
goto EndReadThread
end;

// We will be waiting on these objects.
HandlesToWaitFor[0] := hCloseEvent;
HandlesToWaitFor[1] := overlappedCommEvent.hEvent;
HandlesToWaitFor[2] := overlappedRead.hEvent;

// Setup CommEvent handling.

// Set the comm mask so we receive error signals.
if not SetCommMask(hCommFile, EV_ERR or EV_RLSD or EV_RING ) then
begin
PostHangupCall;
goto EndReadThread
end;

// Start waiting for CommEvents (Errors)
if not SetupCommEvent( @overlappedCommEvent, fdwEvtMask ) then
goto EndReadThread;

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

// Keep looping until we break out.
while True do
begin
// Wait until some event occurs (data to read; error; stopping).
dwHandleSignaled := WaitForMultipleObjects(3, @HandlesToWaitFor,
False, INFINITE);

// Which event occured?
case dwHandleSignaled of
WAIT_OBJECT_0: // Signal to end the thread.
begin
// Time to exit.
goto EndReadThread
end;

WAIT_OBJECT_0 + 1: // CommEvent signaled.
begin
// Handle the CommEvent.
if not HandleCommEvent( @overlappedCommEvent, fdwEvtMask, TRUE ) then
goto EndReadThread;

// Start waiting for the next CommEvent.
if not SetupCommEvent( @overlappedCommEvent, fdwEvtMask ) then
goto EndReadThread
{break;??}
end;

WAIT_OBJECT_0 + 2: // Read Event signaled.
begin
// Get the new data!
if not HandleReadEvent( @overlappedRead,
@szInputBuffer,
INPUTBUFFERSIZE,
nNumberOfBytesRead ) then
goto EndReadThread;

// Wait for more new data.
if not SetupReadEvent( @overlappedRead,
@szInputBuffer, INPUTBUFFERSIZE,
nNumberOfBytesRead ) then
goto EndReadThread
{break;}
end;

WAIT_FAILED: // Wait failed. Shouldn't happen.
begin
PostHangupCall;
goto EndReadThread
end
else // This case should never occur.
begin
PostHangupCall;
goto EndReadThread
end
end {case dwHandleSignaled}
end; {while True}

// Time to clean up Read Thread.
EndReadThread:

PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR );
CloseHandle( overlappedRead.hEvent );
CloseHandle( overlappedCommEvent.hEvent )
end; {TReadThread.Execute}

//
// FUNCTION: SetupReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
// PURPOSE: Sets up an overlapped ReadFile
//
// PARAMETERS:
// lpOverlappedRead - address of overlapped structure to use.
// lpszInputBuffer - Buffer to place incoming bytes.
// dwSizeofBuffer - size of lpszInputBuffer.
// lpnNumberOfBytesRead - address of DWORD to place the number of read bytes.
//
// RETURN VALUE:
// TRUE if able to successfully setup the ReadFile. FALSE if there
// was a failure setting up or if the CloseEvent object was signaled.
//
// COMMENTS:
//
// This function is a helper function for the Read Thread. This
// function sets up the overlapped ReadFile so that it can later
// be waited on (or more appropriatly, so the event in the overlapped
// structure can be waited upon). If there is data waiting, it is
// handled and the next ReadFile is initiated.
// Another possible reason for returning FALSE is if the comm port
// is closed by the service provider.
//
//
//
function TReadThread.SetupReadEvent( lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
var
dwLastError: DWORD;
label
StartSetupReadEvent;
begin
Result := False;

StartSetupReadEvent:

// Make sure the CloseEvent hasn't been signaled yet.
// Check is needed because this function is potentially recursive.
if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
Exit;

// Start the overlapped ReadFile.
if ReadFile( hCommFile,
lpszInputBuffer^, dwSizeofBuffer,
lpnNumberOfBytesRead, lpOverlappedRead ) then
begin
// This would only happen if there was data waiting to be read.

// Handle the data.
if not HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead ) then
Exit;

// Start waiting for more data.
goto StartSetupReadEvent
end;

// ReadFile failed. Expected because of overlapped I/O.
dwLastError := GetLastError;

// LastError was ERROR_IO_PENDING, as expected.
if dwLastError = ERROR_IO_PENDING then
begin
Result := True;
Exit
end;

// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
Exit;

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

//
// FUNCTION: HandleReadData(LPCSTR, DWORD)
//
// PURPOSE: Deals with data after its been read from the comm file.
//
// PARAMETERS:
// lpszInputBuffer - Buffer to place incoming bytes.
// dwSizeofBuffer - size of lpszInputBuffer.
//
// RETURN VALUE:
// TRUE if able to successfully handle the data.
// FALSE if unable to allocate memory or handle the data.
//
// COMMENTS:
//
// This function is yet another helper function for the Read Thread.
// It LocalAlloc()s a buffer, copies the new data to this buffer and
// calls PostWriteToDisplayCtl to let the EditCtls module deal with
// the data. Its assumed that PostWriteToDisplayCtl posts the message
// rather than dealing with it right away so that the Read Thread
// is free to get right back to waiting for data. Its also assumed
// that the EditCtls module is responsible for LocalFree()ing the
// pointer that is passed on.
//
//
function TReadThread.HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
var
lpszPostedBytes: LPSTR;
begin
Result := False;

// If we got data and didn't just time out empty...
if dwSizeofBuffer <> 0 then
begin
// Do something with the bytes read.

lpszPostedBytes := PAnsiChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );

if lpszPostedBytes = nil{NULL} then
begin
// Out of memory

PostHangupCall;
Exit
end;

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

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

//
// FUNCTION: HandleReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
// PURPOSE: Retrieves and handles data when there is data ready.
//
// PARAMETERS:
// lpOverlappedRead - address of overlapped structure to use.
// lpszInputBuffer - Buffer to place incoming bytes.
// dwSizeofBuffer - size of lpszInputBuffer.
// lpnNumberOfBytesRead - address of DWORD to place the number of read bytes.
//
// RETURN VALUE:
// TRUE if able to successfully retrieve and handle the available data.
// FALSE if unable to retrieve or handle the data.
//
// COMMENTS:
//
// This function is another helper function for the Read Thread. This
// is the function that is called when there is data available after
// an overlapped ReadFile has been setup. It retrieves the data and
// handles it.
//
//
function TReadThread.HandleReadEvent( lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
var
dwLastError: DWORD;
begin
Result := False;

if GetOverlappedResult( hCommFile,
lpOverlappedRead^, lpnNumberOfBytesRead, False ) then
begin
Result := HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead );
Exit
end;

// Error in GetOverlappedResult; handle it.

dwLastError := GetLastError;

// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
Exit;

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

//
// FUNCTION: SetupCommEvent(LPOVERLAPPED, LPDWORD)
//
// PURPOSE: Sets up the overlapped WaitCommEvent call.
//
// PARAMETERS:
// lpOverlappedCommEvent - Pointer to the overlapped structure to use.
// lpfdwEvtMask - Pointer to DWORD to received Event data.
//
// RETURN VALUE:
// TRUE if able to successfully setup the WaitCommEvent.
// FALSE if unable to setup WaitCommEvent, unable to handle
// an existing outstanding event or if the CloseEvent has been signaled.
//
// COMMENTS:
//
// This function is a helper function for the Read Thread that sets up
// the WaitCommEvent so we can deal with comm events (like Comm errors)
// if they occur.
//
//
function TReadThread.SetupCommEvent( lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD ): Boolean;
var
dwLastError: DWORD;
label
StartSetupCommEvent;
begin
Result := False;

StartSetupCommEvent:

// Make sure the CloseEvent hasn't been signaled yet.
// Check is needed because this function is potentially recursive.
if WAIT_TIMEOUT <> WaitForSingleObject( hCloseEvent,0 ) then
Exit;

// Start waiting for Comm Errors.
if WaitCommEvent( hCommFile, lpfdwEvtMask, lpOverlappedCommEvent ) then
begin
// This could happen if there was an error waiting on the
// comm port. Lets try and handle it.

if not HandleCommEvent( nil, lpfdwEvtMask, False ) then
begin
{??? GetOverlappedResult does not handle "NIL" as defined by Borland}
Exit
end;

// What could cause infinite recursion at this point?
goto StartSetupCommEvent
end;

// We expect ERROR_IO_PENDING returned from WaitCommEvent
// because we are waiting with an overlapped structure.

dwLastError := GetLastError;

// LastError was ERROR_IO_PENDING, as expected.
if dwLastError = ERROR_IO_PENDING then
begin
Result := True;
Exit
end;

// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
Exit;

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

//
// FUNCTION: HandleCommEvent(LPOVERLAPPED, LPDWORD, BOOL)
//
// PURPOSE: Handle an outstanding Comm Event.
//
// PARAMETERS:
// lpOverlappedCommEvent - Pointer to the overlapped structure to use.
// lpfdwEvtMask - Pointer to DWORD to received Event data.
// fRetrieveEvent - Flag to signal if the event needs to be
// retrieved, or has already been retrieved.
//
// RETURN VALUE:
// TRUE if able to handle a Comm Event.
// FALSE if unable to setup WaitCommEvent, unable to handle
// an existing outstanding event or if the CloseEvent has been signaled.
//
// COMMENTS:
//
// This function is a helper function for the Read Thread that (if
// fRetrieveEvent == TRUE) retrieves an outstanding CommEvent and
// deals with it. The only event that should occur is an EV_ERR event,
// signalling that there has been an error on the comm port.
//
// Normally, comm errors would not be put into the normal data stream
// as this sample is demonstrating. Putting it in a status bar would
// be more appropriate for a real application.
//
//
function TReadThread.HandleCommEvent( lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
var
dwDummy: DWORD;
dwErrors: DWORD;
dwLastError: DWORD;
dwModemEvent: DWORD;
begin
Result := False;

// If this fails, it could be because the file was closed (and I/O is
// finished) or because the overlapped I/O is still in progress. In
// either case (or any others) its a bug and return FALSE.
if fRetrieveEvent then
begin
if not GetOverlappedResult( hCommFile,
lpOverlappedCommEvent^, dwDummy, False ) then
begin
dwLastError := GetLastError;

// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
Exit;

PostHangupCall;
Exit
end
end;

// Was the event an error?
if (lpfdwEvtMask and EV_ERR) <> 0 then
begin
// Which error was it?
if not ClearCommError( hCommFile, dwErrors, nil ) then
begin
dwLastError := GetLastError;

// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
Exit;

PostHangupCall;
Exit
end;

// Its possible that multiple errors occured and were handled
// in the last ClearCommError. Because all errors were signaled
// individually, but cleared all at once, pending comm events
// can yield EV_ERR while dwErrors equals 0. Ignore this event.

if not ReceiveError( dwErrors ) then
Exit;

Result := True
end;

dwModemEvent := 0;

if ((lpfdwEvtMask and EV_RLSD) <> 0) then
dwModemEvent := ME_RLSD;
if ((lpfdwEvtMask and EV_RING) <> 0) then
dwModemEvent := dwModemEvent or ME_RING;

if dwModemEvent <> 0 then
begin
if not ModemStateChange( dwModemEvent ) then
begin
Result := False;
Exit
end;

Result := True
end;

if ((lpfdwEvtMask and EV_ERR)=0) and (dwModemEvent=0) then
begin
// Should not have gotten here.
PostHangupCall
end
end; {TReadThread.HandleCommEvent}

function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
begin
Result := False;

if not PostMessage( hComm32Window, PWM_GOTCOMMDATA,
WPARAM(dwSizeofNewString), LPARAM(lpNewString) ) then
PostHangupCall
else
Result := True
end;

function TReadThread.ReceiveError( EvtMask : DWORD ): BOOL;
begin
Result := False;

if not PostMessage( hComm32Window, PWM_RECEIVEERROR, 0, LPARAM(EvtMask) ) then
PostHangupCall
else
Result := True
end;

function TReadThread.ModemStateChange( ModemEvent : DWORD ) : BOOL;
begin
Result := False;

if not PostMessage( hComm32Window, PWM_MODEMSTATECHANGE, 0, LPARAM(ModemEvent) ) then
PostHangupCall
else
Result := True
end;

procedure TReadThread.PostHangupCall;
begin
PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

(******************************************************************************)
// WRITE THREAD
(******************************************************************************)

//
// PROCEDURE: TWriteThread.Execute
//
// PURPOSE: The starting point for the Write thread.
//
// PARAMETERS:
// lpvParam - unused.
//
// RETURN VALUE:
// DWORD - unused.
//
// COMMENTS:
//
// The Write thread uses a PeekMessage loop to wait for a string to write,
// and when it gets one, it writes it to the Comm port. If the CloseEvent
// object is signaled, then it exits. The use of messages to tell the
// Write thread what to write provides a natural desynchronization between
// the UI and the Write thread.
//
//
procedure TWriteThread.Execute;
var
msg: TMsg;
dwHandleSignaled: DWORD;
overlappedWrite: TOverLapped;
CompleteOneWriteRequire : Boolean;
label
EndWriteThread;
begin
// Needed for overlapped I/O.
FillChar( overlappedWrite, SizeOf(overlappedWrite), 0 ); {0, 0, 0, 0, NULL}

overlappedWrite.hEvent := CreateEvent( nil, True, True, nil );
if overlappedWrite.hEvent = 0 then
begin
PostHangupCall;
goto EndWriteThread
end;

CompleteOneWriteRequire := True;

// This is the main loop. Loop until we break out.
while True do
begin
if not PeekMessage( msg, 0, 0, 0, PM_REMOVE ) then
begin
// If there are no messages pending, wait for a message or
// the CloseEvent.

pFSendDataEmpty^ := True;

if CompleteOneWriteRequire then
begin
if not PostMessage( hComm32Window, PWM_SENDDATAEMPTY, 0, 0 ) then
begin
PostHangupCall;
goto EndWriteThread
end
end;

CompleteOneWriteRequire := False;

dwHandleSignaled := MsgWaitForMultipleObjects(1, hCloseEvent, False,
INFINITE, QS_ALLINPUT);

case dwHandleSignaled of
WAIT_OBJECT_0: // CloseEvent signaled!
begin
// Time to exit.
goto EndWriteThread
end;

WAIT_OBJECT_0 + 1: // New message was received.
begin
// Get the message that woke us up by looping again.
Continue
end;

WAIT_FAILED: // Wait failed. Shouldn't happen.
begin
PostHangupCall;
goto EndWriteThread
end

else // This case should never occur.
begin
PostHangupCall;
goto EndWriteThread
end
end
end;

// Make sure the CloseEvent isn't signaled while retrieving messages.
if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
goto EndWriteThread;

// Process the message.
// This could happen if a dialog is created on this thread.
// This doesn't occur in this sample, but might if modified.
if msg.hwnd <> 0{NULL} then
begin
TranslateMessage(msg);
DispatchMessage(msg);
Continue
end;

// Handle the message.
case msg.message of
PWM_COMMWRITE: // New string to write to Comm port.
begin
// Write the string to the comm port. HandleWriteData
// does not return until the whole string has been written,
// an error occurs or until the CloseEvent is signaled.
if not HandleWriteData( @overlappedWrite,
PChar(msg.lParam), DWORD(msg.wParam) ) then
begin
// If it failed, either we got a signal to end or there
// really was a failure.

LocalFree( HLOCAL(msg.lParam) );
goto EndWriteThread
end;
CompleteOneWriteRequire := True;
// Data was sent in a LocalAlloc()d buffer. Must free it.
LocalFree( HLOCAL(msg.lParam) );
pFSendDataEmpty^ := True;
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
SetLastError(ERROR_SUCCESS);
// 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;
if (dwNumberOfBytesToWrite)<>dwNumberOfBytesWritten then
begin
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.
if(dwNumberOfBytesToWrite=dwNumberOfBytesWritten) then
begin
Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten )
end
else
begin
PostHangupCall;
Exit;
end;
until (dwNumberOfBytesToWrite <= 0); // Write the whole thing!

// Wrote the whole string.
Result := True
end; {TWriteThread.HandleWriteData}

procedure TWriteThread.PostHangupCall;
begin
PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

procedure Register;
begin
RegisterComponents('System', [TComm])
end;

end.


¶þ¡¢µ÷ÓÃ

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,SPComm, Vcl.StdCtrls, Vcl.ExtCtrls;

type
TForm1 = class(TForm)
Splitter1: TSplitter;
pnlCommand: TPanel;
btnOpen: TButton;
btnClose: TButton;
btnSend: TButton;
grpReceived: TGroupBox;
mmoReceived: TMemo;
grpSend: TGroupBox;
mmoSend: TMemo;
grpError: TGroupBox;
MmoError: TMemo;
grpComSetting: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
cmbCommName: TComboBox;
cmbBaudrate: TComboBox;
cmbDatabits: TComboBox;
cmbStopbits: TComboBox;
cmbParity: TComboBox;
procedure btnOpenClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CreateCommPorts;
private
FComm: TComm;
function GetByteSize(AIndex: Integer): TByteSize;
function GetParity(AIndex: Integer): TParity;

function GetStopBits(AIndex: Integer): TStopBits;
procedure ReceiveError(Sender: TObject; EventMask: DWORD);
procedure ReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
procedure ToggleEnabled;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function TForm1.GetByteSize(AIndex: Integer): TByteSize;
begin
Result := _8;
case AIndex of
0: Result := _5;
1: Result := _6;
2: Result := _7;
3: Result := _8;
end;
end;
function TForm1.GetParity(AIndex: Integer): TParity;
begin
Result := None;
case AIndex of
0: Result := None;
1: Result := Odd;
2: Result := Even;
end;
end;

function TForm1.GetStopBits(AIndex: Integer): TStopBits;
begin
Result := _1;
case AIndex of
0: Result := _1;
1: Result := _1_5;
2: Result := _2;
end;
end;
procedure TForm1.ReceiveError(Sender: TObject; EventMask: DWORD);
var
S: string;
begin
with MmoError do
begin
Lines.Add(Format('OnReceiveError: EventMask=%d', [EventMask]));

S := '';
case EventMask of
CE_BREAK: // Ó²¼þ¼ì²âµ½ÓиöÖÕ¶ËÌõ¼þ. (ÏÖÔÚ²»Ö§³ÖÁË)
S := 'Ó²¼þ¼ì²âµ½ÓиöÖÕÖ¹Ìõ¼þ.';
CE_DNS: // ½öÓÃÓÚwin95: ûÓÐÑ¡ÔñÏàÓ¦µÄÇý¶¯.
S := '½öÓÃÓÚwin95: ûÓÐÑ¡ÔñÏàÓ¦µÄÇý¶¯.';
CE_FRAME: // ¼ì²âµ½ÓиöÕì²î´í.
S := '¼ì²âµ½ÓиöÕì²î´í.';
CE_IOE: // É豸ͨÐÅÖгöÏÖÒ»¸öI/O´íÎó.
S := 'É豸ͨÐÅÖгöÏÖÒ»¸öI/O´íÎó.';
CE_MODE: // ÒªÇóµÄģʽ²»Ö§³Ö, »òhFile ¾ä±úµÄ²ÎÊýÊÇ·Ç·¨µÄ¡£
S := 'ÒªÇóµÄģʽ²»Ö§³Ö, »òhFile ¾ä±úµÄ²ÎÊýÊÇ·Ç·¨µÄ¡£';
CE_OOP: // ½öÓÃÓÚwin95: ÏàÓ¦µÄÇý¶¯³¬³öÁËÎļþµÄ·¶Î§¡£
S := '½öÓÃÓÚwin95: ÏàÓ¦µÄÇý¶¯³¬³öÁËÎļþµÄ·¶Î§¡£';
CE_OVERRUN: // »º³åÇø×Ö·ûÒç³ö£¬ÓÐÊý¾Ý¶ªÊ§¡£
S := '»º³åÇø×Ö·ûÒç³ö£¬ÓÐÊý¾Ý¶ªÊ§¡£';
CE_PTO: // ½öÓÃÓÚwin95: ÓÐÏàÓ¦É豸ʹÓÃʱ¼äʼþ³¬Ê±.
S := '½öÓÃÓÚwin95: ÓÐÏàÓ¦É豸ʹÓÃʱ¼äʼþ³¬Ê±.';
CE_RXOVER: // ÊäÈ뻺³åÇø×Ö·ûÒç³ö£¬»òÔÚÊÕµ½Îļþ½ÓÊÕ½áÊø±íʾ·ûºó£¬ÓÖ½Óµ½×Ö·û¡£
S := 'ÊäÈ뻺³åÇø×Ö·ûÒç³ö£¬»òÔÚÊÕµ½Îļþ½ÓÊÕ½áÊø±íʾ·ûºó£¬ÓÖ½Óµ½×Ö·û¡£';
CE_RXPARITY: // Ææż¼ìÑé´íÎó¡£
S := 'Ææż¼ìÑé´íÎó¡£';
CE_TXFULL: // ÔÚÊä³ö»º³åÇøÒÑÂúµÄÇé¿öÏ£¬³¢ÊÔÊä³ö×Ö·û¡£
S := 'ÔÚÊä³ö»º³åÇøÒÑÂúµÄÇé¿öÏ£¬³¢ÊÔÊä³ö×Ö·û¡£';
end;

if (S <> '') then Lines.Add(' ' + S);
end;
end;
procedure TForm1.ReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
var
S: AnsiString;
begin
SetLength(S, BufferLength);
Move(Buffer^, PAnsiChar(S)^, BufferLength);

mmoReceived.Lines.Add(S);
end;
procedure TForm1.ToggleEnabled;
var
ACanSend: Boolean;
begin
ACanSend := FComm.Connected;

grpComSetting.Enabled := not ACanSend;
btnOpen.Enabled := not ACanSend;
btnClose.Enabled := ACanSend;
btnSend.Enabled := ACanSend;
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
with FComm do
begin
StopComm;
end;

ToggleEnabled;
end;

procedure TForm1.btnOpenClick(Sender: TObject);
begin
with FComm do
begin
try
CommName := cmbCommName.Text;
Parity := GetParity(cmbParity.ItemIndex);
StopBits := GetStopBits(cmbStopbits.ItemIndex);
ByteSize := GetByteSize(cmbDatabits.ItemIndex);
BaudRate := StrToIntDef(cmbBaudrate.Text, 9600);
ParityCheck := True;

OnReceiveError := ReceiveError;
OnReceiveData := ReceiveData;

StopComm;
StartComm;

ToggleEnabled;
except
on E: Exception do
begin
mmoError.Lines.Add(E.Message)
end;
end;
end;

end;
procedure TForm1.CreateCommPorts;
var
I: Integer;
begin
with cmbCommName do
begin
Items.Clear;
for I := 1 to 254 do
Items.Add(Format('COM%d:', [I]));

ItemIndex := 0;
end;
end;
procedure TForm1.btnSendClick(Sender: TObject);
var
S: AnsiString;
begin
S := mmoSend.text;

FComm.WriteCommData(@S[1], length(S));

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
mmoSend.Clear;
MmoError.Clear;
mmoReceived.Clear;
FComm := TComm.Create(nil);
CreateCommPorts;

ToggleEnabled;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FComm);
end;

end.


¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡ ²é¿´ÆÀÂÛ »Ø¸´