comm32.pas

一个比较好的串口控件(delphi 7.0)

			RequestHangup;
	end;
end;

function TComm32.GetReceiveDataEvent: TReceiveDataEvent;
begin
	Result := FOnReceiveData;
end;

procedure TComm32.SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
begin
	FOnReceiveData := AReceiveDataEvent;
end;

function TComm32.GetRequestHangupEvent: TNotifyEvent;
begin
	Result := FOnRequestHangup;
end;

procedure TComm32.SetRequestHangupEvent( ARequestHangupEvent: TNotifyEvent );
begin
	FOnRequestHangup := ARequestHangupEvent;
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
		 LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
		 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
		 LogDebugLastError( GetLastError, 'Unable to CreateEvent: ' );
		 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) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetCommMask: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// Start waiting for CommEvents (Errors)
	if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetupCommEvent1: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// Start waiting for Read events.
	if not SetupReadEvent( @overlappedRead,
					szInputBuffer, INPUTBUFFERSIZE,
					 nNumberOfBytesRead ) then
	begin
		LogDebugLastError( GetLastError, 'Unable to SetupReadEvent: ' );
		PostHangupCall;
		goto EndReadThread;
	end;

	// 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.
				OutputDebugString( 'Time to Exit' );
				goto EndReadThread;
			end;

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

				// Start waiting for the next CommEvent.
				if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
				begin
					PostHangupCall;
					LogDebugLastError( GetLastError, 'Unable to SetupCommEvent2: ' );
					goto EndReadThread;
				end;
				{break;??}
			end;

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

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

			WAIT_FAILED:       // Wait failed.  Shouldn't happen.
			begin
				LogDebugLastError( GetLastError, 'Read WAIT_FAILED: ' );
				PostHangupCall;
				goto EndReadThread;
			end;

			else    // This case should never occur.
			begin
				LogDebugInfo( PChar('Unexpected Wait return value '+
							IntToStr(dwHandleSignaled)) );
				PostHangupCall;
				goto EndReadThread;
			end;
		end; {case dwHandleSignaled}
	end; {while True}

	// Time to clean up Read Thread.
 EndReadThread:

	LogDebugInfo( 'Read thread shutting down' );
	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

StartSetupReadEvent:

	Result := False;
	// 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.

		LogDebugInfo( 'Data waiting for ReadFile: ');

		 // 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
		 LogDebugInfo( 'Waiting for data from comm connection.' );
		 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
	begin
		 LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
			  'Likely that the Service Provider has closed the port.' );
		 Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
	LogDebugLastError( dwLastError, 'Unexpected ReadFile error: ' );

	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;
	tempstr:				string;
begin
	Result := False;
	 // If we got data and didn't just time out empty...
	if dwSizeofBuffer <> 0 then
	begin
		tempstr := lpszInputBuffer;

		  // Do something with the bytes read.
		LogDebugInfo( 'Got something from Comm port!!!' );

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

		if lpszPostedBytes = nil{NULL} then
		begin
			LogDebugLastError( GetLastError, 'LocalAlloc: ' );
			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
	begin
		LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
				'Likely that the Service Provider has closed the port.' );
		Exit;
	end;

	LogDebugLastError( dwLastError,
		  'Unexpected GetOverlappedResult Read Error: ' );

	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.

		LogDebugInfo( 'Event (Error) waiting before WaitCommEvent.' );

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

		// 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
		LogDebugInfo( 'Waiting for a CommEvent (Error) to occur.' );
		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
	begin
		LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
				'Likely that the Service Provider has closed the port.' );
		Exit;
	end;

	// Unexpected error. No idea what could cause this to happen.
	LogDebugLastError( dwLastError, 'Unexpected WaitCommEvent error: ' );
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: