📄 cpdrv.pas
字号:
//------------------------------------------------------------------------
// UNIT : CPDrv.pas
// CONTENTS : TCommPortDriver component
// VERSION : 2.1
// TARGET : (Inprise's) Borland Delphi 4.0
// AUTHOR : Marco Cocco
// STATUS : Freeware
// INFOS : Implementation of TCommPortDriver component:
// - non multithreaded serial I/O
// KNOWN BUGS : none
// COMPATIBILITY : Windows 95/98/NT/2000
// REPLACES : TCommPortDriver v2.00 (Delphi 4.0)
// TCommPortDriver v1.08/16 (Delphi 1.0)
// TCommPortDriver v1.08/32 (Delphi 2.0/3.0)
// BACK/COMPAT. : partial - a lot of properties have been renamed
// RELEASE DATE : 06/06/2000
// (Replaces v2.0 released on 30/NOV/1998)
//------------------------------------------------------------------------
// FOR UPDATES : - sorry, no home page -
// BUGS REPORT : mail to : mcocco@libero.it
// or: ditrek@tiscalinet.it
//------------------------------------------------------------------------
//
// Copyright (c) 1996-2000 by Marco Cocco. All rights reseved.
// Copyright (c) 1996-2000 by d3k Software Company. All rights reserved.
//
//******************************************************************************
//* Permission to use, copy, modify, and distribute this software and its *
//* documentation without fee for any purpose is hereby granted, *
//* provided that the above copyright notice appears on all copies and that *
//* both that copyright notice and this permission notice appear in all *
//* supporting documentation. *
//* *
//* NO REPRESENTATIONS ARE MADE ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY *
//* PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. *
//* NEITHER MARCO COCCO OR D3K SHALL BE LIABLE FOR ANY DAMAGES SUFFERED BY *
//* THE USE OF THIS SOFTWARE. *
//******************************************************************************
unit CPDrv;
interface
uses
// Delphi units
Windows, Messages, SysUtils, Classes, Forms
// ComDrv32 units
;
//------------------------------------------------------------------------
// Property types
//------------------------------------------------------------------------
type
// Baud Rates (custom or 110...256k bauds)
TBaudRate = ( brCustom,
br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200, br128000, br256000 );
// Port Numbers ( custom or COM1..COM16 )
TPortNumber = ( pnCustom,
pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7,
pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13,
pnCOM14, pnCOM15, pnCOM16 );
// Data bits ( 5, 6, 7, 8 )
TDataBits = ( db5BITS, db6BITS, db7BITS, db8BITS );
// Stop bits ( 1, 1.5, 2 )
TStopBits = ( sb1BITS, sb1HALFBITS, sb2BITS );
// Parity ( None, odd, even, mark, space )
TParity = ( ptNONE, ptODD, ptEVEN, ptMARK, ptSPACE );
// Hardware Flow Control ( None, None + RTS always on, RTS/CTS )
THwFlowControl = ( hfNONE, hfNONERTSON, hfRTSCTS );
// Software Flow Control ( None, XON/XOFF )
TSwFlowControl = ( sfNONE, sfXONXOFF );
// What to do with incomplete (incoming) packets ( Discard, Pass )
TPacketMode = ( pmDiscard, pmPass );
//------------------------------------------------------------------------
// Event types
//------------------------------------------------------------------------
type
// RX event ( packet mode disabled )
TReceiveDataEvent = procedure( Sender: TObject; DataPtr: pointer; DataSize: DWORD ) of object;
// RX event ( packed mode enabled )
TReceivePacketEvent = procedure( Sender: TObject; Packet: pointer; DataSize: DWORD ) of object;
//------------------------------------------------------------------------
// Other types
//------------------------------------------------------------------------
type
// Line status ( Clear To Send, Data Set Ready, Ring, Carrier Detect )
TLineStatus = ( lsCTS, lsDSR, lsRING, lsCD );
// Set of line status
TLineStatusSet = set of TLineStatus;
//------------------------------------------------------------------------
// Constants
//------------------------------------------------------------------------
const
RELEASE_NOCLOSE_PORT = HFILE(INVALID_HANDLE_VALUE-1);
//------------------------------------------------------------------------
// TCommPortDriver component
//------------------------------------------------------------------------
type
TCommPortDriver = class( TComponent )
protected
// Device Handle ( File Handle )
FHandle : HFILE;
// # of the COM port to use, or pnCustom to use custom port name
FPort : TPortNumber;
// Custom port name ( usually '\\.\COMn', with n = 1..x )
FPortName : string;
// COM Port speed (brXXX)
FBaudRate : TBaudRate;
// Baud rate ( actual numeric value )
FBaudRateValue : DWORD;
// Data bits size (dbXXX)
FDataBits : TDataBits;
// How many stop bits to use (sbXXX)
FStopBits : TStopBits;
// Type of parity to use (ptXXX)
FParity : TParity;
// Type of hw handshaking (hw flow control) to use (hfXXX)
FHwFlow : THwFlowControl;
// Type of sw handshaking (sw flow control) to use (sFXXX)
FSwFlow : TSwFlowControl;
// Size of the input buffer
FInBufSize : DWORD;
// Size of the output buffer
FOutBufSize : DWORD;
// Size of a data packet
FPacketSize : smallint;
// ms to wait for a complete packet (<=0 = disabled)
FPacketTimeout : integer;
// What to do with incomplete packets (pmXXX)
FPacketMode : TPacketMode;
// Event to raise on data reception (asynchronous)
FOnReceiveData : TReceiveDataEvent;
// Event to raise on packet reception (asynchronous)
FOnReceivePacket : TReceivePacketEvent;
// ms of delay between COM port pollings
FPollingDelay : word;
// Specifies if the DTR line must be enabled/disabled on connect
FEnableDTROnOpen : boolean;
// Output timeout - milliseconds
FOutputTimeout : word;
// Timeout for ReadData
FInputTimeout : DWORD;
// Set to TRUE to prevent hangs when no device connected or
// device is OFF
FCkLineStatus : boolean;
// This is used for the timer
FNotifyWnd : HWND;
// Temporary buffer (RX) - used internally
FTempInBuffer : pointer;
// Time of the first byte of current RX packet
FFirstByteOfPacketTime : DWORD;
// Number of RX polling timer pauses
FRXPollingPauses : integer;
// Sets the COM port handle
procedure SetHandle( Value: HFILE );
// Selects the COM port to use
procedure SetPort( Value: TPortNumber );
// Sets the port name
procedure SetPortName( Value: string );
// Selects the baud rate
procedure SetBaudRate( Value: TBaudRate );
// Selects the baud rate ( actual baud rate value )
procedure SetBaudRateValue( Value: DWORD );
// Selects the number of data bits
procedure SetDataBits( Value: TDataBits );
// Selects the number of stop bits
procedure SetStopBits( Value: TStopBits );
// Selects the kind of parity
procedure SetParity( Value: TParity );
// Selects the kind of hardware flow control
procedure SetHwFlowControl( Value: THwFlowControl );
// Selects the kind of software flow control
procedure SetSwFlowControl( Value: TSwFlowControl );
// Sets the RX buffer size
procedure SetInBufSize( Value: DWORD );
// Sets the TX buffer size
procedure SetOutBufSize( Value: DWORD );
// Sets the size of incoming packets
procedure SetPacketSize( Value: smallint );
// Sets the timeout for incoming packets
procedure SetPacketTimeout( Value: integer );
// Sets the delay between polling checks
procedure SetPollingDelay( Value: word );
// Applies current settings to open COM port
function ApplyCOMSettings: boolean;
// Polling proc
procedure TimerWndProc( var msg: TMessage );
public
// Constructor
constructor Create( AOwner: TComponent ); override;
// Destructor
destructor Destroy; override;
// Opens the COM port and takes of it. Returns false if something
// goes wrong.
function Connect: boolean;
// Closes the COM port and releases control of it
procedure Disconnect;
// Returns true if COM port has been opened
function Connected: boolean;
// Returns the current state of CTS, DSR, RING and RLSD (CD) lines.
// The function fails if the hardware does not support the control-register
// values (that is, returned set is always empty).
function GetLineStatus: TLineStatusSet;
// Returns true if polling has not been paused
function IsPolling: boolean;
// Pauses polling
procedure PausePolling;
// Re-starts polling (after pause)
procedure ContinuePolling;
// Flushes the rx/tx buffers
function FlushBuffers( inBuf, outBuf: boolean ): boolean;
// Returns number of received bytes in the RX buffer
function CountRX: integer;
// Returns the output buffer free space or 65535 if not connected
function OutFreeSpace: word;
// Sends binary data
function SendData( DataPtr: pointer; DataSize: DWORD ): DWORD;
// Sends binary data. Returns number of bytes sent. Timeout overrides
// the value specifiend in the OutputTimeout property
function SendDataEx( DataPtr: pchar; DataSize, Timeout: DWORD ): DWORD;
// Sends a byte. Returns true if the byte has been sent
function SendByte( Value: byte ): boolean;
// Sends a char. Returns true if the char has been sent
function SendChar( Value: char ): boolean;
// Sends a pascal string (NULL terminated if $H+ (default))
function SendString( s: string ): boolean;
// Sends a C-style strings (NULL terminated)
function SendZString( s: pchar ): boolean;
// Reads binary data. Returns number of bytes read
function ReadData( DataPtr: pchar; MaxDataSize: DWORD ): DWORD;
// Reads a byte. Returns true if the byte has been read
function ReadByte( var Value: byte ): boolean;
// Reads a char. Returns true if char has been read
function ReadChar( var Value: char ): boolean;
// Set DTR line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure ToggleDTR( onOff: boolean );
// Set RTS line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure ToggleRTS( onOff: boolean );
// Make the Handle of the COM port public (for TAPI...) [read/write]
property Handle: HFILE read FHandle write SetHandle;
published
// # of the COM Port to use ( or pnCustom for port by name )
property Port: TPortNumber read FPort write SetPort default pnCOM2;
// Name of COM port
property PortName: string read FPortName write SetPortName;
// Speed ( Baud Rate )
property BaudRate: TBaudRate read FBaudRate write SetBaudRate default br9600;
// Speed ( Actual Baud Rate value )
property BaudRateValue: DWORD read FBaudRateValue write SetBaudRateValue default 9600;
// Data bits to use (5..8, for the 8250 the use of 5 data bits with 2 stop
// bits is an invalid combination, as is 6, 7, or 8 data bits with 1.5 stop
// bits)
property DataBits: TDataBits read FDataBits write SetDataBits default db8BITS;
// Stop bits to use (1, 1.5, 2)
property StopBits: TStopBits read FStopBits write SetStopBits default sb1BITS;
// Kind of Parity to use (none,odd,even,mark,space)
property Parity: TParity read FParity write SetParity default ptNONE;
// Kind of Hardware Flow Control to use:
// hfNONE none
// hfNONERTSON no flow control but keep RTS line on
// hfRTSCTS Request-To-Send/Clear-To-Send
property HwFlow: THwFlowControl read FHwFlow write SetHwFlowControl default hfNONERTSON;
// Kind of Software Flow Control to use:
// sfNONE none
// sfXONXOFF XON/XOFF
property SwFlow: TSwFlowControl read FSwFlow write SetSwFlowControl default sfNONE;
// Input Buffer size ( suggested - driver might ignore this setting ! )
property InBufSize: DWORD read FInBufSize write SetInBufSize default 2048;
// Output Buffer size ( suggested - driver usually ignores this setting ! )
property OutBufSize: DWORD read FOutBufSize write SetOutBufSize default 2048;
// RX packet size ( this value must be less than InBufSize )
// A value <= 0 means "no packet mode" ( i.e. standard mode enabled )
property PacketSize: smallint read FPacketSize write SetPacketSize default -1;
// Timeout (ms) for a complete packet (in RX)
property PacketTimeout: integer read FPacketTimeout write SetPacketTimeout default -1;
// What to do with incomplete packets (in RX)
property PacketMode: TPacketMode read FPacketMode write FPacketMode default pmDiscard;
// ms of delay between COM port pollings
property PollingDelay: word read FPollingDelay write SetPollingDelay default 50;
// Set to TRUE to enable DTR line on connect and to leave it on until disconnect.
// Set to FALSE to disable DTR line on connect.
property EnableDTROnOpen: boolean read FEnableDTROnOpen write FEnableDTROnOpen default true;
// Output timeout (milliseconds)
property OutputTimeout: word read FOutputTimeOut write FOutputTimeout default 500;
// Input timeout (milliseconds)
property InputTimeout: DWORD read FInputTimeOut write FInputTimeout default 200;
// Set to TRUE to prevent hangs when no device connected or device is OFF
property CheckLineStatus: boolean read FCkLineStatus write FCkLineStatus default false;
// Event to raise when there is data available (input buffer has data)
// (called only if PacketSize <= 0)
property OnReceiveData: TReceiveDataEvent read FOnReceiveData write FOnReceiveData;
// Event to raise when there is data packet available (called only if PacketSize > 0)
property OnReceivePacket: TReceivePacketEvent read FOnReceivePacket write FOnReceivePacket;
end;
function BaudRateOf( bRate: TBaudRate ): DWORD;
function DelayForRX( bRate: TBaudRate; DataSize: DWORD ): DWORD;
implementation
const
Win32BaudRates: array[br110..br256000] of DWORD =
( CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200,
CBR_128000, CBR_256000 );
const
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;
function GetWinPlatform: string;
var ov: TOSVERSIONINFO;
begin
ov.dwOSVersionInfoSize := sizeof(ov);
if GetVersionEx( ov ) then
begin
case ov.dwPlatformId of
VER_PLATFORM_WIN32s: // Win32s on Windows 3.1
Result := 'W32S';
VER_PLATFORM_WIN32_WINDOWS: // Win32 on Windows 95/98
Result := 'W95';
VER_PLATFORM_WIN32_NT: // Windows NT
Result := 'WNT';
end;
end
else
Result := '??';
end;
function GetWinVersion: DWORD;
var ov: TOSVERSIONINFO;
begin
ov.dwOSVersionInfoSize := sizeof(ov);
if GetVersionEx( ov ) then
Result := MAKELONG( ov.dwMinorVersion, ov.dwMajorVersion )
else
Result := $00000000;
end;
function BaudRateOf( bRate: TBaudRate ): DWORD;
begin
if bRate = brCustom then
Result := 0
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -