spcomm258.pas

spcomm串口编程

     end;

     // Create the Read thread.
     try
        ReadThread := TReadThread.Create( True {suspended} );
     except
           ReadThread := nil;
           CloseHandle( hCloseEvent );
           CloseHandle( hCommFile );
           hCommFile := 0;
           FPortOpenError := 'Unable to create read thread';
//           raise ECommsError.Create( FPortOpenError );
           Exit;
     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;
           FPortOpenError := 'Unable to create write thread';
//           raise ECommsError.Create( FPortOpenError );
           Exit;
     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.
     FPortOpenError := '';
     FPortOpen := false;
     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 );
          if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
                                WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
          begin
               FSendDataEmpty := False;
               Result := True;
               Exit
          end
     end;

     Result := False
end; {TComm.WriteCommData}

procedure TComm.SetOutput( Buffer: variant );
begin
  FOutput := Buffer;
  WriteCommData(PChar(string(FOutput)), Length(PChar(string(FOutput))));
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
//    that doesn't get closed.  This isn't worth worrying about
//    since it shouldn't happen anyway.
//
//
procedure TComm.CloseReadThread;
begin
     // If it exists...
     if ReadThread <> nil then
     begin
          // Signal the event to close the worker threads.
          SetEvent( hCloseEvent );

          // Purge all outstanding reads
          PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR );

          // Wait 10 seconds for it to exit.  Shouldn't happen.
          if (WaitForSingleObject(ReadThread.Handle, 10000) = WAIT_TIMEOUT) then
             ReadThread.Terminate;
          ReadThread.Free;
          ReadThread := nil
     end
end; {TComm.CloseReadThread}

//
//  FUNCTION: CloseWriteThread
//
//  PURPOSE: Closes the Write Thread.
//
//  PARAMETERS:
//    none
//
//  RETURN VALUE:
//    none
//
//  COMMENTS:
//
//    Closes the write thread by signaling the CloseEvent.
//    Purges any outstanding writes on the comm port.
//
//    Note that terminating a thread leaks memory.
//    Besides the normal leak incurred, there is an event object
//    that doesn't get closed.  This isn't worth worrying about
//    since it shouldn't happen anyway.
//
//
procedure TComm.CloseWriteThread;
begin
     // If it exists...
     if WriteThread <> nil then
     begin
          // Signal the event to close the worker threads.
          SetEvent(hCloseEvent);

          // Purge all outstanding writes.
          PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
          FSendDataEmpty := True;

          // Wait 10 seconds for it to exit.  Shouldn't happen.
          if WaitForSingleObject( WriteThread.Handle, 10000 ) = WAIT_TIMEOUT then
             WriteThread.Terminate;
          WriteThread.Free;
          WriteThread := nil
     end
end; {TComm.CloseWriteThread}

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

procedure TComm.ReceiveError( EvtMask : DWORD );
begin
     if Assigned(FOnReceiveError) then
        FOnReceiveError( self, EvtMask )
end;

procedure TComm.ModemStateChange( ModemEvent : DWORD );
begin
     if Assigned(FOnModemStateChange) then
        FOnModemStateChange( self, ModemEvent )
end;

procedure TComm.RequestHangup;
begin
     if Assigned(FOnRequestHangup) then
        FOnRequestHangup( Self )
end;

procedure TComm._SendDataEmpty;
begin
     if Assigned(FOnSendDataEmpty) then
        FOnSendDataEmpty( self )
end;

(******************************************************************************)
//  TComm PRIVATE METHODS
(******************************************************************************)

procedure TComm.CommWndProc( var msg: TMessage );
begin
     case msg.msg of
          PWM_GOTCOMMDATA:
          begin
               ReceiveData( PChar(msg.LParam), msg.WParam );
               LocalFree( msg.LParam )
          end;
          PWM_RECEIVEERROR:    ReceiveError( msg.LParam );
          PWM_MODEMSTATECHANGE:ModemStateChange( msg.LParam );
          PWM_REQUESTHANGUP:   RequestHangup;
          PWM_SENDDATAEMPTY:   _SendDataEmpty
     end
end;

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

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

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

     dcb.BaudRate := FBaudRate;

     dcb.Flags := 1;         // Enable fBinary

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

     // setup hardware flow control

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

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

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

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

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

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

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

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

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

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

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

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

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

     dcb.ErrorChar := FReplacedChar;

     SetCommState( hCommFile, dcb )