cpdrv.pas

d3k软件公司 对串行I/O口进行操作的软件 封装所有底层系统编程

    Result := Win32BaudRates[ bRate ];
end;

function DelayForRX( bRate: TBaudRate; DataSize: DWORD ): DWORD;
begin
  Result := round( DataSize / (BaudRateOf(bRate) / 10) * 1000 );
end;

constructor TCommPortDriver.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  // Initialize to default values -----------------------
  // Not connected
  FHandle                    := INVALID_HANDLE_VALUE;
  // COM 2
  FPort                      := pnCOM2;
  FPortName                  := '\\.\COM2';
  // 9600 bauds
  FBaudRate                  := br9600;
  FBaudRateValue             := BaudRateOf( br9600 );
  // 8 data bits
  FDataBits                  := db8BITS;
  // 1 stop bit
  FStopBits                  := sb1BITS;
  // no parity
  FParity                    := ptNONE;
  // No hardware flow control but RTS on
  FHwFlow                    := hfNONERTSON;
  // No software flow control
  FSwFlow                    := sfNONE;
  // Input buffer of 2048 bytes
  FInBufSize                 := 2048;
  // Output buffer of 2048 bytes
  FOutBufSize                := 2048;
  // Don't pack data
  FPacketSize                := -1;
  // Packet timeout disabled 
  FPacketTimeout             := -1;
  // Discard incomplete packets
  FPacketMode                := pmDiscard;
  // Poll COM port every 50ms
  FPollingDelay              := 50;
  // Output timeout of 500ms
  FOutputTimeout             := 500;
  // Timeout for ReadData(), 200ms
  FInputTimeout              := 200;
  // DTR high on connect
  FEnableDTROnOpen           := true;
  // Time not valid ( used by the packing routines )
  FFirstByteOfPacketTime     := DWORD(-1);
  // Don't check of off-line devices
  FCkLineStatus              := false;
  // Init number of RX polling timer pauses - not paused
  FRXPollingPauses := 0;
  // Temporary buffer for received data 
  FTempInBuffer := AllocMem( FInBufSize );
  // Allocate a window handle to catch timer's notification messages
  if not (csDesigning in ComponentState) then
    FNotifyWnd := AllocateHWnd( TimerWndProc );
end;

destructor TCommPortDriver.Destroy;
begin
  // Be sure to release the COM port
  Disconnect;
  // Free the temporary buffer
  FreeMem( FTempInBuffer, FInBufSize );
  // Destroy the timer's window
  if not (csDesigning in ComponentState) then
    DeallocateHWnd( FNotifyWnd );
  // Call inherited destructor
  inherited Destroy;
end;

// The COM port handle made public and writeable.
// This lets you connect to external opened com port.
// Setting ComPortHandle to INVALID_PORT_HANDLE acts as Disconnect.
procedure TCommPortDriver.SetHandle( Value: HFILE );
begin
  // If same COM port then do nothing
  if FHandle = Value then
    exit;
  // If value is RELEASE_NOCLOSE_PORT then stop controlling the COM port
  // without closing in
  if Value = RELEASE_NOCLOSE_PORT then
  begin
    // Stop the timer
    if Connected then
      KillTimer( FNotifyWnd, 1 );
    // No more connected 
    FHandle := INVALID_HANDLE_VALUE;
  end
  else
  begin
    // Disconnect
    Disconnect;
    // If Value is INVALID_HANDLE_VALUE then exit now
    if Value = INVALID_HANDLE_VALUE then
      exit;
    // Set COM port handle
    FHandle := Value;
    // Start the timer ( used for polling )
    SetTimer( FNotifyWnd, 1, FPollingDelay, nil );
  end;
end;

// Selects the COM port to use
procedure TCommPortDriver.SetPort( Value: TPortNumber );
begin
  // Be sure we are not using any COM port
  if Connected then
    exit;
  // Change COM port
  FPort := Value;
  // Update the port name
  if FPort <> pnCustom then
    FPortName := Format( '\\.\COM%d', [ord(FPort)] );
