(*************************************************
* ComPort Library ver. 2.62 *
* for Delphi 3, 4, 5 and C++ Builder 3, 4, 5 *
* written by Dejan Crnila, 1998 - 2001 *
* email: dejancrn@yahoo.com *
* *
* Unit: CPort.pas *
*************************************************)

{
* modify by HGR 2003-2004 *
* email: HGRhgr@21cn.com *

}

unit CPort;

{$I CPort.inc}

interface

uses
Windows, Messages, Classes, SysUtils, IniFiles, Registry;

type
// various types
TPort = string;
TBaudRate = (brCustom, br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
br19200, br38400, br56000, br57600, br115200, br128000, br256000);
TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits);
TDataBits = (dbFive, dbSix, dbSeven, dbEight);
TParityBits = (prNone, prOdd, prEven, prMark, prSpace);
TDTRFlowControl = (dtrDisable, dtrEnable, dtrHandshake);
TRTSFlowControl = (rtsDisable, rtsEnable, rtsHandshake, rtsToggle);
TFlowControl = (fcHardware, fcSoftware, fcNone, fcCustom);
TComEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS, evDSR,
evError, evRLSD, evRx80Full);
TComEvents = set of TComEvent;
TComSignal = (csCTS, csDSR, csRing, csRLSD);
TComSignals = set of TComSignal;
TComError = (ceFrame, ceRxParity, ceOverrun, ceBreak, ceIO, ceMode, ceRxOver,
ceTxFull);
TComErrors = set of TComError;
TSyncMethod = (smThreadSync, smWindowSync, smNone);
TStoreType = (stRegistry, stIniFile);
TStoredProp = (spBasic, spFlowControl, spBuffer, spTimeouts, spParity,
spOthers);
TStoredProps = set of TStoredProp;
TComLinkEvent = (leConn, leCTS, leDSR, leRLSD, leRing, leRx, leTx,
leTxEmpty, leRxFlag);
TRxCharEvent = procedure(Sender: TObject; Count: Integer) of object;
TRxBufEvent = procedure(Sender: TObject; const Buffer;
Count: Integer) of object;
TComErrorEvent = procedure(Sender: TObject; Errors: TComErrors) of object;
TComSignalEvent = procedure(Sender: TObject; OnOff: Boolean) of object;

// types for asynchronous calls
TOperationKind = (okWrite, okRead);
TAsync = record
Overlapped: TOverlapped;
Kind: TOperationKind;
Data: Pointer;
Size: Integer;
end;
PAsync = ^TAsync;

// TComPort component and asistant classes

TCustomComPort = class; // forward declaration

// class that links TCustomComPort events to other components
TComLink = class
private
FOnConn: TComSignalEvent;
FOnRxBuf: TRxBufEvent;
FOnTxBuf: TRxBufEvent;
FOnTxEmpty: TNotifyEvent;
FOnRxFlag: TNotifyEvent;
FOnCTSChange: TComSignalEvent;
FOnDSRChange: TComSignalEvent;
FOnRLSDChange: TComSignalEvent;
FOnRing: TNotifyEvent;
FOnTx: TComSignalEvent;
FOnRx: TComSignalEvent;
public
property OnConn: TComSignalEvent read FOnConn write FOnConn;
property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
property OnTxBuf: TRxBufEvent read FOnTxBuf write FOnTxBuf;
property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
property OnRLSDChange: TComSignalEvent
read FOnRLSDChange write FOnRLSDChange;
property OnRing: TNotifyEvent read FOnRing write FOnRing;
property OnTx: TComSignalEvent read FOnTx write FOnTx;
property OnRx: TComSignalEvent read FOnRx write FOnRx;
end;

// thread for background monitoring of port events
TComThread = class(TThread)
private
FComPort: TCustomComPort;
FStopEvent: THandle;
FEvents: TComEvents;
protected
procedure DispatchComMsg;
procedure DoEvents;
procedure Execute; override;
procedure SendEvents;
procedure Stop;
public
constructor Create(AComPort: TCustomComPort);
destructor Destroy; override;
end;

// timoeout properties for read/write operations
TComTimeouts = class(TPersistent)
private
FComPort: TCustomComPort;
FReadInterval: Integer;
FReadTotalM: Integer;
FReadTotalC: Integer;
FWriteTotalM: Integer;
FWriteTotalC: Integer;
procedure SetComPort(const AComPort: TCustomComPort);
procedure SetReadInterval(const Value: Integer);
procedure SetReadTotalM(const Value: Integer);
procedure SetReadTotalC(const Value: Integer);
procedure SetWriteTotalM(const Value: Integer);
procedure SetWriteTotalC(const Value: Integer);
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
property ComPort: TCustomComPort read FComPort;
published
property ReadInterval: Integer read FReadInterval write SetReadInterval default -1;
property ReadTotalMultiplier: Integer read FReadTotalM write SetReadTotalM default 0;
property ReadTotalConstant: Integer read FReadTotalC write SetReadTotalC default 0;
property WriteTotalMultiplier: Integer
read FWriteTotalM write SetWriteTotalM default 100;
property WriteTotalConstant: Integer
read FWriteTotalC write SetWriteTotalC default 1000;
end;

// flow control settings
TComFlowControl = class(TPersistent)
private
FComPort: TCustomComPort;
FOutCTSFlow: Boolean;
FOutDSRFlow: Boolean;
FControlDTR: TDTRFlowControl;
FControlRTS: TRTSFlowControl;
FXonXoffOut: Boolean;
FXonXoffIn: Boolean;
FDSRSensitivity: Boolean;
FTxContinueOnXoff: Boolean;
FXonChar: Char;
FXoffChar: Char;
procedure SetComPort(const AComPort: TCustomComPort);
procedure SetOutCTSFlow(const Value: Boolean);
procedure SetOutDSRFlow(const Value: Boolean);
procedure SetControlDTR(const Value: TDTRFlowControl);
procedure SetControlRTS(const Value: TRTSFlowControl);
procedure SetXonXoffOut(const Value: Boolean);
procedure SetXonXoffIn(const Value: Boolean);
procedure SetDSRSensitivity(const Value: Boolean);
procedure SetTxContinueOnXoff(const Value: Boolean);
procedure SetXonChar(const Value: Char);
procedure SetXoffChar(const Value: Char);
procedure SetFlowControl(const Value: TFlowControl);
function GetFlowControl: TFlowControl;
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
property ComPort: TCustomComPort read FComPort;
published
property FlowControl: TFlowControl read GetFlowControl write SetFlowControl stored False;
property OutCTSFlow: Boolean read FOutCTSFlow write SetOutCTSFlow;
property OutDSRFlow: Boolean read FOutDSRFlow write SetOutDSRFlow;
property ControlDTR: TDTRFlowControl read FControlDTR write SetControlDTR;
property ControlRTS: TRTSFlowControl read FControlRTS write SetControlRTS;
property XonXoffOut: Boolean read FXonXoffOut write SetXonXoffOut;
property XonXoffIn: Boolean read FXonXoffIn write SetXonXoffIn;
property DSRSensitivity: Boolean
read FDSRSensitivity write SetDSRSensitivity default False;
property TxContinueOnXoff: Boolean
read FTxContinueOnXoff write SetTxContinueOnXoff default False;
property XonChar: Char read FXonChar write SetXonChar default #17;
property XoffChar: Char read FXoffChar write SetXoffChar default #19;
end;

// parity settings
TComParity = class(TPersistent)
private
FComPort: TCustomComPort;
FBits: TParityBits;
FCheck: Boolean;
FReplace: Boolean;
FReplaceChar: Char;
procedure SetComPort(const AComPort: TCustomComPort);
procedure SetBits(const Value: TParityBits);
procedure SetCheck(const Value: Boolean);
procedure SetReplace(const Value: Boolean);
procedure SetReplaceChar(const Value: Char);
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
property ComPort: TCustomComPort read FComPort;
published
property Bits: TParityBits read FBits write SetBits;
property Check: Boolean read FCheck write SetCheck default False;
property Replace: Boolean read FReplace write SetReplace default False;
property ReplaceChar: Char read FReplaceChar write SetReplaceChar default #0;
end;

// buffer size settings
TComBuffer = class(TPersistent)
private
FComPort: TCustomComPort;
FInputSize: Integer;
FOutputSize: Integer;
procedure SetComPort(const AComPort: TCustomComPort);
procedure SetInputSize(const Value: Integer);
procedure SetOutputSize(const Value: Integer);
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
property ComPort: TCustomComPort read FComPort;
published
property InputSize: Integer read FInputSize write SetInputSize default 1024;
property OutputSize: Integer read FOutputSize write SetOutputSize default 1024;
end;

