有没有mscom的中文帮助？提供一下？如果有全api的串口程序可否借鉴一下？(50分)

有没有mscom的中文帮助？提供一下？如果有全api的串口程序可否借鉴一下？

纯API操作串行口，读写分别用线程。

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

// 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;
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);
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; 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;

// 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;

implementation

uses
CPortSetup, Controls, Forms, WinSpool;

const
// error messages
ComErrorMessages: array[1..22] of string =
('打开串行口失败.',
'向串行口发送数据失败.',
'读取串行口数据失败.',
'无效的异步(Asynchronous)通讯参数.',
'清I/O缓冲区失败.',
'取异步(Asynchronous)状态失败.',
'设置串行口参数失败.',
'设置串行口超时参数失败.',
'设置串行口缓冲区大小失败.',
'取串行口参数(ClearCommError)失败.',
'取Modem状态(GetCommModemStatus)失败.',
'设置串行口硬件状态(EscapeCommFunction)失败.',
'TransmitCommChar失败',
'串行口打开时不能设置同步方式(SyncMethod).',
'搜索系统串行口时失败.',
'存贮串行口参数时失败.',
'读取串行口参数时失败.',
'建立/解除控件(TCustomComPort)链结时出错.',
'为LED设置ComPort后不能改变其状态!',
'Event线程建立后不能设置等事件(Wait for event).',
'WaitForEvent函数失败.',
'有控件已链结到OnRxBuf.');

// 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 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 evError in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_ERR, 0);
if evRx80Full in FEvents then
SendMessage(FComPort.FWindow, CM_COMPORT, EV_RX80FULL, 0);
end;

// call events
procedure TComThread.DoEvents;
begin
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 evError in FEvents then
FComPort.CallError;
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];
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;
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
on E:Exception do
Application.ShowException(E);
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
begin
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
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);

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
Result := WriteAsync(Str[1], Length(Str), AsyncPtr);
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);
Result := ReadAsync(Str[1], Count, AsyncPtr);
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);

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; Timeout: Integer);
var
Overlapped: TOverlapped;
Mask: DWORD;
Success: Boolean;
Signaled: Integer;
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);
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 := WaitForSingleObject(Overlapped.hEvent, Timeout);
if Signaled = WAIT_TIMEOUT then
SetCommMask(FHandle, 0); // timeout ellapsed, stop WaitCommEvent function
Success := (Signaled = WAIT_OBJECT_0) or (Signaled = WAIT_TIMEOUT);
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;

// 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
DoCTSChange(False);
DoDSRChange(False);
DoRLSDChange(False);
end;
end;

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

procedure TCustomComPort.CallAfterClose;
begin
DoAfterClose;
end;

procedure TCustomComPort.CallAfterOpen;
begin
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;
DoCTSChange(OnOff);
end;

procedure TCustomComPort.CallDSRChange;
var
OnOff: Boolean;
begin
OnOff := csDSR in Signals;
DoDSRChange(OnOff);
end;

procedure TCustomComPort.CallRLSDChange;
var
OnOff: Boolean;
begin
OnOff := csRLSD in Signals;
DoRLSDChange(OnOff);
end;

procedure TCustomComPort.CallError;
begin
DoError(LastErrors);
end;

procedure TCustomComPort.CallRing;
begin
DoRing;
end;

procedure TCustomComPort.CallRx80Full;
begin
DoRx80Full;
end;

procedure TCustomComPort.CallRxChar;
var
Count: Integer;

begin
Count := InputCount;
if Count > 0 then
DoRxChar(Count);
end;

procedure TCustomComPort.CallRxFlag;
begin
DoRxFlag;
end;

procedure TCustomComPort.CallTxEmpty;
begin
DoTxEmpty;
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;

// translated numeric string to port string
function ComString(Str: string): TPort;
var
Num: Integer;
begin
if UpperCase(Copy(Str, 1, 3)) = 'COM' then
Str := Copy(Str, 4, Length(Str) - 3);
try
Num := StrToInt(Str);
except
Num := 1;
end;
if (Num < 1) or (Num > 255) then
Num := 1;
Result := Format('COM%d', [Num]);
end;

