spcomm.pas.~8~

其中包含XPMenu控件和SPComm控件

** Author:    Administrator
** Date:      23-七月-2007
** Arguments: None
** Result:    None
** 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}


{****************************************************************************
** Procedure: CloseWriteThread
** Author:    Administrator
** Date:      23-七月-2007
** Arguments: None
** Result:    None
** 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.CloseRWThread;
begin
  CloseReadThread;
  CloseWriteThread;
end;

(****************************************************************************
 * 函数:   CreateAndStartRWThread(None);
 * 功能:   创建读写线程并启动.
 * 作者:   Administrator
 * 日期:   2007-09-25
 * 参数:   None
 * 返回值: None
 * 描述:
 ****************************************************************************)
procedure TComm.CreateAndStartRWThread;
begin
  // Create the Read thread.
  if ReadThread=nil then
  begin
    try
       ReadThread := TReadThread.Create( True {suspended} );
    except
          ReadThread := nil;
          CloseHandle( hCloseEvent );
          CloseHandle( hCommFile );
          hCommFile := 0;
          raise ECommsError.Create( 'Unable to create read thread' )
    end;
  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.
  if WriteThread=nil then
  begin
    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;
  end;
  WriteThread.hCommFile := hCommFile;
  WriteThread.hCloseEvent := hCloseEvent;
  WriteThread.hComm32Window := FHWnd;
  WriteThread.pFSendDataEmpty := @FSendDataEmpty;

  WriteThread.Priority := tpHigher;

  ReadThread.Resume;
  WriteThread.Resume;
end;

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;

(****************************************************************************
 * 函数:   _SetCommTimeout(None);
 * 功能:   
 * 作者:   Administrator
 * 日期:   2007-09-26
 * 参数:   None
 * 返回值: None
 * 描述:
    TCommTimeouts 结构参数意义:
      ReadIntervalTimeout：两字符之间最大的延时，当读取串口数据时，
        一旦两个字符传输的时间差超过该时间，读取函数将返回现有的数据。
        设置为0表示该参数不起作用。
      ReadTotalTimeoutMultiplier：读取每字符间的超时。
      ReadTotalTimeoutConstant：一次读取串口数据的固定超时。
      WriteTotalTimeoutMultiplier：写入每字符间的超时。
      WriteTotalTimeoutConstant：一次写入串口数据的固定超时。
  所以:
     在一次读取串口的操作中，其超时为ReadTotalTimeoutMultiplier乘以读取的字节数
  再加上 ReadTotalTimeoutConstant。将ReadIntervalTimeout设置为MAXDWORD，并将
  ReadTotalTimeoutMultiplier 和ReadTotalTimeoutConstant设置为0，表示读取操作将
  立即返回存放在输入缓冲区的字符。
    在一次写入串口的操作中，其超时为WriteTotalTimeoutMultiplier乘以写入的字节数
    再加上 WriteTotalTimeoutConstant。
 ****************************************************************************)
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