// main component
TCustomComPort = class(TComponent)
private
FEventThread: TComThread;
FThreadCreated: Boolean;
FHandle: THandle;
FWindow: THandle;
FUpdateCount: Integer;
FLinks: TList;
FTriggersOnRxChar: Boolean;
FHasLink: Boolean;
FConnected: Boolean;
FBaudRate: TBaudRate;
FCustomBaudRate: Integer;
FPort: TPort;
FStopBits: TStopBits;
FDataBits: TDataBits;
FDiscardNull: Boolean;
FEventChar: Char;
FEvents: TComEvents;
FBuffer: TComBuffer;
FParity: TComParity;
FTimeouts: TComTimeouts;
FFlowControl: TComFlowControl;
FSyncMethod: TSyncMethod;
FStoredProps: TStoredProps;
FOnRxChar: TRxCharEvent;
FOnRxBuf: TRxBufEvent;
FOnTxEmpty: TNotifyEvent;
FOnBreak: TNotifyEvent;
FOnRing: TNotifyEvent;
FOnCTSChange: TComSignalEvent;
FOnDSRChange: TComSignalEvent;
FOnRLSDChange: TComSignalEvent;
FOnError: TComErrorEvent;
FOnRxFlag: TNotifyEvent;
FOnAfterOpen: TNotifyEvent;
FOnAfterClose: TNotifyEvent;
FOnBeforeOpen: TNotifyEvent;
FOnBeforeClose: TNotifyEvent;
FOnRx80Full: TNotifyEvent;
function GetTriggersOnRxChar: Boolean;
procedure SetTriggersOnRxChar(const Value: Boolean);
procedure SetConnected(const Value: Boolean);
procedure SetBaudRate(const Value: TBaudRate);
procedure SetCustomBaudRate(const Value: Integer);
procedure SetPort(const Value: TPort);
procedure SetStopBits(const Value: TStopBits);
procedure SetDataBits(const Value: TDataBits);
procedure SetDiscardNull(const Value: Boolean);
procedure SetEventChar(const Value: Char);
procedure SetSyncMethod(const Value: TSyncMethod);
procedure SetParity(const Value: TComParity);
procedure SetTimeouts(const Value: TComTimeouts);
procedure SetBuffer(const Value: TComBuffer);
procedure SetFlowControl(const Value: TComFlowControl);
function HasLink: Boolean;
procedure TxNotifyLink(const Buffer; Count: Integer);
procedure NotifyLink(FLinkEvent: TComLinkEvent);
procedure SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean);
procedure CheckSignals(Open: Boolean);
procedure WindowMethod(var Message: TMessage);
procedure CallAfterOpen;
procedure CallAfterClose;
procedure CallBeforeOpen;
procedure CallBeforeClose;
procedure CallRxChar;
procedure CallTxEmpty;
procedure CallBreak;
procedure CallRing;
procedure CallRxFlag;
procedure CallCTSChange;
procedure CallDSRChange;
procedure CallError;
procedure CallRLSDChange;
procedure CallRx80Full;
protected
procedure Loaded; override;
procedure DoAfterClose; dynamic;
procedure DoAfterOpen; dynamic;
procedure DoBeforeClose; dynamic;
procedure DoBeforeOpen; dynamic;
procedure DoRxChar(Count: Integer); dynamic;
procedure DoRxBuf(const Buffer; Count: Integer); dynamic;
procedure DoTxEmpty; dynamic;
procedure DoBreak; dynamic;
procedure DoRing; dynamic;
procedure DoRxFlag; dynamic;
procedure DoCTSChange(OnOff: Boolean); dynamic;
procedure DoDSRChange(OnOff: Boolean); dynamic;
procedure DoError(Errors: TComErrors); dynamic;
procedure DoRLSDChange(OnOff: Boolean); dynamic;
procedure DoRx80Full; dynamic;
procedure StoreRegistry(Reg: TRegistry); virtual;
procedure StoreIniFile(IniFile: TIniFile); virtual;
procedure LoadRegistry(Reg: TRegistry); virtual;
procedure LoadIniFile(IniFile: TIniFile); virtual;
procedure CreateHandle; virtual;
procedure DestroyHandle; virtual;
procedure ApplyDCB; dynamic;
procedure ApplyTimeouts; dynamic;
procedure ApplyBuffer; dynamic;
procedure SetupComPort; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
procedure StoreSettings(StoreType: TStoreType; StoreTo: string);
procedure LoadSettings(StoreType: TStoreType; LoadFrom: string);
procedure Open;
procedure Close;
procedure ShowSetupDialog;
function InputCount: Integer;
function OutputCount: Integer;
function Signals: TComSignals;
function StateFlags: TComStateFlags;
procedure SetDTR(OnOff: Boolean);
procedure SetRTS(OnOff: Boolean);
procedure SetXonXoff(OnOff: Boolean);
procedure SetBreak(OnOff: Boolean);
procedure ClearBuffer(Input, Output: Boolean);
function LastErrors: TComErrors;
function Write(const Buffer; Count: Integer): Integer;
function WriteStr(const Str: string): Integer;
function Read(var Buffer; Count: Integer): Integer;
function ReadStr(var Str: string; Count: Integer): Integer;
function WriteAsync(const Buffer; Count: Integer;
var AsyncPtr: PAsync): Integer;
function WriteStrAsync(const Str: string; var AsyncPtr: PAsync): Integer;
function ReadAsync(var Buffer; Count: Integer;
var AsyncPtr: PAsync): Integer;
function ReadStrAsync(var Str: string; Count: Integer;
var AsyncPtr: PAsync): Integer;
function WaitForAsync(var AsyncPtr: PAsync): Integer;
function IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
procedure WaitForEvent(var Events: TComEvents; StopEvent: THandle;
Timeout: Integer);
procedure AbortAllAsync;
procedure TransmitChar(Ch: Char);
procedure RegisterLink(AComLink: TComLink);
procedure UnRegisterLink(AComLink: TComLink);
property Handle: THandle read FHandle;
property TriggersOnRxChar: Boolean
read GetTriggersOnRxChar write SetTriggersOnRxChar;
property StoredProps: TStoredProps read FStoredProps write FStoredProps;
property Connected: Boolean read FConnected write SetConnected default False;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property CustomBaudRate: Integer
read FCustomBaudRate write SetCustomBaudRate;
property Port: TPort read FPort write SetPort;
property Parity: TComParity read FParity write SetParity;
property StopBits: TStopBits read FStopBits write SetStopBits;
property DataBits: TDataBits read FDataBits write SetDataBits;
property DiscardNull: Boolean read FDiscardNull write SetDiscardNull default False;
property EventChar: Char read FEventChar write SetEventChar default #0;
property Events: TComEvents read FEvents write FEvents;
property Buffer: TComBuffer read FBuffer write SetBuffer;
property FlowControl: TComFlowControl
read FFlowControl write SetFlowControl;
property Timeouts: TComTimeouts read FTimeouts write SetTimeouts;
property SyncMethod: TSyncMethod
read FSyncMethod write SetSyncMethod default smThreadSync;
property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen;
property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose;
property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen;
property OnBeforeClose: TNotifyEvent
read FOnBeforeClose write FOnBeforeClose;
property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar;
property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
property OnBreak: TNotifyEvent read FOnBreak write FOnBreak;
property OnRing: TNotifyEvent read FOnRing write FOnRing;
property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
property OnRLSDChange: TComSignalEvent
read FOnRLSDChange write FOnRLSDChange;
property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
property OnError: TComErrorEvent read FOnError write FOnError;
property OnRx80Full: TNotifyEvent read FOnRx80Full write FOnRx80Full;
end;

// publish the properties
TComPort = class(TCustomComPort)
property Connected;
property BaudRate;
property Port;
property Parity;
property StopBits;
property DataBits;
property DiscardNull;
property EventChar;
property Events;
property Buffer;
property FlowControl;
property Timeouts;
property SyncMethod;
property OnAfterOpen;
property OnAfterClose;
property OnBeforeOpen;
property OnBeforeClose;
property OnRxChar;
property OnRxBuf;
property OnTxEmpty;
property OnBreak;
property OnRing;
property OnCTSChange;
property OnDSRChange;
property OnRLSDChange;
property OnRxFlag;
property OnError;
property OnRx80Full;
end;

TComStrEvent = procedure(Sender: TObject; const Str: string) of object;
TCustPacketEvent = procedure(Sender: TObject; const Str: string;
var Pos: Integer) of object;

// component for reading data in packets
TComDataPacket = class(TComponent)
private
FComLink: TComLink;
FComPort: TCustomComPort;
FStartString: string;
FStopString: string;
FMaxBufferSize: Integer;
FSize: Integer;
FIncludeStrings: Boolean;
FCaseInsensitive: Boolean;
FInPacket: Boolean;
FBuffer: string;
FOnPacket: TComStrEvent;
FOnDiscard: TComStrEvent;
FOnCustomStart: TCustPacketEvent;
FOnCustomStop: TCustPacketEvent;
procedure SetComPort(const Value: TCustomComPort);
procedure SetCaseInsensitive(const Value: Boolean);
procedure SetSize(const Value: Integer);
procedure SetStartString(const Value: string);
procedure SetStopString(const Value: string);
procedure RxBuf(Sender: TObject; const Buffer; Count: Integer);
procedure CheckIncludeStrings(var Str: string);
function Upper(const Str: string): string;
procedure EmptyBuffer;
function ValidStop: Boolean;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoDiscard(const Str: string); dynamic;
procedure DoPacket(const Str: string); dynamic;
procedure DoCustomStart(const Str: string; var Pos: Integer); dynamic;
procedure DoCustomStop(const Str: string; var Pos: Integer); dynamic;
procedure HandleBuffer; virtual;
property Buffer: string read FBuffer write FBuffer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddData(const Str: string);
published
property ComPort: TCustomComPort read FComPort write SetComPort;
property CaseInsensitive: Boolean
read FCaseInsensitive write SetCaseInsensitive default False;
property IncludeStrings: Boolean read FIncludeStrings write FIncludeStrings default False;
property MaxBufferSize: Integer read FMaxBufferSize write FMaxBufferSize default 1024;
property StartString: string read FStartString write SetStartString;
property StopString: string read FStopString write SetStopString;
property Size: Integer read FSize write SetSize default 0;
property OnDiscard: TComStrEvent read FOnDiscard write FOnDiscard;
property OnPacket: TComStrEvent read FOnPacket write FOnPacket;
property OnCustomStart: TCustPacketEvent
read FOnCustomStart write FOnCustomStart;
property OnCustomStop: TCustPacketEvent
read FOnCustomStop write FOnCustomStop;
end;

// exception class for ComPort Library errors
EComPort = class(Exception)
private
FWinCode: Integer;
FCode: Integer;
public
constructor Create(ACode: Integer; AWinCode: Integer);
constructor CreateNoWinCode(ACode: Integer);
property WinCode: Integer read FWinCode write FWinCode;
property Code: Integer read FCode write FCode;
end;

// aditional procedures
procedure InitAsync(var AsyncPtr: PAsync);
procedure DoneAsync(var AsyncPtr: PAsync);
procedure EnumComPorts(Ports: TStrings);

// conversion functions
function StrToBaudRate(Str: string): TBaudRate;
function StrToStopBits(Str: string): TStopBits;
function StrToDataBits(Str: string): TDataBits;
function StrToParity(Str: string): TParityBits;
function StrToFlowControl(Str: string): TFlowControl;
function BaudRateToStr(BaudRate: TBaudRate): string;
function StopBitsToStr(StopBits: TStopBits): string;
function DataBitsToStr(DataBits: TDataBits): string;
function ParityToStr(Parity: TParityBits): string;
function FlowControlToStr(FlowControl: TFlowControl): string;

const
// infinite wait
WaitInfinite = Integer(INFINITE);

// error codes
CError_OpenFailed = 1;
CError_WriteFailed = 2;
CError_ReadFailed = 3;
CError_InvalidAsync = 4;
CError_PurgeFailed = 5;
CError_AsyncCheck = 6;
CError_SetStateFailed = 7;
CError_TimeoutsFailed = 8;
CError_SetupComFailed = 9;
CError_ClearComFailed = 10;
CError_ModemStatFailed = 11;
CError_EscapeComFailed = 12;
CError_TransmitFailed = 13;
CError_SyncMeth = 14;
CError_EnumPortsFailed = 15;
CError_StoreFailed = 16;
CError_LoadFailed = 17;
CError_RegFailed = 18;
CError_LedStateFailed = 19;
CError_ThreadCreated = 20;
CError_WaitFailed = 21;
CError_HasLink = 22;

implementation

uses
CPortSetup, Controls, Forms, WinSpool;

const
// error messages
ComErrorMessages: array[1..22] of string =
('Unable to open com port',
'WriteFile function failed',
'ReadFile function failed',
'Invalid Async parameter',
'PurgeComm function failed',
'Unable to get async status',
'SetCommState function failed',
'SetCommTimeouts failed',
'SetupComm function failed',
'ClearCommError function failed',
'GetCommModemStatus function failed',
'EscapeCommFunction function failed',
'TransmitCommChar function failed',
'Cannot set SyncMethod while connected',
'EnumPorts function failed',
'Failed to store settings',
'Failed to load settings',
'Link (un)registration failed',
'Cannot change led state if ComPort is selected',
'Cannot wait for event if event thread is created',
'WaitForEvent method failed',
'A component is linked to OnRxBuf event');

// auxilary constants used not defined in windows.pas
dcb_Binary = $00000001;
dcb_Parity = $00000002;
dcb_OutxCTSFlow = $00000004;
dcb_OutxDSRFlow = $00000008;
dcb_DTRControl = $00000030;
dcb_DSRSensivity = $00000040;
dcb_TxContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_Null = $00000800;
dcb_RTSControl = $00003000;
dcb_AbortOnError = $00004000;

// com port window message
CM_COMPORT = WM_USER + 1;

(*****************************************
* auxilary functions and procedures *
*****************************************)

// converts TComEvents type to Integer
function EventsToInt(const Events: TComEvents): Integer;
begin
Result := 0;
if evRxChar in Events then
Result := Result or EV_RXCHAR;
if evRxFlag in Events then
Result := Result or EV_RXFLAG;
if evTxEmpty in Events then
Result := Result or EV_TXEMPTY;
if evRing in Events then
Result := Result or EV_RING;
if evCTS in Events then
Result := Result or EV_CTS;
if evDSR in Events then
Result := Result or EV_DSR;
if evRLSD in Events then
Result := Result or EV_RLSD;
if evError in Events then
Result := Result or EV_ERR;
if evBreak in Events then
Result := Result or EV_BREAK;
if evRx80Full in Events then
Result := Result or EV_RX80FULL;
end;