// set port
procedure TCustomComPort.SetPort(const Value: TPort);
var
Str: string;
begin
Str := ComString(Value);
if Str <> FPort then
begin
FPort := Str;
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
FTriggersOnRxChar := Value;
end;

// returns true if RxChar is triggered when data arrives input buffer
function TCustomComPort.GetTriggersOnRxChar: Boolean;
begin
Result := TRUE;
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;

我学习SDK时写得一个纯SDK得串口通信程序，把计算机得串口收发得两个脚连起来就可以在
本机收发字符串。用VC6编译成功。你可以看看有没有帮助。
串口主程序：

#include<windows.h>
#include"StdAfx.h"
#include"ChuanKou.h"


HINSTANCE hInst;
DWORD Thread1;
DWORD Thread2;
HANDLE hEvent[2]; //事件对象句柄数组
HWND hMainWnd;
DWORD i=1;//线程1结束标志
DWORD j=1;//线程2结束标志
int ThreadPriority;
HANDLE hCom;
HANDLE hThread1; //线程句柄
HANDLE hThread2; //线程句柄
char text_buffer[1024];//编辑框字符缓冲区
char Buffer[1024];
char EditShow[1024];

DWORD WriteLength;
DWORD Writen;

char szAppName[]="这是个串口通信程序";

int WINAPI WinMain(HINSTANCE hInstance,
HINSTANCE hPrevInstance,
LPSTR lpCmdLine,
int nCmdShow) //创建主窗口
{
//char szAppName[]="这是个串口通信程序";
HWND hwnd;
MSG msg;
WNDCLASSEX wndclass;
hInst=hInstance;

////////////////定义窗口类

wndclass.cbSize =sizeof(wndclass);
wndclass.style =CS_HREDRAW|CS_VREDRAW;
wndclass.lpfnWndProc =ChuanKouProc;
wndclass.cbClsExtra =0;
wndclass.cbWndExtra =0;
wndclass.hInstance =hInstance;
wndclass.hIcon =LoadIcon(NULL,IDI_APPLICATION);
wndclass.hCursor =LoadCursor(NULL,IDC_ARROW);
wndclass.hbrBackground=(HBRUSH)GetStockObject(LTGRAY_BRUSH);
wndclass.lpszClassName=szAppName;
wndclass.lpszMenuName =NULL;
wndclass.hIconSm =LoadIcon(NULL,IDI_WINLOGO);

RegisterClassEx(&amp;wndclass); //注册窗口类

hwnd=CreateWindow(szAppName, //窗口类名
"ChuanKouAppication",//窗口标题
WS_SYSMENU|WS_MINIMIZEBOX,//窗口样式
CW_USEDEFAULT,//窗口起始位置x

CW_USEDEFAULT,//窗口起始位置y

//CW_USEDEFAULT,//用于缺省大小x
//CW_USEDEFAULT,//用于缺省大小y
300, //窗口长
100, //窗口宽

NULL,//无父事例句柄
NULL,//无菜单
hInstance,//当前事例句柄
NULL);//无参数
hMainWnd=hwnd;
ShowWindow(hwnd,nCmdShow);
UpdateWindow(hwnd);

while(GetMessage(&amp;msg,NULL,0,0))
{
TranslateMessage(&amp;msg);
DispatchMessage(&amp;msg);

}
return msg.wParam;
}