end;

// Sets the port name
procedure TCommPortDriver.SetPortName( Value: string );
begin
  // Be sure we are not using any COM port
  if Connected then
    exit;
  // Change COM port
  FPort := pnCustom;
  // Update the port name
  FPortName := Value;
end;

// Selects the baud rate
procedure TCommPortDriver.SetBaudRate( Value: TBaudRate );
begin
  // Set new COM speed
  FBaudRate := Value;
  if FBaudRate <> brCustom then
    FBaudRateValue := BaudRateOf( FBaudRate );
  // Apply changes
  if Connected then
    ApplyCOMSettings;
end;

// Selects the baud rate ( actual baud rate value )
procedure TCommPortDriver.SetBaudRateValue( Value: DWORD );
begin
  // Set new COM speed
  FBaudRate := brCustom;
  FBaudRateValue := Value;
  // Apply changes
  if Connected then
    ApplyCOMSettings;
end;

// Selects the number of data bits
procedure TCommPortDriver.SetDataBits( Value: TDataBits );
begin
  // Set new data bits
  FDataBits := Value;
  // Apply changes 
  if Connected then
    ApplyCOMSettings;
end;

// Selects the number of stop bits
procedure TCommPortDriver.SetStopBits( Value: TStopBits );
begin
  // Set new stop bits
  FStopBits := Value;
  // Apply changes 
  if Connected then
    ApplyCOMSettings;
end;

// Selects the kind of parity
procedure TCommPortDriver.SetParity( Value: TParity );
begin
  // Set new parity
  FParity := Value;
  // Apply changes 
  if Connected then
    ApplyCOMSettings;
end;

// Selects the kind of hardware flow control
procedure TCommPortDriver.SetHwFlowControl( Value: THwFlowControl );
begin
  // Set new hardware flow control
  FHwFlow := Value;
  // Apply changes 
  if Connected then
    ApplyCOMSettings;
end;

// Selects the kind of software flow control
procedure TCommPortDriver.SetSwFlowControl( Value: TSwFlowControl );
begin
  // Set new software flow control
  FSwFlow := Value;
  // Apply changes 
  if Connected then
    ApplyCOMSettings;
end;

// Sets the RX buffer size
procedure TCommPortDriver.SetInBufSize( Value: DWORD );
begin
  // Do nothing if connected
  if Connected then
    exit;
  // Free the temporary input buffer
  FreeMem( FTempInBuffer, FInBufSize );
  // Set new input buffer size
  if Value > 8192 then
    Value := 8192
  else if Value < 128 then
    Value := 128;
  FInBufSize := Value;
  // Allocate the temporary input buffer
  FTempInBuffer := AllocMem( FInBufSize );
  // Adjust the RX packet size
  SetPacketSize( FPacketSize );
end;

// Sets the TX buffer size
procedure TCommPortDriver.SetOutBufSize( Value: DWORD );
begin
  // Do nothing if connected
  if Connected then
    exit;
  // Set new output buffer size
  if Value > 8192 then
    Value := 8192
  else if Value < 128 then
    Value := 128;
  FOutBufSize := Value;
end;

// Sets the size of incoming packets
procedure TCommPortDriver.SetPacketSize( Value: smallint );
begin
  // PackeSize <= 0 if data isn't to be 'packetized'
  if Value <= 0 then
    FPacketSize := -1
  // If the PacketSize if greater than then RX buffer size then
  // increase the RX buffer size
  else if DWORD(Value) > FInBufSize then
  begin
    FPacketSize := Value;
    SetInBufSize( FPacketSize );
  end;
end;

// Sets the timeout for incoming packets
procedure TCommPortDriver.SetPacketTimeout( Value: integer );
begin
  // PacketTimeout <= 0 if packet timeout is to be disabled
  if Value < 1 then
    FPacketTimeout := -1
  // PacketTimeout cannot be less than polling delay + some extra ms 
  else if Value < FPollingDelay then
    FPacketTimeout := FPollingDelay + (FPollingDelay*40) div 100;