function IntToEvents(Mask: Integer): TComEvents;
begin
Result := [];
if (EV_RXCHAR and Mask) <> 0 then
Result := Result + [evRxChar];
if (EV_TXEMPTY and Mask) <> 0 then
Result := Result + [evTxEmpty];
if (EV_BREAK and Mask) <> 0 then
Result := Result + [evBreak];
if (EV_RING and Mask) <> 0 then
Result := Result + [evRing];
if (EV_CTS and Mask) <> 0 then
Result := Result + [evCTS];
if (EV_DSR and Mask) <> 0 then
Result := Result + [evDSR];
if (EV_RXFLAG and Mask) <> 0 then
Result := Result + [evRxFlag];
if (EV_RLSD and Mask) <> 0 then
Result := Result + [evRLSD];
if (EV_ERR and Mask) <> 0 then
Result := Result + [evError];
if (EV_RX80FULL and Mask) <> 0 then
Result := Result + [evRx80Full];
end;

(*****************************************
* TComThread class *
*****************************************)

// create thread
constructor TComThread.Create(AComPort: TCustomComPort);
begin
inherited Create(True);
FStopEvent := CreateEvent(nil, True, False, nil);
FComPort := AComPort;
// select which events are monitored
SetCommMask(FComPort.Handle, EventsToInt(FComPort.Events));
// execute thread
Resume;
end;

// destroy thread
destructor TComThread.Destroy;
begin
Stop;
inherited Destroy;
end;

// thread action
procedure TComThread.Execute;
var
EventHandles: array[0..1] of THandle;
Overlapped: TOverlapped;
Signaled, BytesTrans, Mask: DWORD;
begin
FillChar(Overlapped, SizeOf(Overlapped), 0);
Overlapped.hEvent := CreateEvent(nil, True, True, nil);
EventHandles[0] := FStopEvent;
EventHandles[1] := Overlapped.hEvent;
repeat
// wait for event to occur on serial port
WaitCommEvent(FComPort.Handle, Mask, @Overlapped);
Signaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE);
// if event occurs, dispatch it
if (Signaled = WAIT_OBJECT_0 + 1)
and GetOverlappedResult(FComPort.Handle, Overlapped, BytesTrans, False)
then
begin
FEvents := IntToEvents(Mask);
DispatchComMsg;
end;
until Signaled <> (WAIT_OBJECT_0 + 1);
// clear buffers
SetCommMask(FComPort.Handle, 0);
PurgeComm(FComPort.Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
CloseHandle(Overlapped.hEvent);
CloseHandle(FStopEvent);
end;

// stop thread
procedure TComThread.Stop;
begin
SetEvent(FStopEvent);
Sleep(0);
end;

// dispatch events
procedure TComThread.DispatchComMsg;
begin
case FComPort.SyncMethod of
smThreadSync: Synchronize(DoEvents); // call events in main thread
smWindowSync: SendEvents; // call events in thread that opened the port
smNone: DoEvents; // call events inside monitoring thread
end;
end;

// send events to TCustomComPort component using window message
procedure TComThread.SendEvents;
begin
if evError in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_ERR, 0);
if evRxChar in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXCHAR, 0);
if evTxEmpty in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_TXEMPTY, 0);
if evBreak in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_BREAK, 0);
if evRing in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RING, 0);
if evCTS in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_CTS, 0);
if evDSR in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_DSR, 0);
if evRxFlag in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXFLAG, 0);
if evRing in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RLSD, 0);
if evRx80Full in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RX80FULL, 0);
end;

// call events
procedure TComThread.DoEvents;
begin
if evError in FEvents then
FComPort.CallError;
if evRxChar in FEvents then
FComPort.CallRxChar;
if evTxEmpty in FEvents then
FComPort.CallTxEmpty;
if evBreak in FEvents then
FComPort.CallBreak;
if evRing in FEvents then
FComPort.CallRing;
if evCTS in FEvents then
FComPort.CallCTSChange;
if evDSR in FEvents then
FComPort.CallDSRChange;
if evRxFlag in FEvents then
FComPort.CallRxFlag;
if evRLSD in FEvents then
FComPort.CallRLSDChange;
if evRx80Full in FEvents then
FComPort.CallRx80Full;
end;

(*****************************************
* TComTimeouts class *
*****************************************)

// create class
constructor TComTimeouts.Create;
begin
inherited Create;
FReadInterval := -1;
FWriteTotalM := 100;
FWriteTotalC := 1000;
end;

// copy properties to other class
procedure TComTimeouts.AssignTo(Dest: TPersistent);
begin
if Dest is TComTimeouts then
begin
with TComTimeouts(Dest) do
begin
FReadInterval := Self.ReadInterval;
FReadTotalM := Self.ReadTotalMultiplier;
FReadTotalC := Self.ReadTotalConstant;
FWriteTotalM := Self.WriteTotalMultiplier;
FWriteTotalC := Self.WriteTotalConstant;
end
end
else
inherited AssignTo(Dest);
end;

// select TCustomComPort to own this class
procedure TComTimeouts.SetComPort(const AComPort: TCustomComPort);
begin
FComPort := AComPort;
end;

// set read interval
procedure TComTimeouts.SetReadInterval(const Value: Integer);
begin
if Value <> FReadInterval then
begin
FReadInterval := Value;
// if possible, apply the changes
if FComPort <> nil then
FComPort.ApplyTimeouts;
end;
end;

// set read total constant
procedure TComTimeouts.SetReadTotalC(const Value: Integer);
begin
if Value <> FReadTotalC then
begin
FReadTotalC := Value;
if FComPort <> nil then
FComPort.ApplyTimeouts;
end;
end;

// set read total multiplier
procedure TComTimeouts.SetReadTotalM(const Value: Integer);
begin
if Value <> FReadTotalM then
begin
FReadTotalM := Value;
if FComPort <> nil then
FComPort.ApplyTimeouts;
end;
end;

// set write total constant
procedure TComTimeouts.SetWriteTotalC(const Value: Integer);
begin
if Value <> FWriteTotalC then
begin
FWriteTotalC := Value;
if FComPort <> nil then
FComPort.ApplyTimeouts;
end;
end;

// set write total multiplier
procedure TComTimeouts.SetWriteTotalM(const Value: Integer);
begin
if Value <> FWriteTotalM then
begin
FWriteTotalM := Value;
if FComPort <> nil then
FComPort.ApplyTimeouts;
end;
end;

(*****************************************
* TComFlowControl class *
*****************************************)

// create class
constructor TComFlowControl.Create;
begin
inherited Create;
FXonChar := #17;
FXoffChar := #19;
end;

// copy properties to other class
procedure TComFlowControl.AssignTo(Dest: TPersistent);
begin
if Dest is TComFlowControl then
begin
with TComFlowControl(Dest) do
begin
FOutCTSFlow := Self.OutCTSFlow;
FOutDSRFlow := Self.OutDSRFlow;
FControlDTR := Self.ControlDTR;
FControlRTS := Self.ControlRTS;
FXonXoffOut := Self.XonXoffOut;
FXonXoffIn := Self.XonXoffIn;
FTxContinueOnXoff := Self.TxContinueOnXoff;
FDSRSensitivity := Self.DSRSensitivity;
FXonChar := Self.XonChar;
FXoffChar := Self.XoffChar;
end
end
else
inherited AssignTo(Dest);
end;

// select TCustomComPort to own this class
procedure TComFlowControl.SetComPort(const AComPort: TCustomComPort);
begin
FComPort := AComPort;
end;

// set input flow control for DTR (data-terminal-ready)
procedure TComFlowControl.SetControlDTR(const Value: TDTRFlowControl);
begin
if Value <> FControlDTR then
begin
FControlDTR := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set input flow control for RTS (request-to-send)
procedure TComFlowControl.SetControlRTS(const Value: TRTSFlowControl);
begin
if Value <> FControlRTS then
begin
FControlRTS := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set ouput flow control for CTS (clear-to-send)
procedure TComFlowControl.SetOutCTSFlow(const Value: Boolean);
begin
if Value <> FOutCTSFlow then
begin
FOutCTSFlow := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set output flow control for DSR (data-set-ready)
procedure TComFlowControl.SetOutDSRFlow(const Value: Boolean);
begin
if Value <> FOutDSRFlow then
begin
FOutDSRFlow := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set software input flow control
procedure TComFlowControl.SetXonXoffIn(const Value: Boolean);
begin
if Value <> FXonXoffIn then
begin
FXonXoffIn := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set software ouput flow control
procedure TComFlowControl.SetXonXoffOut(const Value: Boolean);
begin
if Value <> FXonXoffOut then
begin
FXonXoffOut := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set DSR sensitivity
procedure TComFlowControl.SetDSRSensitivity(const Value: Boolean);
begin
if Value <> FDSRSensitivity then
begin
FDSRSensitivity := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set transfer continue when Xoff is sent
procedure TComFlowControl.SetTxContinueOnXoff(const Value: Boolean);
begin
if Value <> FTxContinueOnXoff then
begin
FTxContinueOnXoff := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set Xon char
procedure TComFlowControl.SetXonChar(const Value: Char);
begin
if Value <> FXonChar then
begin
FXonChar := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set Xoff char
procedure TComFlowControl.SetXoffChar(const Value: Char);
begin
if Value <> FXoffChar then
begin
FXoffChar := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// get common flow control
function TComFlowControl.GetFlowControl: TFlowControl;
begin
if (FControlRTS = rtsHandshake) and (FOutCTSFlow)
and (not FXonXoffIn) and (not FXonXoffOut)
then
Result := fcHardware
else
if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
and (FXonXoffIn) and (FXonXoffOut)
then
Result := fcSoftware
else
if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
and (not FXonXoffIn) and (not FXonXoffOut)
then
Result := fcNone
else
Result := fcCustom;
end;

// set common flow control
procedure TComFlowControl.SetFlowControl(const Value: TFlowControl);
begin
if Value <> fcCustom then
begin
FControlRTS := rtsDisable;
FOutCTSFlow := False;
FXonXoffIn := False;
FXonXoffOut := False;
case Value of
fcHardware:
begin
FControlRTS := rtsHandshake;
FOutCTSFlow := True;
end;
fcSoftware:
begin
FXonXoffIn := True;
FXonXoffOut := True;
end;
end;
end;
if FComPort <> nil then
FComPort.ApplyDCB;
end;

(*****************************************
* TComParity class *
*****************************************)

// create class
constructor TComParity.Create;
begin
inherited Create;
FBits := prNone;
end;

// copy properties to other class
procedure TComParity.AssignTo(Dest: TPersistent);
begin
if Dest is TComParity then
begin
with TComParity(Dest) do
begin
FBits := Self.Bits;
FCheck := Self.Check;
FReplace := Self.Replace;
FReplaceChar := Self.ReplaceChar;
end
end
else
inherited AssignTo(Dest);
end;

// select TCustomComPort to own this class
procedure TComParity.SetComPort(const AComPort: TCustomComPort);
begin
FComPort := AComPort;
end;

// set parity bits
procedure TComParity.SetBits(const Value: TParityBits);
begin
if Value <> FBits then
begin
FBits := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set check parity
procedure TComParity.SetCheck(const Value: Boolean);
begin
if Value <> FCheck then
begin
FCheck := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set replace on parity error
procedure TComParity.SetReplace(const Value: Boolean);
begin
if Value <> FReplace then
begin
FReplace := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

// set replace char
procedure TComParity.SetReplaceChar(const Value: Char);
begin
if Value <> FReplaceChar then
begin
FReplaceChar := Value;
if FComPort <> nil then
FComPort.ApplyDCB;
end;
end;

(*****************************************
* TComBuffer class *
*****************************************)

// create class
constructor TComBuffer.Create;
begin
inherited Create;
FInputSize := 1024;
FOutputSize := 1024;
end;

// copy properties to other class
procedure TComBuffer.AssignTo(Dest: TPersistent);
begin
if Dest is TComBuffer then
begin
with TComBuffer(Dest) do
begin
FOutputSize := Self.OutputSize;
FInputSize := Self.InputSize;
end
end
else
inherited AssignTo(Dest);
end;

// select TCustomComPort to own this class
procedure TComBuffer.SetComPort(const AComPort: TCustomComPort);
begin
FComPort := AComPort;
end;