LRESULT CALLBACK ChuanKouProc(HWND hWnd,
UINT msg,
WPARAM wParam,
LPARAM lParam)
{
static HWND hWndEdit1; //编辑框句柄1
static HWND hWndEdit2; //编辑框句柄1
static HWND hWndButton1; //按钮句柄
static HWND hWndButton2; //按钮句柄
static HWND hWndButton3; //按钮句柄


switch(msg)
{
case WM_CREATE:
hWndEdit1=CreateWindow("EDIT",NULL,
WS_CHILD|WS_VISIBLE|WS_BORDER|
ES_LEFT|ES_AUTOHSCROLL,
0,0,0,0,
hWnd,
(HMENU)IDE_EDIT1,
hInst,
NULL); //创建编辑框子窗口1

hWndEdit2=CreateWindow("EDIT",NULL,
WS_CHILD|WS_VISIBLE|WS_BORDER|
ES_LEFT|ES_AUTOHSCROLL,
0,0,0,0,
hWnd,
(HMENU)IDE_EDIT2,
hInst,
NULL); //创建编辑框子窗口2

hWndButton1=CreateWindow("BUTTON","Send",
BS_PUSHBUTTON|WS_CHILD|
WS_VISIBLE|BS_CENTER,
210,10,80,20,
hWnd,
(HMENU)IDB_BUT1,
hInst,
NULL); //创建按钮子窗口1

hWndButton2=CreateWindow("BUTTON","Exit",
BS_PUSHBUTTON|WS_CHILD|
WS_VISIBLE|BS_CENTER,
210,45,80,20,
hWnd,
(HMENU)IDB_BUT2,
hInst,
NULL); //创建按钮子窗口2

/* hWndButton3=CreateWindow("BUTTON","传送文件",
BS_PUSHBUTTON|WS_CHILD|
WS_VISIBLE|BS_CENTER,
280,225,80,25,
hWnd,
(HMENU)IDB_BUT3,
hInst,
NULL); ////创建按钮子窗口3
*/

///////////////打开串口资源

hCom=CreateFile("COM1", //打开com
GENERIC_READ|GENERIC_WRITE, //可读写
0, //应用程序可在不访问设备情况下查询设备
NULL, //无安全属性
OPEN_EXISTING, //打开方式:若文件不存在则函数失败
FILE_FLAG_OVERLAPPED, //异步通讯方式FILE_FLAG_OVERLAPPED
NULL); //打开串口
if(hCom!=INVALID_HANDLE_VALUE)
MessageBox(hWnd,"串口打开成功","Message",0);


SetupComm(hCom,1024,1024); //设置输入输出缓冲区
PurgeComm(hCom,
PURGE_TXCLEAR| //清空输出缓冲
PURGE_RXCLEAR //清空输入缓冲
); //清空输入输出缓冲区

COMMTIMEOUTS CommTimeOuts;//定义超时结构
CommTimeOuts.ReadIntervalTimeout=1000;
CommTimeOuts.ReadTotalTimeoutMultiplier=5000;
CommTimeOuts.ReadTotalTimeoutConstant=5000;
CommTimeOuts.WriteTotalTimeoutMultiplier=5000;
CommTimeOuts.WriteTotalTimeoutConstant=5000;

if(!SetCommTimeouts(hCom,&amp;CommTimeOuts))
{
CloseHandle(hCom);
MessageBox(hWnd,"设置超时失败","Message",0);
return FALSE;
}
DCB dcb;
GetCommState(hCom,&amp;dcb); //读串口原来的参数设置
/////////设置DCB块结构
dcb.BaudRate=9600; dcb.ByteSize=8; dcb.Parity=NOPARITY;
dcb.StopBits=ONESTOPBIT; dcb.fBinary=TRUE; dcb.fParity=FALSE;
////////设置DCB为:波特率9600，8字节数据位，无校验，1位停止位，
////////允许2进制位(必须为TUNE)，无校验检查

SetCommState(hCom,&amp;dcb);//配置串口参数

///////////建立工作者线程

if(!(hThread1=CreateThread(NULL,
0,
(LPTHREAD_START_ROUTINE)ThreadFunc1,//线程函数
NULL,
0,
&amp;Thread1)))//建立线程1(读线程)
MessageBox(hWnd,"出现错误，不能建立读线程","Message",0);

if(!(hThread2=CreateThread(NULL,
0,
(LPTHREAD_START_ROUTINE)ThreadFunc2,//线程函数
NULL,
0,
&amp;Thread2)))//建立线程2(写线程)
MessageBox(hWnd,"出现错误，不能建立写线程","Message",0);

ThreadPriority=GetThreadPriority(hThread1); //得到线程1的优先级

SetThreadPriority(hThread2,ThreadPriority+1);//设线程2优先级高于线程1

hEvent[0]=CreateEvent(NULL, //无安全属性
TRUE, //手动设定事件为无通知状态
FALSE, //初始值为无通知状态
NULL //无对象名
); //创建事件对象

SetEvent(hEvent[0]); //设置为通知状态

hEvent[1]=CreateEvent(NULL, //无安全属性
TRUE, //手动设定事件为无通知状态
FALSE, //初始值为无通知状态
NULL //无对象名
); //创建事件对象
break;
case WM_SETFOCUS:
SetFocus(hWndEdit1);
break;

case WM_SIZE: //显示编辑框使之可以随窗口变化而变化（本程序设置窗口不可变）
MoveWindow(hWndEdit1,5,45,200,20,FALSE);
MoveWindow(hWndEdit2,5,10,200,20,TRUE);
break;

case WM_COMMAND:
switch (LOWORD(wParam))
{

case 1111://按下发送文本键后由这里处理此消息
if((WriteLength=GetDlgItemText(hWnd,1114,text_buffer,1024))==0)
MessageBox(hMainWnd,"不能发空信息","Message",MB_OK);
else
{
SetEvent(hEvent[1]);
ResetEvent(hEvent[0]);
Writen=WriteLength;
}
SetFocus(hWndEdit1);
break;
case 1112:
PurgeComm(hCom,
PURGE_TXCLEAR| //清空输出缓冲
PURGE_RXCLEAR //清空输入缓冲
); //清空输入输出缓冲区
CloseHandle(hCom);
CloseHandle(hEvent[0]);
CloseHandle(hEvent[1]);
i=0;
j=0;
PostQuitMessage(0);
break;
}
break;//这里少了这个break造成很大麻烦
case 2222:
MessageBox(hMainWnd," 数据已读入","Message",MB_OK);
break;
case 3333:
MessageBox(hMainWnd," 数据已写入","Message",MB_OK);
break;

case WM_DESTROY:
PurgeComm(hCom,
PURGE_TXCLEAR| //清空输出缓冲
PURGE_RXCLEAR //清空输入缓冲
); //清空输入输出缓冲区
CloseHandle(hCom);
CloseHandle(hEvent[0]);
CloseHandle(hEvent[1]);
i=0;
j=0;
PostQuitMessage(0);
break;

default:
return(DefWindowProc (hWnd,msg,wParam,lParam));
}
return(0);
}