end;

// Sets the delay between polling checks
procedure TCommPortDriver.SetPollingDelay( Value: word );
begin
  // Make it greater than 4 ms
  if Value < 5 then
    Value := 5;
  // If new delay is not equal to previous value...
  if Value <> FPollingDelay then
  begin
    // Stop the timer 
    if Connected then
      KillTimer( FNotifyWnd, 1 );
    // Store new delay value
    FPollingDelay := Value;
    // Restart the timer
    if Connected then
      SetTimer( FNotifyWnd, 1, FPollingDelay, nil );
    // Adjust the packet timeout 
    SetPacketTimeout( FPacketTimeout );
  end;
end;

// Apply COM settings 
function TCommPortDriver.ApplyCOMSettings: boolean;
var dcb: TDCB;
begin
  // Do nothing if not connected
  Result := false;
  if not Connected then
    exit;

  // ** Setup DCB (Device Control Block) fields ******************************

  // Clear all
  fillchar( dcb, sizeof(dcb), 0 );
  // DCB structure size
  dcb.DCBLength := sizeof(dcb);
  // Baud rate
  dcb.BaudRate := FBaudRateValue;
  // Set fBinary: Win32 does not support non binary mode transfers
  // (also disable EOF check) 
  dcb.Flags := dcb_Binary;
  // Enables the DTR line when the device is opened and leaves it on 
  if EnableDTROnOpen then
    dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
  // Kind of hw flow control to use
  case FHwFlow of
    // No hw flow control
    hfNONE:;
    // No hw flow control but set RTS high and leave it high
    hfNONERTSON:
      dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
    // RTS/CTS (request-to-send/clear-to-send) flow control
    hfRTSCTS:
      dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake;
  end;
  // Kind of sw flow control to use
  case FSwFlow of
    // No sw flow control
    sfNONE:;
    // XON/XOFF sw flow control
    sfXONXOFF:
      dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
  end;
  // Set XONLim: specifies the minimum number of bytes allowed in the input
  // buffer before the XON character is sent (or CTS is set). 
  if (GetWinPlatform = 'WNT') and (GetWinVersion >= $00040000) then
  begin
    // WinNT 4.0 + Service Pack 3 needs XONLim to be less than or
    // equal to 4096 bytes. Win95/98 doesn't have such limit. 
    if FInBufSize div 4 > 4096 then
      dcb.XONLim := 4096
    else
      dcb.XONLim := FInBufSize div 4;
  end
  else
    dcb.XONLim := FInBufSize div 4;
  // Specifies the maximum number of bytes allowed in the input buffer before
  // the XOFF character is sent (or CTS is set low). The maximum number of bytes
  // allowed is calculated by subtracting this value from the size, in bytes, of
  // the input buffer.
  dcb.XOFFLim := dcb.XONLim;
  // How many data bits to use
  dcb.ByteSize := 5 + ord(FDataBits);
  // Kind of parity to use
  dcb.Parity := ord(FParity);
  // How many stop bits to use
  dcb.StopBits := ord(FStopbits);
  // XON ASCII char - DC1, Ctrl-Q, ASCII 17
  dcb.XONChar := #17;
  // XOFF ASCII char - DC3, Ctrl-S, ASCII 19
  dcb.XOFFChar := #19;

  // Apply new settings
  Result := SetCommState( FHandle, dcb );
  if not Result then
    exit;
  // Flush buffers
  Result := FlushBuffers( true, true );
  if not Result then
    exit;
  // Setup buffers size
  Result := SetupComm( FHandle, FInBufSize, FOutBufSize );
end;

function TCommPortDriver.Connect: boolean;
var tms: TCOMMTIMEOUTS;
begin
  // Do nothing if already connected
  Result := Connected;
  if Result then
    exit;
  // Open the COM port
  FHandle := CreateFile( pchar(FPortName),
                         GENERIC_READ or GENERIC_WRITE,