// set input size
procedure TComBuffer.SetInputSize(const Value: Integer);
begin
if Value <> FInputSize then
begin
FInputSize := Value;
if (FInputSize mod 2) = 1 then
Dec(FInputSize);
if FComPort <> nil then
FComPort.ApplyBuffer;
end;
end;

// set ouput size
procedure TComBuffer.SetOutputSize(const Value: Integer);
begin
if Value <> FOutputSize then
begin
FOutputSize := Value;
if (FOutputSize mod 2) = 1 then
Dec(FOutputSize);
if FComPort <> nil then
FComPort.ApplyBuffer;
end;
end;

(*****************************************
* TCustomComPort component *
*****************************************)

// create component
constructor TCustomComPort.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// component cannot reside on inheritable forms
FComponentStyle := FComponentStyle - [csInheritable];
FLinks := TList.Create;
FTriggersOnRxChar := True;
FBaudRate := br9600;
FCustomBaudRate := 9600;
FPort := 'COM1';
FStopBits := sbOneStopBit;
FDataBits := dbEight;
FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
evCTS, evDSR, evError, evRLSD, evRx80Full];
FHandle := INVALID_HANDLE_VALUE;
FStoredProps := [spBasic];
FParity := TComParity.Create;
FParity.SetComPort(Self);
FFlowControl := TComFlowControl.Create;
FFlowControl.SetComPort(Self);
FTimeouts := TComTimeouts.Create;
FTimeouts.SetComPort(Self);
FBuffer := TComBuffer.Create;
FBuffer.SetComPort(Self);
end;

// destroy component
destructor TCustomComPort.Destroy;
begin
Close;
FBuffer.Free;
FFlowControl.Free;
FTimeouts.Free;
FParity.Free;
inherited Destroy;
FLinks.Free;
end;

// create handle to serial port
procedure TCustomComPort.CreateHandle;
begin
FHandle := CreateFile(
PChar('\\.\' + FPort),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED,
0);

if FHandle = INVALID_HANDLE_VALUE then
raise EComPort.Create(CError_OpenFailed, GetLastError);
end;

// destroy serial port handle
procedure TCustomComPort.DestroyHandle;
begin
if FHandle <> INVALID_HANDLE_VALUE then
CloseHandle(FHandle);
end;

procedure TCustomComPort.Loaded;
begin
inherited Loaded;
// open port if Connected is True at design-time
if FConnected and not (csDesigning in ComponentState) then
begin
FConnected := False;
try
Open;
except
Application.HandleException(Self);
end;
end;
end;

// call events which have been dispatch using window message
procedure TCustomComPort.WindowMethod(var Message: TMessage);
begin
with Message do
if Msg = CM_COMPORT then
try
case wParam of
EV_RXCHAR: CallRxChar;
EV_TXEMPTY: CallTxEmpty;
EV_BREAK: CallBreak;
EV_RING: CallRing;
EV_CTS: CallCTSChange;
EV_DSR: CallDSRChange;
EV_RXFLAG: CallRxFlag;
EV_RLSD: CallRLSDChange;
EV_ERR: CallError;
EV_RX80FULL: CallRx80Full;
end
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindow, Msg, wParam, lParam);
end;

// prevent from applying changes at runtime
procedure TCustomComPort.BeginUpdate;
begin
FUpdateCount := FUpdateCount + 1;
end;

// apply the changes made since BeginUpdate call
procedure TCustomComPort.EndUpdate;
begin
if FUpdateCount > 0 then
begin
FUpdateCount := FUpdateCount - 1;
if FUpdateCount = 0 then
SetupComPort;
end;
end;

// open port
procedure TCustomComPort.Open;
begin
// if already connected, do nothing
if not FConnected and not (csDesigning in ComponentState) then
begin
CallBeforeOpen;
// open port
CreateHandle;
FConnected := True;
try
// initialize port
SetupComPort;
except
// error occured during initialization, destroy handle
DestroyHandle;
FConnected := False;
raise;
end;
// if at least one event is set, create special thread to monitor port
if (FEvents = []) then
FThreadCreated := False
else
begin
if (FSyncMethod = smWindowSync) then
FWindow := AllocateHWnd(WindowMethod);
FEventThread := TComThread.Create(Self);
FThreadCreated := True;
end;
// port is succesfully opened, do any additional initialization
CallAfterOpen;
end;
end;

// close port
procedure TCustomComPort.Close;
begin
// if already closed, do nothing
if FConnected and not (csDesigning in ComponentState) then
begin
CallBeforeClose;
// abort all pending operations
AbortAllAsync;
// stop monitoring for events
if FThreadCreated then
begin
FEventThread.Free;
FThreadCreated := False;
if FSyncMethod = smWindowSync then
DeallocateHWnd(FWindow);
end;
// close port
DestroyHandle;
FConnected := False;
// port is closed, do any additional finalization
CallAfterClose;
end;
end;

// apply port properties
procedure TCustomComPort.ApplyDCB;
const
CParityBits: array[TParityBits] of Integer =
(NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
CStopBits: array[TStopBits] of Integer =
(ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
CBaudRate: array[TBaudRate] of Integer =
(0, 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);
CDataBits: array[TDataBits] of Integer = (5, 6, 7, 8);
CControlRTS: array[TRTSFlowControl] of Integer =
(RTS_CONTROL_DISABLE shl 12,
RTS_CONTROL_ENABLE shl 12,
RTS_CONTROL_HANDSHAKE shl 12,
RTS_CONTROL_TOGGLE shl 12);
CControlDTR: array[TDTRFlowControl] of Integer =
(DTR_CONTROL_DISABLE shl 4,
DTR_CONTROL_ENABLE shl 4,
DTR_CONTROL_HANDSHAKE shl 4);

var
DCB: TDCB;

begin
// if not connected or inside BeginUpdate/EndUpdate block, do nothing
if FConnected and (FUpdateCount = 0) and
not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
begin
DCB.DCBlength := SizeOf(TDCB);
DCB.XonLim := FBuffer.InputSize div 4;
DCB.XoffLim := DCB.XonLim;
DCB.EvtChar := Char(FEventChar);

DCB.Flags := dcb_Binary;
if FDiscardNull then
DCB.Flags := DCB.Flags or dcb_Null;

with FFlowControl do
begin
DCB.XonChar := XonChar;
DCB.XoffChar := XoffChar;
if OutCTSFlow then
DCB.Flags := DCB.Flags or dcb_OutxCTSFlow;
if OutDSRFlow then
DCB.Flags := DCB.Flags or dcb_OutxDSRFlow;
DCB.Flags := DCB.Flags or CControlDTR[ControlDTR]
or CControlRTS[ControlRTS];
if XonXoffOut then
DCB.Flags := DCB.Flags or dcb_OutX;
if XonXoffIn then
DCB.Flags := DCB.Flags or dcb_InX;
if DSRSensitivity then
DCB.Flags := DCB.Flags or dcb_DSRSensivity;
if TxContinueOnXoff then
DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff;
end;

DCB.Parity := CParityBits[FParity.Bits];
DCB.StopBits := CStopBits[FStopBits];
if FBaudRate <> brCustom then
DCB.BaudRate := CBaudRate[FBaudRate]
else
DCB.BaudRate := FCustomBaudRate;
DCB.ByteSize := CDataBits[FDataBits];

if FParity.Check then
begin
DCB.Flags := DCB.Flags or dcb_Parity;
if FParity.Replace then
begin
DCB.Flags := DCB.Flags or dcb_ErrorChar;
DCB.ErrorChar := Char(FParity.ReplaceChar);
end;
end;

// apply settings
if not SetCommState(FHandle, DCB) then
raise EComPort.Create(CError_SetStateFailed, GetLastError);
end;
end;

// apply timeout properties
procedure TCustomComPort.ApplyTimeouts;
var
Timeouts: TCommTimeouts;

function GetTOValue(const Value: Integer): DWORD;
begin
if Value = -1 then
Result := MAXDWORD
else
Result := Value;
end;

begin
// if not connected or inside BeginUpdate/EndUpdate block, do nothing
if FConnected and (FUpdateCount = 0) and
not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
begin
Timeouts.ReadIntervalTimeout := GetTOValue(FTimeouts.ReadInterval);
Timeouts.ReadTotalTimeoutMultiplier := GetTOValue(FTimeouts.ReadTotalMultiplier);
Timeouts.ReadTotalTimeoutConstant := GetTOValue(FTimeouts.ReadTotalConstant);
Timeouts.WriteTotalTimeoutMultiplier := GetTOValue(FTimeouts.WriteTotalMultiplier);
Timeouts.WriteTotalTimeoutConstant := GetTOValue(FTimeouts.WriteTotalConstant);

// apply settings
if not SetCommTimeouts(FHandle, Timeouts) then
raise EComPort.Create(CError_TimeoutsFailed, GetLastError);
end;
end;

// apply buffers
procedure TCustomComPort.ApplyBuffer;
begin
// if not connected or inside BeginUpdate/EndUpdate block, do nothing
if FConnected and (FUpdateCount = 0) and
not ((csDesigning in ComponentState) or (csLoading in ComponentState))
then
//apply settings
if not SetupComm(FHandle, FBuffer.InputSize, FBuffer.OutputSize) then
raise EComPort.Create(CError_SetupComFailed, GetLastError);
end;

// initialize port
procedure TCustomComPort.SetupComPort;
begin
ApplyBuffer;
ApplyDCB;
ApplyTimeouts;
end;

// get number of bytes in input buffer
function TCustomComPort.InputCount: Integer;
var
Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(FHandle, Errors, @ComStat) then
raise EComPort.Create(CError_ClearComFailed, GetLastError);
Result := ComStat.cbInQue;
end;

// get number of bytes in output buffer
function TCustomComPort.OutputCount: Integer;
var
Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(FHandle, Errors, @ComStat) then
raise EComPort.Create(CError_ClearComFailed, GetLastError);
Result := ComStat.cbOutQue;
end;

// get signals which are in high state
function TCustomComPort.Signals: TComSignals;
var
Status: DWORD;
begin
if not GetCommModemStatus(FHandle, Status) then
raise EComPort.Create(CError_ModemStatFailed, GetLastError);
Result := [];

if (MS_CTS_ON and Status) <> 0 then
Result := Result + [csCTS];
if (MS_DSR_ON and Status) <> 0 then
Result := Result + [csDSR];
if (MS_RING_ON and Status) <> 0 then
Result := Result + [csRing];
if (MS_RLSD_ON and Status) <> 0 then
Result := Result + [csRLSD];
end;

// get port state flags
function TCustomComPort.StateFlags: TComStateFlags;
var
Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(FHandle, Errors, @ComStat) then
raise EComPort.Create(CError_ClearComFailed, GetLastError);
Result := ComStat.Flags;
end;

// set hardware line break
procedure TCustomComPort.SetBreak(OnOff: Boolean);
var
Act: Integer;
begin
if OnOff then
Act := Windows.SETBREAK
else
Act := Windows.CLRBREAK;

if not EscapeCommFunction(FHandle, Act) then
raise EComPort.Create(CError_EscapeComFailed, GetLastError);
end;

// set DTR signal
procedure TCustomComPort.SetDTR(OnOff: Boolean);
var
Act: DWORD;
begin
if OnOff then
Act := Windows.SETDTR
else
Act := Windows.CLRDTR;

if not EscapeCommFunction(FHandle, Act) then
raise EComPort.Create(CError_EscapeComFailed, GetLastError);
end;

// set RTS signals
procedure TCustomComPort.SetRTS(OnOff: Boolean);
var
Act: DWORD;
begin
if OnOff then
Act := Windows.SETRTS
else
Act := Windows.CLRRTS;

if not EscapeCommFunction(FHandle, Act) then
raise EComPort.Create(CError_EscapeComFailed, GetLastError);
end;

// set XonXoff state
procedure TCustomComPort.SetXonXoff(OnOff: Boolean);
var
Act: DWORD;
begin
if OnOff then
Act := Windows.SETXON
else
Act := Windows.SETXOFF;

if not EscapeCommFunction(FHandle, Act) then
raise EComPort.Create(CError_EscapeComFailed, GetLastError);
end;

// clear input and/or output buffer
procedure TCustomComPort.ClearBuffer(Input, Output: Boolean);
var
Flag: DWORD;
begin
Flag := 0;
if Input then
Flag := PURGE_RXCLEAR;
if Output then
Flag := Flag or PURGE_TXCLEAR;

if not PurgeComm(FHandle, Flag) then
raise EComPort.Create(CError_PurgeFailed, GetLastError);
end;

// return last errors on port
function TCustomComPort.LastErrors: TComErrors;
var
Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(FHandle, Errors, @ComStat) then
raise EComPort.Create(CError_ClearComFailed, GetLastError);
Result := [];

if (CE_FRAME and Errors) <> 0 then
Result := Result + [ceFrame];
if ((CE_RXPARITY and Errors) <> 0) and FParity.Check then // get around a bug
Result := Result + [ceRxParity];
if (CE_OVERRUN and Errors) <> 0 then
Result := Result + [ceOverrun];
if (CE_RXOVER and Errors) <> 0 then
Result := Result + [ceRxOver];
if (CE_TXFULL and Errors) <> 0 then
Result := Result + [ceTxFull];
if (CE_BREAK and Errors) <> 0 then
Result := Result + [ceBreak];
if (CE_IOE and Errors) <> 0 then
Result := Result + [ceIO];
if (CE_MODE and Errors) <> 0 then
Result := Result + [ceMode];
end;

// prepare PAsync variable for read/write operation
procedure PrepareAsync(AKind: TOperationKind; const Buffer;
Count: Integer; AsyncPtr: PAsync);
begin
with AsyncPtr^ do
begin
Kind := AKind;
if Data <> nil then
FreeMem(Data);
GetMem(Data, Count);
Move(Buffer, Data^, Count);
Size := Count;
end;
end;

// perform asynchronous write operation
function TCustomComPort.WriteAsync(const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
var
Success: Boolean;
BytesTrans: DWORD;
begin
if AsyncPtr = nil then
raise EComPort.CreateNoWinCode(CError_InvalidAsync);
PrepareAsync(okWrite, Buffer, Count, AsyncPtr);

Success := WriteFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped)
or (GetLastError = ERROR_IO_PENDING);

if not Success then
raise EComPort.Create(CError_WriteFailed, GetLastError);

SendSignalToLink(leTx, True);
Result := BytesTrans;
end;

// perform synchronous write operation
function TCustomComPort.Write(const Buffer; Count: Integer): Integer;
var
AsyncPtr: PAsync;
begin
InitAsync(AsyncPtr);
try
WriteAsync(Buffer, Count, AsyncPtr);
Result := WaitForAsync(AsyncPtr);
finally
DoneAsync(AsyncPtr);
end;
end;

// perform asynchronous write operation
function TCustomComPort.WriteStrAsync(const Str: string; var AsyncPtr: PAsync): Integer;
begin
if Length(Str) > 0 then
Result := WriteAsync(Str[1], Length(Str), AsyncPtr)
else
Result := 0;
end;

// perform synchronous write operation
function TCustomComPort.WriteStr(const Str: string): Integer;
var
AsyncPtr: PAsync;
begin
InitAsync(AsyncPtr);
try
WriteStrAsync(Str, AsyncPtr);
Result := WaitForAsync(AsyncPtr);
finally
DoneAsync(AsyncPtr);
end;
end;

// perform asynchronous read operation
function TCustomComPort.ReadAsync(var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
var
Success: Boolean;
BytesTrans: DWORD;
begin
if AsyncPtr = nil then
raise EComPort.CreateNoWinCode(CError_InvalidAsync);
AsyncPtr^.Kind := okRead;

Success := ReadFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped)
or (GetLastError = ERROR_IO_PENDING);

if not Success then
raise EComPort.Create(CError_ReadFailed, GetLastError);

Result := BytesTrans;
end;

// perform synchronous read operation
function TCustomComPort.Read(var Buffer; Count: Integer): Integer;
var
AsyncPtr: PAsync;
begin
InitAsync(AsyncPtr);
try
ReadAsync(Buffer, Count, AsyncPtr);
Result := WaitForAsync(AsyncPtr);
finally
DoneAsync(AsyncPtr);
end;
end;

// perform asynchronous read operation
function TCustomComPort.ReadStrAsync(var Str: string; Count: Integer; var AsyncPtr: PAsync): Integer;
begin
SetLength(Str, Count);
if Count > 0 then
Result := ReadAsync(Str[1], Count, AsyncPtr)
else
Result := 0;
end;

// perform synchronous read operation
function TCustomComPort.ReadStr(var Str: string; Count: Integer): Integer;
var
AsyncPtr: PAsync;
begin
InitAsync(AsyncPtr);
try
ReadStrAsync(Str, Count, AsyncPtr);
Result := WaitForAsync(AsyncPtr);
SetLength(Str, Result);
finally
DoneAsync(AsyncPtr);
end;
end;

function ErrorCode(AsyncPtr: PAsync): Integer;
begin
Result := 0;
case AsyncPtr^.Kind of
okWrite: Result := CError_WriteFailed;
okRead: Result := CError_ReadFailed;
end;
end;

// wait for asynchronous operation to end
function TCustomComPort.WaitForAsync(var AsyncPtr: PAsync): Integer;
var
BytesTrans, Signaled: DWORD;
Success: Boolean;
begin
if AsyncPtr = nil then
raise EComPort.CreateNoWinCode(CError_InvalidAsync);

Signaled := WaitForSingleObject(AsyncPtr^.Overlapped.hEvent, INFINITE);
Success := (Signaled = WAIT_OBJECT_0) and
(GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False));

if not Success then
raise EComPort.Create(ErrorCode(AsyncPtr), GetLastError);

if (AsyncPtr^.Kind = okRead) and (InputCount = 0) then
SendSignalToLink(leRx, False)
else
if AsyncPtr^.Data <> nil then
TxNotifyLink(AsyncPtr^.Data^, AsyncPtr^.Size);

Result := BytesTrans;
end;

// abort all asynchronous operations
procedure TCustomComPort.AbortAllAsync;
begin
if not PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT) then
raise EComPort.Create(CError_PurgeFailed, GetLastError);
end;