DWORD WINAPI ThreadFunc1(LPVOID lpParameter) //线程函数
{
DWORD dwEvtMask=0;
OVERLAPPED ReadOverLapped;
COMSTAT ComStat;
DWORD dwLength;
DWORD dwErrorFlags;
BOOL fReadStat;
DWORD dwBytesRead;
DWORD dwError;
DWORD NumberOfBytesTransferred;
ReadOverLapped.hEvent=CreateEvent(NULL, //无安全属性
TRUE, //手动设定事件为无通知状态
FALSE, //初始值为无通知状态
NULL //无对象名
); //创建事件对象
DWORD flag;

memset(&amp;ReadOverLapped,0,sizeof(OVERLAPPED));

while(i)
{
WaitForSingleObject(hEvent[0],INFINITE);

SetCommMask(hCom,EV_RXCHAR); //设置监视类型
WaitCommEvent(hCom,&amp;dwEvtMask,&amp;ReadOverLapped);
flag=0;
if(dwEvtMask==EV_RXCHAR) //如果有数据到达
{


do
{
ClearCommError(hCom,&amp;dwErrorFlags,&amp;ComStat); //报告通信设备的当前状态
dwLength=ComStat.cbInQue; //接受到的且未读的数据的长度
memset(Buffer, 0, 1024);

if(dwLength>0)
{

fReadStat=ReadFile(hCom, //读的文件句柄
Buffer, //数据读入的缓冲区地址
dwLength, //要读的数据长度
&amp;dwBytesRead, //指向一个变量，得到读入的长度
&amp;ReadOverLapped //指向重叠结构的指针
);
strcat( EditShow, Buffer ); //数据可能要读几次到Buffer才能读完，
//所以要把读到的数据连接起来
dwError=GetLastError();

if(!fReadStat)
{
if(dwError==ERROR_IO_PENDING)
{
WaitForSingleObject(ReadOverLapped.hEvent,INFINITE);
while(!GetOverlappedResult(hCom,
&amp;ReadOverLapped,
&amp;NumberOfBytesTransferred,
FALSE));
ReadOverLapped.Offset+=NumberOfBytesTransferred;
}
}
else
{
ReadOverLapped.Offset+=dwBytesRead;
}

}

}while(dwLength>0); //循环结束时读操作完成
}


flag=strcmp(EditShow,"");

if(flag)
{
SetDlgItemText(hMainWnd,1115,EditShow);
}
SetEvent(hEvent[0]);
//PostMessage(hMainWnd,2222,0,0);
//Sleep(0);
}
return 0;
}

