mycomm32.pas

windows 下的多线程串口通讯组件。纯delphi源代码

  CloseReadThread;
  CloseWriteThread;
  //------ 通知结束通讯-------//
  CloseHandle( hCloseEvent );
  //------关闭设备端口--------//
  CloseHandle( hCommFile );
  hCommFile := 0;
  if fCommsLogFileName <> '' then  //---关闭登记文件----//
    CloseFile( CommsLogFile );
end; {TMyComport.StopComm}

function TMyComport.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
  Buffer:	Pointer;
begin
  if WriteThread <> nil then
    begin
     	Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
     	Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
     	if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
     		 WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
        begin
	     	  Result := true;
	   	    Exit;
	      end
      else //消息没有发送成功，必须释放分配的内存
        begin
	        LogDebugInfo( Pchar(TimetoStr(Time)+' 不能给Write thread发送消息!'));
          LocalFree(HLOCAL(Buffer));
        end;
    end
  else
     LogDebugInfo( Pchar(TimetoStr(Time)+' 没有创建Write thread'));
  Result := False;
end; {TMyComport.WriteCommData}

(**************************************************************)
//	   TMyComport PROTECTED METHODS
(**************************************************************)

procedure TMyComport.CloseReadThread;
begin
  if ReadThread <> nil then
    begin
      LogDebugInfo(Pchar(TimetoStr(Time)+' 关闭Read Thread'));
      // 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
        begin
     	    LogDebugInfo( Pchar(TimetoStr(Time)+' Read thread不再存在.关闭它'));
     	    ReadThread.Terminate;
        end;
      ReadThread.Free;
      ReadThread := nil;
    end;
end; {TMyComport.CloseReadThread}

procedure TMyComport.CloseWriteThread;
begin
  if WriteThread <> nil then
    begin
     	LogDebugInfo( Pchar(TimetoStr(Time)+' 关闭Write Thread'));
     	// Signal the event to close the worker threads.
     	SetEvent(hCloseEvent);
     	// Purge all outstanding writes.
     	PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
     	// Wait 10 seconds for it to exit.  Shouldn't happen.
     	if WaitForSingleObject(WriteThread.Handle,10000)=WAIT_TIMEOUT then
        begin
	        LogDebugInfo( Pchar(TimetoStr(Time)+' Write thread不再存在.关闭它'));
	        WriteThread.Terminate;
        end;
	    WriteThread.Free;
      WriteThread := nil;
    end;
end; {TMyComport.CloseWriteThread}

procedure TMyComport.ReceiveData( Buffer: PChar; BufferLength: Word );
begin
  if Assigned(FOnReceiveData) then
    FOnReceiveData( Buffer, BufferLength );
end;


(**************************************************************)
//  	TMyComport PRIVATE METHODS
(**************************************************************)
procedure TMyComport.SetCommsLogFileName( LogFileName: string );
begin
  CommsLogName := LogFileName;
  FCommsLogFileName := LogFileName;
end;

procedure TMyComport.CommWndProc( var msg: TMessage );
begin
  case msg.msg of
    PWM_GOTCOMMDATA:
  	  begin
  	    ReceiveData( PChar(msg.LParam), msg.WParam );
	      LocalFree( msg.LParam );
      end;
  end;
end;

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

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

