spcomm.pas

DELPHI串口通讯程序

          if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
                                WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
          begin
               FSendDataEmpty := False;
               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
     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 )
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;