// detect whether asynchronous operation is completed
function TCustomComPort.IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
var
BytesTrans: DWORD;
begin
if AsyncPtr = nil then
raise EComPort.CreateNoWinCode(CError_InvalidAsync);

Result := GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False);
if not Result then
if GetLastError <> ERROR_IO_PENDING then
raise EComPort.Create(CError_AsyncCheck, GetLastError);
end;

// waits for event to occur on serial port
procedure TCustomComPort.WaitForEvent(var Events: TComEvents;
StopEvent: THandle; Timeout: Integer);
var
Overlapped: TOverlapped;
Mask: DWORD;
Success: Boolean;
Signaled, EventHandleCount: Integer;
EventHandles: array[0..1] of THandle;
begin
// cannot call method if event thread is running
if FThreadCreated then
raise EComPort.CreateNoWinCode(CError_ThreadCreated);

FillChar(Overlapped, SizeOf(TOverlapped), 0);
Overlapped.hEvent := CreateEvent(nil, True, False, nil);
EventHandles[0] := Overlapped.hEvent;
if StopEvent <> 0 then
begin
EventHandles[1] := StopEvent;
EventHandleCount := 2;
end
else
EventHandleCount := 1;

try
SetCommMask(FHandle, EventsToInt(Events));
// let's wait for event or timeout
Success := WaitCommEvent(FHandle, Mask, @Overlapped);

if (Success) or (GetLastError = ERROR_IO_PENDING) then
begin
Signaled := WaitForMultipleObjects(EventHandleCount, @EventHandles,
False, Timeout);
Success := (Signaled = WAIT_OBJECT_0)
or (Signaled = WAIT_OBJECT_0 + 1) or (Signaled = WAIT_TIMEOUT);
SetCommMask(FHandle, 0);
end;

if not Success then
raise EComPort.Create(CError_WaitFailed, GetLastError);

Events := IntToEvents(Mask);
finally
CloseHandle(Overlapped.hEvent);
end;
end;

// transmit char ahead of any pending data in ouput buffer
procedure TCustomComPort.TransmitChar(Ch: Char);
begin
if not TransmitCommChar(FHandle, Ch) then
raise EComPort.Create(CError_TransmitFailed, GetLastError);
end;

// show port setup dialog
procedure TCustomComPort.ShowSetupDialog;
begin
EditComPort(Self);
end;

// some conversion routines
function BoolToStr(const Value: Boolean): string;
begin
if Value then
Result := 'Yes'
else
Result := 'No';
end;

function StrToBool(const Value: string): Boolean;
begin
if UpperCase(Value) = 'YES' then
Result := True
else
Result := False;
end;

function DTRToStr(DTRFlowControl: TDTRFlowControl): string;
const
DTRStrings: array[TDTRFlowControl] of string = ('Disable', 'Enable',
'Handshake');
begin
Result := DTRStrings[DTRFlowControl];
end;

function RTSToStr(RTSFlowControl: TRTSFlowControl): string;
const
RTSStrings: array[TRTSFlowControl] of string = ('Disable', 'Enable',
'Handshake', 'Toggle');
begin
Result := RTSStrings[RTSFlowControl];
end;

function StrToRTS(Str: string): TRTSFlowControl;
var
I: TRTSFlowControl;
begin
I := Low(TRTSFlowControl);
while (I <= High(TRTSFlowControl)) do
begin
if UpperCase(Str) = UpperCase(RTSToStr(I)) then
Break;
I := Succ(I);
end;
if I > High(TRTSFlowControl) then
Result := rtsDisable
else
Result := I;
end;

function StrToDTR(Str: string): TDTRFlowControl;
var
I: TDTRFlowControl;
begin
I := Low(TDTRFlowControl);
while (I <= High(TDTRFlowControl)) do
begin
if UpperCase(Str) = UpperCase(DTRToStr(I)) then
Break;
I := Succ(I);
end;
if I > High(TDTRFlowControl) then
Result := dtrDisable
else
Result := I;
end;

function StrToChar(Str: string): Char;
var
A: Integer;
begin
if Length(Str) > 0 then
begin
if (Str[1] = '#') and (Length(Str) > 1) then
begin
try
A := StrToInt(Copy(Str, 2, Length(Str) - 1));
except
A := 0;
end;
Result := Chr(Byte(A));
end
else
Result := Str[1];
end
else
Result := #0;
end;

function CharToStr(Ch: Char): string;
begin
if Ch in [#33..#127] then
Result := Ch
else
Result := '#' + IntToStr(Ord(Ch));
end;

// store settings to ini file
procedure TCustomComPort.StoreIniFile(IniFile: TIniFile);
begin
if spBasic in FStoredProps then
begin
IniFile.WriteString(Name, 'Port', Port);
IniFile.WriteString(Name, 'BaudRate', BaudRateToStr(BaudRate));
if BaudRate = brCustom then
IniFile.WriteInteger(Name, 'CustomBaudRate', CustomBaudRate);
IniFile.WriteString(Name, 'StopBits', StopBitsToStr(StopBits));
IniFile.WriteString(Name, 'DataBits', DataBitsToStr(DataBits));
IniFile.WriteString(Name, 'Parity', ParityToStr(Parity.Bits));
IniFile.WriteString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl));
end;
if spOthers in FStoredProps then
begin
IniFile.WriteString(Name, 'EventChar', CharToStr(EventChar));
IniFile.WriteString(Name, 'DiscardNull', BoolToStr(DiscardNull));
end;
if spParity in FStoredProps then
begin
IniFile.WriteString(Name, 'Parity.Check', BoolToStr(Parity.Check));
IniFile.WriteString(Name, 'Parity.Replace', BoolToStr(Parity.Replace));
IniFile.WriteString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar));
end;
if spBuffer in FStoredProps then
begin
IniFile.WriteInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize);
IniFile.WriteInteger(Name, 'Buffer.InputSize', Buffer.InputSize);
end;
if spTimeouts in FStoredProps then
begin
IniFile.WriteInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval);
IniFile.WriteInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
IniFile.WriteInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
IniFile.WriteInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
IniFile.WriteInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
end;
if spFlowControl in FStoredProps then
begin
IniFile.WriteString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS));
IniFile.WriteString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR));
IniFile.WriteString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity));
IniFile.WriteString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow));
IniFile.WriteString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow));
IniFile.WriteString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff));
IniFile.WriteString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn));
IniFile.WriteString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut));
IniFile.WriteString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar));
IniFile.WriteString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar));
end;
end;