DWORD WINAPI ThreadFunc2(LPVOID lpParameter)//线程函数
{
DWORD dwEvtMask=0;
OVERLAPPED WriteOverLapped;
COMSTAT ComStat;
DWORD dwErrorFlags;
BOOL fWriteStat;
DWORD dwBytesWrite;
DWORD dwError;
DWORD NumberOfBytesTransferred = 0;
WriteOverLapped.hEvent=CreateEvent(NULL, //无安全属性
TRUE, //手动设定事件为无通知状态
FALSE, //初始值为无通知状态
NULL //无对象名
); //创建事件对象
DWORD dwLength;


while(j)
{
memset(&amp;WriteOverLapped,0,sizeof(OVERLAPPED));

LPSTR pBuffer=text_buffer; //得到缓冲区的指针
WaitForSingleObject(hEvent[1],INFINITE);
memset(EditShow, 0, 1024); //将显示缓冲区清零

do
{
fWriteStat=WriteFile(hCom, //写的文件句柄
pBuffer, //要写入数据的缓冲区地址
WriteLength, //要写的数据长度
&amp;dwBytesWrite,//指向一个变量，得到实际写入的长度
&amp;WriteOverLapped //指向重叠结构的指针
);
dwError=GetLastError();
if(!fWriteStat)
{
if(dwError==ERROR_IO_PENDING)
{
WaitForSingleObject(WriteOverLapped.hEvent,INFINITE);
while(!GetOverlappedResult(hCom,
&amp;WriteOverLapped,
&amp;NumberOfBytesTransferred,
FALSE));
WriteLength=WriteLength-NumberOfBytesTransferred;
pBuffer+=NumberOfBytesTransferred;
}
}
else
{
WriteLength=0;
}
}while(WriteLength>0);//循环结束时写操作完成,下面要做些收尾工作
//PostMessage(hMainWnd,3333,0,0);
memset(text_buffer,0,1024);
SetDlgItemText(hMainWnd,1114,"");

ResetEvent(hEvent[1]);
SetEvent(hEvent[0]);

//Sleep(0);
}
return 0;
}


////////////////////////////////////头文件：
LRESULT CALLBACK ChuanKouProc(HWND hWnd,
UINT msg,
WPARAM wParam,
LPARAM lParam);
DWORD WINAPI ThreadFunc1(LPVOID lpParameter);
DWORD WINAPI ThreadFunc2(LPVOID lpParameter);
#define IDB_BUT1 1111
#define IDB_BUT2 1112
#define IDB_BUT3 1113
#define IDE_EDIT1 1114
#define IDE_EDIT2 1115
//#define WM_JOB1 221
//#define WM_JOB2 222

我晕了，这么复杂。

给我email,我发一个给你！

接受答案了.

老大，能不能发个email给我，zychen2002@163.net