(***********************************************************)
//  	READ THREAD
(***********************************************************)
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);//Signaled
  //??overlappedRead.hEvent :=CreateEvent(nil,True,False,nil);//nonsignaled
  if overlappedRead.hEvent = 0 then
    begin
      LogDebugInfo('不能创建overlappedRead事件');
      goto EndReadThread;
    end;
  // Put an event for the CommEvent overlapped structure.
  overlappedCommEvent.hEvent := CreateEvent( nil, True, True, nil);
  //??overlappedCommEvent.hEvent :=CreateEvent(nil,True,False,nil);
  if overlappedCommEvent.hEvent = 0 then
    begin
      LogDebugInfo('不能创建overlappedComm事件');
      goto EndReadThread;
    end;
  // We will be waiting on these objects.
  HandlesToWaitFor[0] := hCloseEvent;
  HandlesToWaitFor[1] := overlappedCommEvent.hEvent;
  HandlesToWaitFor[2] := overlappedRead.hEvent;
 	LogDebugInfo(Pchar(TimetoStr(Time)+' Begin Execute ReadTread'));
  // Setup CommEvent handling.
  // Set the comm mask so we receive error signals.
  if not SetCommMask(hCommFile, EV_ERR) then
    begin
      LogDebugInfo('不能SetCommMask: ' );
      goto EndReadThread;
    end;
  // Start waiting for CommEvents (Errors)
  if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
    begin
      LogDebugInfo('不能设置通讯事件SetupCommEvent1: ' );
      goto EndReadThread;
    end;
  // Start waiting for Read events.
  if not SetupReadEvent( @overlappedRead,
  			 szInputBuffer, INPUTBUFFERSIZE,
  			 nNumberOfBytesRead ) then
    begin
      LogDebugInfo('Unable to SetupReadEvent: ' );
      goto EndReadThread;
    end;
  // Keep looping until we break out.
 	LogDebugInfo(Pchar(TimetoStr(Time)+' Set Read Thread OK'));
  while True do
    begin//Wait until some event occurs (data to read; error; stopping).
    	LogDebugInfo(Pchar(TimetoStr(Time)+' Begin Wait 3 Read Events'));
      dwHandleSignaled :=WaitForMultipleObjects(3, @HandlesToWaitFor,
				                False, INFINITE);
      // Which event occured?
     	LogDebugInfo(Pchar(TimetoStr(Time)+' Wait A ReadThread Event OK'));
      case dwHandleSignaled of
	      WAIT_OBJECT_0:    // Signal to end the thread.
	        begin    	      // Time to exit.
		        OutputDebugString(' Time to Exit Read' );
		        goto EndReadThread;
          end;
        WAIT_OBJECT_0 + 1: // CommEvent signaled.
	        begin            // Handle the CommEvent.
		        if not HandleCommEvent(@overlappedCommEvent,fdwEvtMask,TRUE) then
              begin
                LogDebugInfo('Unable HandleCommEvent: ');
		            goto EndReadThread;
              end;
		        // Start waiting for the next CommEvent.
		        if not SetupCommEvent( @overlappedCommEvent,  fdwEvtMask ) then
		          begin
		            LogDebugInfo('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
		            LogDebugInfo('不能处理ReadEvent: ');
      		      goto EndReadThread;
              end;
		        // Wait for more new data.
		        if not SetupReadEvent( @overlappedRead, szInputBuffer,
                    INPUTBUFFERSIZE, nNumberOfBytesRead ) then
              begin
		            goto EndReadThread;
              end;
		        {break;}
          end;
        WAIT_FAILED: // Wait failed.  Shouldn't happen.
          begin
	      	  LogDebugInfo('Read WAIT_FAILED: ' );
		        goto EndReadThread;
          end;
	    else    // This case should never occur.
        begin
	      	LogDebugInfo( PChar('Unexpected Wait return value '+
				                IntToStr(dwHandleSignaled)) );
		      goto EndReadThread;
        end;
      end; {End case dwHandleSignaled}
    end; {while True}
  // Time to clean up Read Thread.
EndReadThread:
  LogDebugInfo(Pchar(TimetoStr(Time)+' Read thread shutting down'));
  PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR );
  CloseHandle( overlappedRead.hEvent );
  CloseHandle( overlappedCommEvent.hEvent );
end; {TReadThread.Execute}

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( Pchar(TimetoStr(Time)+' Some 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( Pchar(TimetoStr(Time)+' SetupReadEvent OK,Wait for Read Data.'));
	    Result := True;
	    Exit;
    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.
  LogDebugInfo('In SetupReadEvent,Unexpected ReadFile error: ');
end; {TReadThread.SetupReadEvent}

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( Pchar(TimetoStr(Time)+' HandleReadData OK,Got something from Comm port!!!'));
	    lpszPostedBytes := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ));
	    if lpszPostedBytes = nil then
	      begin
	        LogDebugInfo('Errer LocalAlloc: ' );
	        Exit;
        end;
      Move(lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer );
      lpszPostedBytes[dwSizeofBuffer] := #0;
	    Result := ReceiveData( lpszPostedBytes, dwSizeofBuffer );
    end;
end; {TReadThread.HandleReadData}

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;
  if dwLastError = ERROR_INVALID_HANDLE then
    begin
      LogDebugInfo( 'In HandleReadEvent,ERROR_INVALID_HANDLE,'+
      		'Likely closed the port.' );
      Exit;
    end;
  LogDebugInfo('Unexpected GetOverlappedResult Read Error: ' );
end; {TReadThread.HandleReadEvent}

function TReadThread.SetupCommEvent( lpOverlappedCommEvent: POverlapped;
	 var lpfdwEvtMask: DWORD ): Boolean;
var
   dwLastError: DWORD;
label
   StartSetupCommEvent;
begin
  Result := False;
StartSetupCommEvent:
  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(Pchar(TimetoStr(Time)+' Event (Error) waiting before WaitCommEvent.'));
{??? GetOverlappedResult does not handle "NIL" as defined by Borland }
	    if not HandleCommEvent(nil,lpfdwEvtMask,False) then Exit;
      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(Pchar(TimetoStr(Time)+' SetupCommEvent Ok,Waiting for a CommEvent (Error) to occur.'));
	    Result := True;
	    Exit
    end;
  if dwLastError = ERROR_INVALID_HANDLE then
    begin
      LogDebugInfo( 'ERROR_INVALID_HANDLE, '+
	 	      'Likely closed the port.' );
	    Exit;
    end;
  // Unexpected error. No idea what could cause this to happen.
  LogDebugInfo('Unexpected WaitCommEvent error: ' );
end; {TReadThread.SetupCommEvent}

function TReadThread.HandleCommEvent( lpOverlappedCommEvent: POverlapped;
	 var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
var
	dwDummy:     DWORD;
	lpszOutput:  LPSTR;
	szError:     array[0..127] of Char;
	dwErrors,
//nOutput,
	dwLastError: DWORD;
begin
  Result := False;
  szError[0] := #0;
  lpszOutput := PChar(LocalAlloc( LPTR, 256 ));
  if lpszOutput = nil{NULL} then
    begin
      LogDebugInfo('LocalAlloc Error: ' );
      Exit;
    end;
  if fRetrieveEvent then
    if not GetOverlappedResult( hCommFile,