// store settings to registry
procedure TCustomComPort.StoreRegistry(Reg: TRegistry);
begin
if spBasic in FStoredProps then
begin
Reg.WriteString('Port', Port);
Reg.WriteString('BaudRate', BaudRateToStr(BaudRate));
if BaudRate = brCustom then
Reg.WriteInteger('CustomBaudRate', CustomBaudRate);
Reg.WriteString('StopBits', StopBitsToStr(StopBits));
Reg.WriteString('DataBits', DataBitsToStr(DataBits));
Reg.WriteString('Parity', ParityToStr(Parity.Bits));
Reg.WriteString('FlowControl', FlowControlToStr(FlowControl.FlowControl));
end;
if spOthers in FStoredProps then
begin
Reg.WriteString('EventChar', CharToStr(EventChar));
Reg.WriteString('DiscardNull', BoolToStr(DiscardNull));
end;
if spParity in FStoredProps then
begin
Reg.WriteString('Parity.Check', BoolToStr(Parity.Check));
Reg.WriteString('Parity.Replace', BoolToStr(Parity.Replace));
Reg.WriteString('Parity.ReplaceChar', CharToStr(Parity.ReplaceChar));
end;
if spBuffer in FStoredProps then
begin
Reg.WriteInteger('Buffer.OutputSize', Buffer.OutputSize);
Reg.WriteInteger('Buffer.InputSize', Buffer.InputSize);
end;
if spTimeouts in FStoredProps then
begin
Reg.WriteInteger('Timeouts.ReadInterval', Timeouts.ReadInterval);
Reg.WriteInteger('Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
Reg.WriteInteger('Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
Reg.WriteInteger('Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
Reg.WriteInteger('Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
end;
if spFlowControl in FStoredProps then
begin
Reg.WriteString('FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS));
Reg.WriteString('FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR));
Reg.WriteString('FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity));
Reg.WriteString('FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow));
Reg.WriteString('FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow));
Reg.WriteString('FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff));
Reg.WriteString('FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn));
Reg.WriteString('FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut));
Reg.WriteString('FlowControl.XoffChar', CharToStr(FlowControl.XoffChar));
Reg.WriteString('FlowControl.XonChar', CharToStr(FlowControl.XonChar));
end;
end;

// load settings from ini file
procedure TCustomComPort.LoadIniFile(IniFile: TIniFile);
begin
if spBasic in FStoredProps then
begin
Port := IniFile.ReadString(Name, 'Port', Port);
BaudRate := StrToBaudRate(IniFile.ReadString(Name, 'BaudRate', BaudRateToStr(BaudRate)));
if BaudRate = brCustom then
CustomBaudRate := IniFile.ReadInteger(Name, 'CustomBaudRate', 9600);
StopBits := StrToStopBits(IniFile.ReadString(Name, 'StopBits', StopBitsToStr(StopBits)));
DataBits := StrToDataBits(IniFile.ReadString(Name, 'DataBits', DataBitsToStr(DataBits)));
Parity.Bits := StrToParity(IniFile.ReadString(Name, 'Parity', ParityToStr(Parity.Bits)));
FlowControl.FlowControl := StrToFlowControl(
IniFile.ReadString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl)));
end;
if spOthers in FStoredProps then
begin
EventChar := StrToChar(IniFile.ReadString(Name, 'EventChar', CharToStr(EventChar)));
DiscardNull := StrToBool(IniFile.ReadString(Name, 'DiscardNull', BoolToStr(DiscardNull)));
end;
if spParity in FStoredProps then
begin
Parity.Check := StrToBool(IniFile.ReadString(Name, 'Parity.Check', BoolToStr(Parity.Check)));
Parity.Replace := StrToBool(IniFile.ReadString(Name, 'Parity.Replace', BoolToStr(Parity.Replace)));
Parity.ReplaceChar := StrToChar(IniFile.ReadString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar)));
end;
if spBuffer in FStoredProps then
begin
Buffer.OutputSize := IniFile.ReadInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize);
Buffer.InputSize := IniFile.ReadInteger(Name, 'Buffer.InputSize', Buffer.InputSize);
end;
if spTimeouts in FStoredProps then
begin
Timeouts.ReadInterval := IniFile.ReadInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval);
Timeouts.ReadTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
Timeouts.ReadTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
Timeouts.WriteTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
Timeouts.WriteTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
end;
if spFlowControl in FStoredProps then
begin
FlowControl.ControlRTS := StrToRTS(IniFile.ReadString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS)));
FlowControl.ControlDTR := StrToDTR(IniFile.ReadString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR)));
FlowControl.DSRSensitivity := StrToBool(IniFile.ReadString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity)));
FlowControl.OutCTSFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow)));
FlowControl.OutDSRFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutCTSFlow)));
FlowControl.TxContinueOnXoff := StrToBool(IniFile.ReadString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff)));
FlowControl.XonXoffIn := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn)));
FlowControl.XonXoffOut := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut)));
FlowControl.XoffChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar)));
FlowControl.XonChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar)));
end;
end;

// load settings from registry
procedure TCustomComPort.LoadRegistry(Reg: TRegistry);
begin
if spBasic in FStoredProps then
begin
Port := Reg.ReadString('Port');
BaudRate := StrToBaudRate(Reg.ReadString('BaudRate'));
if BaudRate = brCustom then
CustomBaudRate := Reg.ReadInteger('CustomBaudRate');
StopBits := StrToStopBits(Reg.ReadString('StopBits'));
DataBits := StrToDataBits(Reg.ReadString('DataBits'));
Parity.Bits := StrToParity(Reg.ReadString('Parity'));
FlowControl.FlowControl := StrToFlowControl(Reg.ReadString('FlowControl'));
end;
if spOthers in FStoredProps then
begin
EventChar := StrToChar(Reg.ReadString('EventChar'));
DiscardNull := StrToBool(Reg.ReadString('DiscardNull'));
end;
if spParity in FStoredProps then
begin
Parity.Check := StrToBool(Reg.ReadString('Parity.Check'));
Parity.Replace := StrToBool(Reg.ReadString('Parity.Replace'));
Parity.ReplaceChar := StrToChar(Reg.ReadString('Parity.ReplaceChar'));
end;
if spBuffer in FStoredProps then
begin
Buffer.OutputSize := Reg.ReadInteger('Buffer.OutputSize');
Buffer.InputSize := Reg.ReadInteger('Buffer.InputSize');
end;
if spTimeouts in FStoredProps then
begin
Timeouts.ReadInterval := Reg.ReadInteger('Timeouts.ReadInterval');
Timeouts.ReadTotalConstant := Reg.ReadInteger('Timeouts.ReadTotalConstant');
Timeouts.ReadTotalMultiplier := Reg.ReadInteger('Timeouts.ReadTotalMultiplier');
Timeouts.WriteTotalConstant := Reg.ReadInteger('Timeouts.WriteTotalConstant');
Timeouts.WriteTotalMultiplier := Reg.ReadInteger('Timeouts.WriteTotalMultiplier');
end;
if spFlowControl in FStoredProps then
begin
FlowControl.ControlRTS := StrToRTS(Reg.ReadString('FlowControl.ControlRTS'));
FlowControl.ControlDTR := StrToDTR(Reg.ReadString('FlowControl.ControlDTR'));
FlowControl.DSRSensitivity := StrToBool(Reg.ReadString('FlowControl.DSRSensitivity'));
FlowControl.OutCTSFlow := StrToBool(Reg.ReadString('FlowControl.OutCTSFlow'));
FlowControl.OutDSRFlow := StrToBool(Reg.ReadString('FlowControl.OutDSRFlow'));
FlowControl.TxContinueOnXoff := StrToBool(Reg.ReadString('FlowControl.TxContinueOnXoff'));
FlowControl.XonXoffIn := StrToBool(Reg.ReadString('FlowControl.XonXoffIn'));
FlowControl.XonXoffOut := StrToBool(Reg.ReadString('FlowControl.XonXoffOut'));
FlowControl.XoffChar := StrToChar(Reg.ReadString('FlowControl.XoffChar'));
FlowControl.XonChar := StrToChar(Reg.ReadString('FlowControl.XonChar'));
end;
end;

