(****************************************************** * ComPort Library ver. 3.0 * * for Delphi 3, 4, 5, 6, 7 and * * C++ Builder 3, 4, 5, 6 * * written by Dejan Crnila, 1998 - 2002 * * maintained by Lars B. Dybdahl, 2003 * * Homepage: http://comport.sf.net/ * *****************************************************) 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; FEventThreadPriority: TThreadPriority; 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 SetPortName(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 SetEventThreadPriority(const Value: TThreadPriority); 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 EventThreadPriority: TThreadPriority read FEventThreadPriority write SetEventThreadPriority; 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 SetPortName; 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; // com port stream TComStream = class(TStream) private FComPort: TCustomComPort; public constructor Create(AComPort: TCustomComPort); function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(Offset: Longint; Origin: Word): Longint; override; 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_ConnChangeProp = 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; CError_RegError = 23; implementation uses {CPortSetup, }Controls, Forms, WinSpool{, gnugettext}; var // error messages ComErrorMessages: array[1..23] of widestring; const // 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; // set thread priority Priority := FComPort.EventThreadPriority; // 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; FEventThreadPriority := tpNormal; 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 if InSendMessage then ReplyMessage(0); if FConnected then 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 {$IFDEF DELPHI_6_OR_HIGHER} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF} FWindow := AllocateHWnd(WindowMethod); {$IFDEF DELPHI_6_OR_HIGHER} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF} 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 {$IFDEF DELPHI_6_OR_HIGHER} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF} DeallocateHWnd(FWindow); {$IFDEF DELPHI_6_OR_HIGHER} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF} 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) and (GetLastError <> ERROR_IO_INCOMPLETE) 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.SetPortName(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_ConnChangeProp) 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; // sets event thread priority procedure TCustomComPort.SetEventThreadPriority(const Value: TThreadPriority); begin if Value <> FEventThreadPriority then begin if FConnected and not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then raise EComPort.CreateNoWinCode(CError_ConnChangeProp) else FEventThreadPriority := Value; end; 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 stream constructor TComStream.Create(AComPort: TCustomComPort); begin inherited Create; FComPort := AComPort; end; // read from stream function TComStream.Read(var Buffer; Count: Integer): Longint; begin FComPort.Read(Buffer, Count); end; // write to stream function TComStream.Write(const Buffer; Count: Integer): Longint; begin FComPort.Write(Buffer, Count); end; // seek always to 0 function TComStream.Seek(Offset: Integer; Origin: Word): Longint; begin Result := 0; 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] + widestring(' (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; procedure EnumComPorts(Ports: TStrings); var KeyHandle: HKEY; ErrCode, Index: Integer; ValueName, Data: string; ValueLen, DataLen, ValueType: DWORD; TmpPorts: TStringList; begin ErrCode := RegOpenKeyEx( HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0, KEY_READ, KeyHandle); if ErrCode <> ERROR_SUCCESS then raise EComPort.Create(CError_RegError, ErrCode); TmpPorts := TStringList.Create; try Index := 0; repeat ValueLen := 256; DataLen := 256; SetLength(ValueName, ValueLen); SetLength(Data, DataLen); ErrCode := RegEnumValue( KeyHandle, Index, PChar(ValueName), {$IFDEF DELPHI_4_OR_HIGHER} Cardinal(ValueLen), {$ELSE} ValueLen, {$ENDIF} nil, @ValueType, PByte(PChar(Data)), @DataLen); if ErrCode = ERROR_SUCCESS then begin SetLength(Data, DataLen - 1); TmpPorts.Add(Data); Inc(Index); end else if ErrCode <> ERROR_NO_MORE_ITEMS then raise EComPort.Create(CError_RegError, ErrCode); until (ErrCode <> ERROR_SUCCESS) ; TmpPorts.Sort; Ports.Assign(TmpPorts); finally RegCloseKey(KeyHandle); TmpPorts.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; initialization {AddDomainForResourceString('cport');} ComErrorMessages[1]:=widestring('Unable to open com port'); ComErrorMessages[2]:=widestring('WriteFile function failed'); ComErrorMessages[3]:=widestring('ReadFile function failed'); ComErrorMessages[4]:=widestring('Invalid Async parameter'); ComErrorMessages[5]:=widestring('PurgeComm function failed'); ComErrorMessages[6]:=widestring('Unable to get async status'); ComErrorMessages[7]:=widestring('SetCommState function failed'); ComErrorMessages[8]:=widestring('SetCommTimeouts failed'); ComErrorMessages[9]:=widestring('SetupComm function failed'); ComErrorMessages[10]:=widestring('ClearCommError function failed'); ComErrorMessages[11]:=widestring('GetCommModemStatus function failed'); ComErrorMessages[12]:=widestring('EscapeCommFunction function failed'); ComErrorMessages[13]:=widestring('TransmitCommChar function failed'); ComErrorMessages[14]:=widestring('Cannot set property while connected'); ComErrorMessages[15]:=widestring('EnumPorts function failed'); ComErrorMessages[16]:=widestring('Failed to store settings'); ComErrorMessages[17]:=widestring('Failed to load settings'); ComErrorMessages[18]:=widestring('Link (un)registration failed'); ComErrorMessages[19]:=widestring('Cannot change led state if ComPort is selected'); ComErrorMessages[20]:=widestring('Cannot wait for event if event thread is created'); ComErrorMessages[21]:=widestring('WaitForEvent method failed'); ComErrorMessages[22]:=widestring('A component is linked to OnRxBuf event'); ComErrorMessages[23]:=widestring('Registry error'); end.