http://61.132.118.185:8080/dispdocnew.php?t=&id=2407
上面可以下载spcomm
我平常用的是TCommPortDriver,我现在找不着了,我把代码贴这儿吧:
//------------------------------------------------------------------------
// Notice:
// 这是一个外国人编写的一个不用线程的串口控件,
// 它在Win98上运行的很稳定,是一个相当不错的串口控件
// 然而当我在Win2000下使用时,却经常出错,
// 只要数据发送的太快的时候,就会出错,出错率很高
// 经过一段时间,我找到了出错的原因,并进行了修正
// (修改的地方有说明),同时也进行了一些改进
// 发送数据的同时也可以接收数据
// 现在可以放心的使用这个控件了
// By Lichaohui Email: lzh0379@yahoo.com.cn
// UNIT : CPDrv.pas
// CONTENTS : TCommPortDriver component
// VERSION : 3.00
// TARGET : (Inprise's) Borland Delphi 6.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 : 08/20/2002
// (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;
function DataInBuffer: Integer;
// 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;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyControl', [TCommPortDriver]);
end;
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
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 := Classes.AllocateHWnd( TimerWndProc );
end;
destructor TCommPortDriver.Destroy;
begin
// Be sure to release the COM port
Disconnect;
// Destroy the timer's window
if not (csDesigning in ComponentState) then
Classes.DeallocateHWnd( FNotifyWnd );
// Free the temporary buffer
FreeMem( FTempInBuffer, FInBufSize );
// 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,
0, // Not shared
nil, // No security attributes
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0 // No template
) ;
Result := Connected;
if not Result then
exit;
// Apply settings
Result := ApplyCOMSettings;
if not Result then
begin
Disconnect;
exit;
end;
// Set ReadIntervalTimeout: Specifies the maximum time, in milliseconds,
// allowed to elapse between the arrival of two characters on the
// communications line.
// We disable timeouts because we are polling the com port!
tms.ReadIntervalTimeout := 1;
// Set ReadTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds,
// used to calculate the total time-out period for read operations.
tms.ReadTotalTimeoutMultiplier := 0;
// Set ReadTotalTimeoutConstant: Specifies the constant, in milliseconds,
// used to calculate the total time-out period for read operations.
tms.ReadTotalTimeoutConstant := 1;
// Set WriteTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds,
// used to calculate the total time-out period for write operations.
tms.WriteTotalTimeoutMultiplier := 0;
// Set WriteTotalTimeoutConstant: Specifies the constant, in milliseconds,
// used to calculate the total time-out period for write operations.
tms.WriteTotalTimeoutConstant := 10;
// Apply timeouts
SetCommTimeOuts( FHandle, tms );
// Start the timer (used for polling)
SetTimer( FNotifyWnd, 1, FPollingDelay, nil );
end;
procedure TCommPortDriver.Disconnect;
begin
if Connected then
begin
// Stop the timer (used for polling)
KillTimer( FNotifyWnd, 1 );
// Release the COM port
CloseHandle( FHandle );
// No more connected
FHandle := INVALID_HANDLE_VALUE;
end;
end;
// Returns true if connected
function TCommPortDriver.Connected: boolean;
begin
Result := FHandle <> INVALID_HANDLE_VALUE;
end;
// Returns CTS, DSR, RING and RLSD (CD) signals status
function TCommPortDriver.GetLineStatus: TLineStatusSet;
var dwS: DWORD;
begin
Result := [];
if not Connected then
exit;
// Retrieves modem control-register values.
// The function fails if the hardware does not support the control-register
// values.
if not GetCommModemStatus( FHandle, dwS ) then
exit;
if dwS and MS_CTS_ON <> 0 then Result := Result + [lsCTS];
if dwS and MS_DSR_ON <> 0 then Result := Result + [lsDSR];
if dwS and MS_RING_ON <> 0 then Result := Result + [lsRING];
if dwS and MS_RLSD_ON <> 0 then Result := Result + [lsCD];
end;
// Returns true if polling has not been paused
function TCommPortDriver.IsPolling: boolean;
begin
Result := FRXPollingPauses <= 0;
end;
// Pauses polling
procedure TCommPortDriver.PausePolling;
begin
// Inc. RX polling pauses counter
inc( FRXPollingPauses );
end;
// Re-starts polling (after pause)
procedure TCommPortDriver.ContinuePolling;
begin
// Dec. RX polling pauses counter
dec( FRXPollingPauses );
end;
// Flush rx/tx buffers
function TCommPortDriver.FlushBuffers( inBuf, outBuf: boolean ): boolean;
var dwAction: DWORD;
begin
// Do nothing if not connected
Result := false;
if not Connected then
exit;
// Flush the RX data buffer
dwAction := 0;
if outBuf then
dwAction := dwAction or PURGE_TXABORT or PURGE_TXCLEAR;
// Flush the TX data buffer
if inBuf then
dwAction := dwAction or PURGE_RXABORT or PURGE_RXCLEAR;
Result := PurgeComm( FHandle, dwAction );
// Used by the RX packet mechanism
if Result then
FFirstByteOfPacketTime := DWORD(-1);
end;
// Returns number of received bytes in the RX buffer
function TCommPortDriver.CountRX: integer;
var stat: TCOMSTAT;
errs: DWORD;
begin
// Do nothing if port has not been opened
Result := 65535;
if not Connected then
exit;
// Get count
ClearCommError( FHandle, errs, @stat );
Result := stat.cbInQue;
end;
// Returns the output buffer free space or 65535 if not connected
function TCommPortDriver.OutFreeSpace: word;
var stat: TCOMSTAT;
errs: DWORD;
begin
if not Connected then
Result := 65535
else
begin
ClearCommError( FHandle, errs, @stat );
Result := FOutBufSize - stat.cbOutQue;
end;
end;
// Sends binary data. Returns number of bytes sent. Timeout overrides
// the value specifiend in the OutputTimeout property
function TCommPortDriver.SendDataEx( DataPtr: pchar; DataSize, Timeout: DWORD ): DWORD;
var nToSend, nSent, t1: DWORD;
begin
// Do nothing if port has not been opened
Result := 0;
if not Connected then
exit;
//Following is added by Lichaohui 08/20/2002
//Receive data first
while DataInBuffer > 0 do
SendMessage(FNotifyWnd, WM_TIMER, 1, 0);
// Current time
t1 := GetTickCount;
// Loop until all data sent or timeout occurred
while DataSize > 0 do
begin
// Get TX buffer free space
nToSend := OutFreeSpace;
// If output buffer has some free space...
if nToSend > 0 then
begin
// Check signals
if FCkLineStatus and (GetLineStatus = []) then
exit;
// Don't send more bytes than we actually have to send
if nToSend > DataSize then
nToSend := DataSize;
// Send
WriteFile( FHandle, DataPtr^, nToSend, nSent, nil );
nSent := abs( nSent );
if nSent > 0 then
begin
// Update number of bytes sent
Result := Result + nSent;
// Decrease the count of bytes to send
DataSize := DataSize - nSent;
// Inc. data pointer
DataPtr := DataPtr + nSent;
// Get current time
t1 := GetTickCount;
// Continue. This skips the time check below (don't stop
// trasmitting if the Timeout is set too low)
continue;
end;
end;
// Buffer is full. If we are waiting too long then exit
if DWORD(GetTickCount-t1) > Timeout then
exit;
end;
end;
// Send data (breaks the data in small packets if it doesn't fit in the output
// buffer)
function TCommPortDriver.SendData( DataPtr: pointer; DataSize: DWORD ): DWORD;
begin
Result := SendDataEx( DataPtr, DataSize, FOutputTimeout );
end;
// Sends a byte. Returns true if the byte has been sent
function TCommPortDriver.SendByte( Value: byte ): boolean;
begin
Result := SendData( @Value, 1 ) = 1;
end;
// Sends a char. Returns true if the char has been sent
function TCommPortDriver.SendChar( Value: char ): boolean;
begin
Result := SendData( @Value, 1 ) = 1;
end;
// Sends a pascal string (NULL terminated if $H+ (default))
function TCommPortDriver.SendString( s: string ): boolean;
var len: DWORD;
begin
len := length( s );
{$IFOPT H+} // New syle pascal string (NULL terminated)
Result := SendData( pchar(s), len ) = len;
{$ELSE} // Old style pascal string (s[0] = length)
Result := SendData( pchar(@s[1]), len ) = len;
{$ENDIF}
end;
// Sends a C-style string (NULL terminated)
function TCommPortDriver.SendZString( s: pchar ): boolean;
var len: DWORD;
begin
len := strlen( s );
Result := SendData( s, len ) = len;
end;
// Reads binary data. Returns number of bytes read
function TCommPortDriver.ReadData( DataPtr: pchar; MaxDataSize: DWORD ): DWORD;
var nToRead, nRead, t1: DWORD;
begin
// Do nothing if port has not been opened
Result := 0;
if not Connected then
exit;
// Pause polling
PausePolling;
// Current time
t1 := GetTickCount;
// Loop until all requested data read or timeout occurred
while MaxDataSize > 0 do
begin
// Get data bytes count in RX buffer
nToRead := CountRX;
// If input buffer has some data...
if nToRead > 0 then
begin
// Don't read more bytes than we actually have to read
if nToRead > MaxDataSize then
nToRead := MaxDataSize;
// Read
ReadFile( FHandle, DataPtr^, nToRead, nRead, nil );
// Update number of bytes read
Result := Result + nRead;
// Decrease the count of bytes to read
MaxDataSize := MaxDataSize - nRead;
// Inc. data pointer
DataPtr := DataPtr + nRead;
// Get current time
t1 := GetTickCount;
// Continue. This skips the time check below (don't stop
// reading if the FInputTimeout is set too low)
continue;
end;
// Buffer is empty. If we are waiting too long then exit
if (GetTickCount-t1) > FInputTimeout then
break;
end;
// Continue polling
ContinuePolling;
end;
// Reads a byte. Returns true if the byte has been read
function TCommPortDriver.ReadByte( var Value: byte ): boolean;
begin
Result := ReadData( @Value, 1 ) = 1;
end;
// Reads a char. Returns true if char has been read
function TCommPortDriver.ReadChar( var Value: char ): boolean;
begin
Result := ReadData( @Value, 1 ) = 1;
end;
// Set DTR line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure TCommPortDriver.ToggleDTR( onOff: boolean );
const funcs: array[boolean] of integer = (CLRDTR,SETDTR);
begin
if Connected then
EscapeCommFunction( FHandle, funcs[onOff] );
end;
// Set RTS line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure TCommPortDriver.ToggleRTS( onOff: boolean );
const funcs: array[boolean] of integer = (CLRRTS,SETRTS);
begin
if Connected then
EscapeCommFunction( FHandle, funcs[onOff] );
end;
// COM port polling proc
procedure TCommPortDriver.TimerWndProc( var msg: TMessage );
var nRead, nToRead, dummy: DWORD;
comStat: TCOMSTAT;
begin
if (msg.Msg = WM_TIMER) and Connected then
begin
// Do nothing if RX polling has been paused
if FRXPollingPauses > 0 then
exit;
// If PacketSize is > 0 then raise the OnReceiveData event only if the RX
// buffer has at least PacketSize bytes in it.
ClearCommError( FHandle, dummy, @comStat );
if FPacketSize > 0 then
begin
// Complete packet received ?
if DWORD(comStat.cbInQue) >= DWORD(FPacketSize) then
begin
repeat
// Read the packet and pass it to the app
nRead := 0;
if ReadFile( FHandle, FTempInBuffer^, FPacketSize, nRead, nil ) then
if (nRead <> 0) and Assigned(FOnReceivePacket) then
FOnReceivePacket( Self, FTempInBuffer, nRead );
// Adjust time
//if comStat.cbInQue >= FPacketSize then
FFirstByteOfPacketTime := FFirstByteOfPacketTime +
DelayForRX( FBaudRate, FPacketSize );
comStat.cbInQue := comStat.cbInQue - WORD(FPacketSize);
if comStat.cbInQue = 0 then
FFirstByteOfPacketTime := DWORD(-1);
until DWORD(comStat.cbInQue) < DWORD(FPacketSize);
// Done
exit;
end;
// Handle packet timeouts
if (FPacketTimeout > 0) and (FFirstByteOfPacketTime <> DWORD(-1)) and
(GetTickCount - FFirstByteOfPacketTime > DWORD(FPacketTimeout)) then
begin
nRead := 0;
// Read the "incomplete" packet
if ReadFile( FHandle, FTempInBuffer^, comStat.cbInQue, nRead, nil ) then
// If PacketMode is not pmDiscard then pass the packet to the app
if (FPacketMode <> pmDiscard) and (nRead <> 0) and Assigned(FOnReceivePacket) then
FOnReceivePacket( Self, FTempInBuffer, nRead );
// Restart waiting for a packet
FFirstByteOfPacketTime := DWORD(-1);
// Done
exit;
end;
// Start time
if (comStat.cbInQue > 0) and (FFirstByteOfPacketTime = DWORD(-1)) then
FFirstByteOfPacketTime := GetTickCount;
// Done
exit;
end;
// Standard data handling
nRead := 0;
nToRead := comStat.cbInQue;
//Following lines is added by Lichaohui on 08/20/2002
if nToRead > FInBufSize then nToRead := FInBufSize;
//If no this line, program will crash to die
//The thing i don't think is the nToRead is
//bigger than FInBufSize, the crash is certainly
//
if (nToRead > 0) and ReadFile( FHandle, FTempInBuffer^, nToRead, nRead, nil ) then
if (nRead <> 0) and Assigned(FOnReceiveData) then
FOnReceiveData( Self, FTempInBuffer, nRead );
end
// Let Windows handle other messages
else
Msg.Result := DefWindowProc( FNotifyWnd, Msg.Msg, Msg.wParam, Msg.lParam ) ;
end;
function TCommPortDriver.DataInBuffer: Integer;
var
dummy: DWORD;
comStat: TCOMSTAT;
begin
ClearCommError( FHandle, dummy, @comStat );
Result := comStat.cbInQue;
end;
end.
你收到的是“!23df”,那么23df应该是一个word类型的数据。我不知道“!”
是什么?