// initialize registry
procedure SetRegistry(Reg: TRegistry; Key: string; Name: string);
var
I: Integer;
Temp: string;
begin
I := Pos('\', Key);
if I > 0 then
begin
Temp := Copy(Key, 1, I - 1);
if UpperCase(Temp) = 'HKEY_LOCAL_MACHINE' then
Reg.RootKey := HKEY_LOCAL_MACHINE
else
if UpperCase(Temp) = 'HKEY_CURRENT_USER' then
Reg.RootKey := HKEY_CURRENT_USER;
Key := Copy(Key, I + 1, Length(Key) - I);
if Key[Length(Key)] <> '\' then
Key := Key + '\';
Key := Key + Name;
Reg.OpenKey(Key, True);
end;
end;

// store settings
procedure TCustomComPort.StoreSettings(StoreType: TStoreType; StoreTo: string);
var
IniFile: TIniFile;
Reg: TRegistry;
begin
try
if StoreType = stRegistry then
begin
Reg := TRegistry.Create;
try
SetRegistry(Reg, StoreTo, Name);
StoreRegistry(Reg);
finally
Reg.Free;
end
end else
begin
IniFile := TIniFile.Create(StoreTo);
try
StoreIniFile(IniFile);
finally
IniFile.Free;
end
end;
except
raise EComPort.CreateNoWinCode(CError_StoreFailed);
end;
end;

// load settings
procedure TCustomComPort.LoadSettings(StoreType: TStoreType; LoadFrom: string);
var
IniFile: TIniFile;
Reg: TRegistry;
begin
BeginUpdate;
try
try
if StoreType = stRegistry then
begin
Reg := TRegistry.Create;
try
SetRegistry(Reg, LoadFrom, Name);
LoadRegistry(Reg);
finally
Reg.Free;
end
end else
begin
IniFile := TIniFile.Create(LoadFrom);
try
LoadIniFile(IniFile);
finally
IniFile.Free;
end
end;
finally
EndUpdate;
end;
except
raise EComPort.CreateNoWinCode(CError_LoadFailed);
end;
end;

// register link from other component to TCustomComPort
procedure TCustomComPort.RegisterLink(AComLink: TComLink);
begin
if FLinks.IndexOf(Pointer(AComLink)) > -1 then
raise EComPort.CreateNoWinCode(CError_RegFailed)
else
FLinks.Add(Pointer(AComLink));
FHasLink := HasLink;
end;

// unregister link from other component to TCustomComPort
procedure TCustomComPort.UnRegisterLink(AComLink: TComLink);
begin
if FLinks.IndexOf(Pointer(AComLink)) = -1 then
raise EComPort.CreateNoWinCode(CError_RegFailed)
else
FLinks.Remove(Pointer(AComLink));
FHasLink := HasLink;
end;

// default actions on port events

procedure TCustomComPort.DoBeforeClose;
begin
if Assigned(FOnBeforeClose) then
FOnBeforeClose(Self);
end;

procedure TCustomComPort.DoBeforeOpen;
begin
if Assigned(FOnBeforeOpen) then
FOnBeforeOpen(Self);
end;

procedure TCustomComPort.DoAfterOpen;
begin
if Assigned(FOnAfterOpen) then
FOnAfterOpen(Self);
end;

procedure TCustomComPort.DoAfterClose;
begin
if Assigned(FOnAfterClose) then
FOnAfterClose(Self);
end;

procedure TCustomComPort.DoRxChar(Count: Integer);
begin
if Assigned(FOnRxChar) then
FOnRxChar(Self, Count);
end;

procedure TCustomComPort.DoRxBuf(const Buffer; Count: Integer);
begin
if Assigned(FOnRxBuf) then
FOnRxBuf(Self, Buffer, Count);
end;

procedure TCustomComPort.DoBreak;
begin
if Assigned(FOnBreak) then
FOnBreak(Self);
end;

procedure TCustomComPort.DoTxEmpty;
begin
if Assigned(FOnTxEmpty)
then FOnTxEmpty(Self);
end;

procedure TCustomComPort.DoRing;
begin
if Assigned(FOnRing) then
FOnRing(Self);
end;

procedure TCustomComPort.DoCTSChange(OnOff: Boolean);
begin
if Assigned(FOnCTSChange) then
FOnCTSChange(Self, OnOff);
end;

procedure TCustomComPort.DoDSRChange(OnOff: Boolean);
begin
if Assigned(FOnDSRChange) then
FOnDSRChange(Self, OnOff);
end;

procedure TCustomComPort.DoRLSDChange(OnOff: Boolean);
begin
if Assigned(FOnRLSDChange) then
FOnRLSDChange(Self, OnOff);
end;

procedure TCustomComPort.DoError(Errors: TComErrors);
begin
if Assigned(FOnError) then
FOnError(Self, Errors);
end;

procedure TCustomComPort.DoRxFlag;
begin
if Assigned(FOnRxFlag) then
FOnRxFlag(Self);
end;

procedure TCustomComPort.DoRx80Full;
begin
if Assigned(FOnRx80Full) then
FOnRx80Full(Self);
end;

// set signals to false on close, and to proper value on open,
// because OnXChange events are not called automatically
procedure TCustomComPort.CheckSignals(Open: Boolean);
begin
if Open then
begin
CallCTSChange;
CallDSRChange;
CallRLSDChange;
end else
begin
SendSignalToLink(leCTS, False);
SendSignalToLink(leDSR, False);
SendSignalToLink(leRLSD, False);
DoCTSChange(False);
DoDSRChange(False);
DoRLSDChange(False);
end;
end;

// called in response to EV_X events, except CallXClose, CallXOpen

procedure TCustomComPort.CallAfterClose;
begin
SendSignalToLink(leConn, False);
DoAfterClose;
end;

procedure TCustomComPort.CallAfterOpen;
begin
SendSignalToLink(leConn, True);
DoAfterOpen;
CheckSignals(True);
end;

procedure TCustomComPort.CallBeforeClose;
begin
// shutdown com signals manually
CheckSignals(False);
DoBeforeClose;
end;

procedure TCustomComPort.CallBeforeOpen;
begin
DoBeforeOpen;
end;

procedure TCustomComPort.CallBreak;
begin
DoBreak;
end;

procedure TCustomComPort.CallCTSChange;
var
OnOff: Boolean;
begin
OnOff := csCTS in Signals;
// check for linked components
SendSignalToLink(leCTS, OnOff);
DoCTSChange(OnOff);
end;

procedure TCustomComPort.CallDSRChange;
var
OnOff: Boolean;
begin
OnOff := csDSR in Signals;
// check for linked components
SendSignalToLink(leDSR, OnOff);
DoDSRChange(OnOff);
end;

procedure TCustomComPort.CallRLSDChange;
var
OnOff: Boolean;
begin
OnOff := csRLSD in Signals;
// check for linked components
SendSignalToLink(leRLSD, OnOff);
DoRLSDChange(OnOff);
end;

procedure TCustomComPort.CallError;
var
Errors: TComErrors;
begin
Errors := LastErrors;
if Errors <> [] then
DoError(Errors);
end;

procedure TCustomComPort.CallRing;
begin
NotifyLink(leRing);
DoRing;
end;

procedure TCustomComPort.CallRx80Full;
begin
DoRx80Full;
end;

procedure TCustomComPort.CallRxChar;
var
Count: Integer;

// read from input buffer
procedure PerformRead(var P: Pointer);
begin
GetMem(P, Count);
Read(P^, Count);
// call OnRxBuf event
DoRxBuf(P^, Count);
end;

// check if any component is linked, to OnRxChar event
procedure CheckLinks;
{$WARNINGS OFF}
var
I: Integer;
P: Pointer;
ComLink: TComLink;
ReadFromBuffer: Boolean;
begin
// examine links
if (Count > 0) and (not TriggersOnRxChar) then
begin
ReadFromBuffer := False;
try
// cycle through links
for I := 0 to FLinks.Count - 1 do
begin
ComLink := TComLink(FLinks[I]);
if Assigned(ComLink.OnRxBuf) then
begin
// link to OnRxChar event found
if not ReadFromBuffer then
begin
// TCustomComPort must read from comport, so OnRxChar event is
// not triggered
ReadFromBuffer := True;
PerformRead(P);
end;
// send data to linked component
ComLink.OnRxBuf(Self, P^, Count);
end
end;
if (not ReadFromBuffer) and (not FTriggersOnRxChar) then
begin
ReadFromBuffer := True;
PerformRead(P);
end;
finally
if ReadFromBuffer then
begin
FreeMem(P);
// data is already out of buffer, prevent from OnRxChar event to occur
Count := 0;
end;
end;
end;
end;

begin
Count := InputCount;
if Count > 0 then
SendSignalToLink(leRx, True);
CheckLinks;
if Count > 0 then
DoRxChar(Count);
end;

procedure TCustomComPort.CallRxFlag;
begin
NotifyLink(leRxFlag);
DoRxFlag;
end;

procedure TCustomComPort.CallTxEmpty;
begin
SendSignalToLink(leTx, False);
NotifyLink(leTxEmpty);
DoTxEmpty;
end;

// returns true if it has least one component linked to OnRxBuf event
function TCustomComPort.HasLink: Boolean;
var
I: Integer;
ComLink: TComLink;
begin
Result := False;
// examine links
if FLinks.Count > 0 then
for I := 0 to FLinks.Count - 1 do
begin
ComLink := TComLink(FLinks[I]);
if Assigned(ComLink.OnRxBuf) then
Result := True;
end;
end;

// send TxBuf notify to link
procedure TCustomComPort.TxNotifyLink(const Buffer; Count: Integer);
var
I: Integer;
ComLink: TComLink;
begin
if (FLinks.Count > 0) then
for I := 0 to FLinks.Count - 1 do
begin
ComLink := TComLink(FLinks[I]);
if Assigned(ComLink.OnTxBuf) then
ComLink.OnTxBuf(Self, Buffer, Count);
end;
end;

// send event notification to link
procedure TCustomComPort.NotifyLink(FLinkEvent: TComLinkEvent);
var
I: Integer;
ComLink: TComLink;
Event: TNotifyEvent;
begin
if (FLinks.Count > 0) then
for I := 0 to FLinks.Count - 1 do
begin
ComLink := TComLink(FLinks[I]);
Event := nil;
case FLinkEvent of
leRing: Event := ComLink.OnRing;
leTxEmpty: Event := ComLink.OnTxEmpty;
leRxFlag: Event := ComLink.OnRxFlag;
end;
if Assigned(Event) then
Event(Self);
end;
end;

// send signal to linked components
procedure TCustomComPort.SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean);
var
I: Integer;
ComLink: TComLink;
SignalEvent: TComSignalEvent;
begin
if (FLinks.Count > 0) then
// cycle through links
for I := 0 to FLinks.Count - 1 do
begin
ComLink := TComLink(FLinks[I]);
SignalEvent := nil;
case Signal of
leCTS: SignalEvent := ComLink.OnCTSChange;
leDSR: SignalEvent := ComLink.OnDSRChange;
leRLSD: SignalEvent := ComLink.OnRLSDChange;
leTx: SignalEvent := ComLink.OnTx;
leRx: SignalEvent := ComLink.OnRx;
leConn: SignalEvent := ComLink.OnConn;
end;
// if linked, trigger event
if Assigned(SignalEvent) then
SignalEvent(Self, OnOff);
end;
end;


// set connected property, same as Open/Close methods
procedure TCustomComPort.SetConnected(const Value: Boolean);
begin
if not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
begin
if Value <> FConnected then
if Value then
Open
else
Close;
end
else
FConnected := Value;
end;

// set baud rate
procedure TCustomComPort.SetBaudRate(const Value: TBaudRate);
begin
if Value <> FBaudRate then
begin
FBaudRate := Value;
// if possible, apply settings
ApplyDCB;
end;
end;

// set custom baud rate
procedure TCustomComPort.SetCustomBaudRate(const Value: Integer);
begin
if Value <> FCustomBaudRate then
begin
FCustomBaudRate := Value;
ApplyDCB;
end;
end;

// set data bits
procedure TCustomComPort.SetDataBits(const Value: TDataBits);
begin
if Value <> FDataBits then
begin
FDataBits := Value;
ApplyDCB;
end;
end;

// set discard null charachters
procedure TCustomComPort.SetDiscardNull(const Value: Boolean);
begin
if Value <> FDiscardNull then
begin
FDiscardNull := Value;
ApplyDCB;
end;
end;

// set event charachters
procedure TCustomComPort.SetEventChar(const Value: Char);
begin
if Value <> FEventChar then
begin
FEventChar := Value;
ApplyDCB;
end;
end;

// set port
procedure TCustomComPort.SetPort(const Value: TPort);
begin
// 11.1.2001 Ch. Kaufmann; removed function ComString, because there can be com ports
// with names other than COMn.
if Value <> FPort then
begin
FPort := Value;
if FConnected and not ((csDesigning in ComponentState) or
(csLoading in ComponentState)) then
begin
Close;
Open;
end;
end;
end;

// set stop bits
procedure TCustomComPort.SetStopBits(const Value: TStopBits);
begin
if Value <> FStopBits then
begin
FStopBits := Value;
ApplyDCB;
end;
end;

// set event synchronization method
procedure TCustomComPort.SetSyncMethod(const Value: TSyncMethod);
begin
if Value <> FSyncMethod then
begin
if FConnected and not ((csDesigning in ComponentState) or
(csLoading in ComponentState))
then
raise EComPort.CreateNoWinCode(CError_SyncMeth)
else
FSyncMethod := Value;
end;
end;

// sets RxChar triggering
procedure TCustomComPort.SetTriggersOnRxChar(const Value: Boolean);
begin
if FHasLink then
raise EComPort.CreateNoWinCode(CError_HasLink);
FTriggersOnRxChar := Value;
end;

// returns true if RxChar is triggered when data arrives input buffer
function TCustomComPort.GetTriggersOnRxChar: Boolean;
begin
Result := FTriggersOnRxChar and (not FHasLink);
end;

// set flow control
procedure TCustomComPort.SetFlowControl(const Value: TComFlowControl);
begin
FFlowControl.Assign(Value);
ApplyDCB;
end;

// set parity
procedure TCustomComPort.SetParity(const Value: TComParity);
begin
FParity.Assign(Value);
ApplyDCB;
end;

// set timeouts
procedure TCustomComPort.SetTimeouts(const Value: TComTimeouts);
begin
FTimeouts.Assign(Value);
ApplyTimeouts;
end;

// set buffer
procedure TCustomComPort.SetBuffer(const Value: TComBuffer);
begin
FBuffer.Assign(Value);
ApplyBuffer;
end;

(*****************************************
* TComDataPacket component *
*****************************************)

// create component
constructor TComDataPacket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FComLink := TComLink.Create;
FComLink.OnRxBuf := RxBuf;
FMaxBufferSize := 1024;
end;

// destroy component
destructor TComDataPacket.Destroy;
begin
ComPort := nil;
FComLink.Free;
inherited Destroy;
end;

// add custom data to packet buffer
procedure TComDataPacket.AddData(const Str: string);
begin
if ValidStop then
begin
Buffer := Buffer + Str;
HandleBuffer;
end
else
DoPacket(Str);
end;

// remove ComPort property if being destroyed
procedure TComDataPacket.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FComPort) and (Operation = opRemove) then
ComPort := nil;
end;

// call OnDiscard
procedure TComDataPacket.DoDiscard(const Str: string);
begin
if Assigned(FOnDiscard) then
FOnDiscard(Self, Str);
end;

// call OnPacket
procedure TComDataPacket.DoPacket(const Str: string);
begin
if Assigned(FOnPacket) then
FOnPacket(Self, Str);
end;

// call OnCustomStart
procedure TComDataPacket.DoCustomStart(const Str: string;
var Pos: Integer);
begin
if Assigned(FOnCustomStart) then
FOnCustomStart(Self, Str, Pos);
end;

// call OnCustomStop
procedure TComDataPacket.DoCustomStop(const Str: string; var Pos: Integer);
begin
if Assigned(FOnCustomStop) then
FOnCustomStop(Self, Str, Pos);
end;

// discard start and stop strings
procedure TComDataPacket.CheckIncludeStrings(var Str: string);
var
LenStart, LenStop: Integer;
begin
if FIncludeStrings then
Exit;
LenStart := Length(FStartString);
LenStop := Length(FStopString);
// remove start string
if Pos(Upper(FStartString), Upper(Str)) = 1 then
Str := Copy(Str, LenStart + 1, Length(Str) - LenStart);
// remove stop string
if Pos(Upper(FStopString), Upper(Str)) = (Length(Str) - LenStop + 1) then
Str := Copy(Str, 1, Length(Str) - LenStop);
end;

// upper case
function TComDataPacket.Upper(const Str: string): string;
begin
if FCaseInsensitive then
Result := UpperCase(Str)
else
Result := Str;
end;

// split buffer in packets
procedure TComDataPacket.HandleBuffer;

procedure DiscardPacketToPos(Pos: Integer);
var
Str: string;
begin
FInPacket := True;
if Pos > 1 then
begin
Str := Copy(Buffer, 1, Pos - 1); // some discarded data
Buffer := Copy(Buffer, Pos, Length(Buffer) - Pos + 1);
DoDiscard(Str);
end;
end;

procedure FormPacket(CutSize: Integer);
var
Str: string;
begin
Str := Copy(Buffer, 1, CutSize);
Buffer := Copy(Buffer, CutSize + 1, Length(Buffer) - CutSize);
CheckIncludeStrings(Str);
DoPacket(Str);
end;

procedure StartPacket;
var
Found: Integer;
begin
// check for custom start condition
Found := -1;
DoCustomStart(Buffer, Found);
if Found > 0 then
DiscardPacketToPos(Found);
if Found = -1 then
begin
if Length(FStartString) > 0 then // start string valid
begin
Found := Pos(Upper(FStartString), Upper(Buffer));
if Found > 0 then
DiscardPacketToPos(Found);
end
else
FInPacket := True;
end;
end;

procedure EndPacket;
var
Found, CutSize, Len: Integer;
begin
// check for custom stop condition
Found := -1;
DoCustomStop(Buffer, Found);
if Found > 0 then
begin
// custom stop condition detected
CutSize := Found;
FInPacket := False;
end
else
if Found = -1 then
begin
Len := Length(Buffer);
if (FSize > 0) and (Len >= FSize) then
begin
// size stop condition detected
FInPacket := False;
CutSize := FSize;
end
else
begin
Len := Length(FStartString);
Found := Pos(Upper(FStopString),
Upper(Copy(Buffer, Len + 1, Length(Buffer) - Len)));
if Found > 0 then
begin
// stop string stop condition detected
CutSize := Found + Length(FStopString) + Len - 1;
FInPacket := False;
end;
end;
end;
if not FInPacket then
FormPacket(CutSize); // create packet
end;

function IsBufferTooLarge: Boolean;
begin
Result := (Length(Buffer) >= FMaxBufferSize) and (FMaxBufferSize > 0);
end;

begin
try
if not FInPacket then
StartPacket;
if FInPacket then
begin
EndPacket;
if not FInPacket then
HandleBuffer;
end;
finally
if IsBufferTooLarge then
EmptyBuffer;
end;
end;

// is stop condition valid?
function TComDataPacket.ValidStop: Boolean;
begin
Result := (FSize > 0) or (Length(FStopString) > 0)
or (Assigned(FOnCustomStop));
end;

// receive data
procedure TComDataPacket.RxBuf(Sender: TObject; const Buffer; Count: Integer);
var
Str: string;

begin
SetLength(Str, Count);
Move(Buffer, Str[1], Count);
AddData(Str);
end;

// empty buffer
procedure TComDataPacket.EmptyBuffer;
begin
if Buffer <> '' then
begin
try
DoDiscard(Buffer);
finally
Buffer := '';
FInPacket := False;
end;
end;
end;

// set com port
procedure TComDataPacket.SetComPort(const Value: TCustomComPort);
begin
if Value <> FComPort then
begin
if FComPort <> nil then
FComPort.UnRegisterLink(FComLink);
FComPort := Value;
if FComPort <> nil then
begin
FComPort.FreeNotification(Self);
FComPort.RegisterLink(FComLink);
end;
end;
end;

// set case sensitivity
procedure TComDataPacket.SetCaseInsensitive(const Value: Boolean);
begin
if FCaseInsensitive <> Value then
begin
FCaseInsensitive := Value;
if not (csLoading in ComponentState) then
EmptyBuffer;
end;
end;

// set packet size
procedure TComDataPacket.SetSize(const Value: Integer);
begin
if FSize <> Value then
begin
FSize := Value;
if not (csLoading in ComponentState) then
EmptyBuffer;
end;
end;

// set start string
procedure TComDataPacket.SetStartString(const Value: string);
begin
if FStartString <> Value then
begin
FStartString := Value;
if not (csLoading in ComponentState) then
EmptyBuffer;
end;
end;

// set stop string
procedure TComDataPacket.SetStopString(const Value: string);
begin
if FStopString <> Value then
begin
FStopString := Value;
if not (csLoading in ComponentState) then
EmptyBuffer;
end;
end;

(*****************************************
* EComPort exception *
*****************************************)

// create exception with windows error code
constructor EComPort.Create(ACode: Integer; AWinCode: Integer);
begin
FWinCode := AWinCode;
FCode := ACode;
inherited CreateFmt(ComErrorMessages[ACode] + ' (win error code: %d)', [AWinCode]);
end;

// create exception
constructor EComPort.CreateNoWinCode(ACode: Integer);
begin
FWinCode := -1;
FCode := ACode;
inherited Create(ComErrorMessages[ACode]);
end;

(*****************************************
* other procedures/functions *
*****************************************)

// initialization of PAsync variables used in asynchronous calls
procedure InitAsync(var AsyncPtr: PAsync);
begin
New(AsyncPtr);
with AsyncPtr^ do
begin
FillChar(Overlapped, SizeOf(TOverlapped), 0);
Overlapped.hEvent := CreateEvent(nil, True, True, nil);
Data := nil;
Size := 0;
end;
end;

// clean-up of PAsync variable
procedure DoneAsync(var AsyncPtr: PAsync);
begin
with AsyncPtr^ do
begin
CloseHandle(Overlapped.hEvent);
if Data <> nil then
FreeMem(Data);
end;
Dispose(AsyncPtr);
AsyncPtr := nil;
end;

// 11.1.2001 Ch. Kaufmann; better version to get list of serial ports.
// This should work on every Windows version (2000, NT, 98, 95)
// enumerate serial ports on local computer
procedure EnumComPorts(Ports: TStrings);
var
I : Integer;
TmpPorts: TStringList;
begin
Ports.Clear;
with TRegistry.Create do
try
TmpPorts := TStringList.Create;
{$IFDEF DELPHI_5_OR_HIGHER}
Access := KEY_READ;
{$ENDIF}
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', False) then
begin
GetValueNames(TmpPorts);
for I := 0 to TmpPorts.Count - 1 do
TmpPorts[I] := ReadString(TmpPorts[I]);
TmpPorts.Sort;
Ports.Assign(TmpPorts);
TmpPorts.Free;
end;
finally
Free;
end;
end;

// string to baud rate
function StrToBaudRate(Str: string): TBaudRate;
var
I: TBaudRate;
begin
I := Low(TBaudRate);
while (I <= High(TBaudRate)) do
begin
if UpperCase(Str) = UpperCase(BaudRateToStr(TBaudRate(I))) then
Break;
I := Succ(I);
end;
if I > High(TBaudRate) then
Result := br9600
else
Result := I;
end;

// string to stop bits
function StrToStopBits(Str: string): TStopBits;
var
I: TStopBits;
begin
I := Low(TStopBits);
while (I <= High(TStopBits)) do
begin
if UpperCase(Str) = UpperCase(StopBitsToStr(TStopBits(I))) then
Break;
I := Succ(I);
end;
if I > High(TStopBits) then
Result := sbOneStopBit
else
Result := I;
end;

// string to data bits
function StrToDataBits(Str: string): TDataBits;
var
I: TDataBits;
begin
I := Low(TDataBits);
while (I <= High(TDataBits)) do
begin
if UpperCase(Str) = UpperCase(DataBitsToStr(I)) then
Break;
I := Succ(I);
end;
if I > High(TDataBits) then
Result := dbEight
else
Result := I;
end;

// string to parity
function StrToParity(Str: string): TParityBits;
var
I: TParityBits;
begin
I := Low(TParityBits);
while (I <= High(TParityBits)) do
begin
if UpperCase(Str) = UpperCase(ParityToStr(I)) then
Break;
I := Succ(I);
end;
if I > High(TParityBits) then
Result := prNone
else
Result := I;
end;

// string to flow control
function StrToFlowControl(Str: string): TFlowControl;
var
I: TFlowControl;
begin
I := Low(TFlowControl);
while (I <= High(TFlowControl)) do
begin
if UpperCase(Str) = UpperCase(FlowControlToStr(I)) then
Break;
I := Succ(I);
end;
if I > High(TFlowControl) then
Result := fcCustom
else
Result := I;
end;

// baud rate to string
function BaudRateToStr(BaudRate: TBaudRate): string;
const
BaudRateStrings: array[TBaudRate] of string = ('Custom', '110', '300', '600',
'1200', '2400', '4800', '9600', '14400', '19200', '38400', '56000', '57600',
'115200', '128000', '256000');
begin
Result := BaudRateStrings[BaudRate];
end;

// stop bits to string
function StopBitsToStr(StopBits: TStopBits): string;
const
StopBitsStrings: array[TStopBits] of string = ('1', '1.5', '2');
begin
Result := StopBitsStrings[StopBits];
end;

// data bits to string
function DataBitsToStr(DataBits: TDataBits): string;
const
DataBitsStrings: array[TDataBits] of string = ('5', '6', '7', '8');
begin
Result := DataBitsStrings[DataBits];
end;

// parity to string
function ParityToStr(Parity: TParityBits): string;
const
ParityBitsStrings: array[TParityBits] of string = ('None', 'Odd', 'Even',
'Mark', 'Space');
begin
Result := ParityBitsStrings[Parity];
end;

// flow control to string
function FlowControlToStr(FlowControl: TFlowControl): string;
const
FlowControlStrings: array[TFlowControl] of string = ('Hardware',
'Software', 'None', 'Custom');
begin
Result := FlowControlStrings[FlowControl];
end;

end.