📄 unidevice_builtin.pas
字号:
unit UniDevice_BuiltIn;
{----------------------------------------------
UniDevice_BuiltIn
Version 1.03
Copyright 1999-2001 AT Corp.Ltd
-----------------------------------------------}
interface
{$DEFINE DownLoader_Compatible} // 兼容通信座—通信完毕后没有关闭DSR信号
uses
UniCommX, SysUtils, Classes, Messages, Windows, ExtCtrls, Syncobjs;
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;
// TSerialPort component and asistant classes
TCustomSerialPort = class; // forward declaration
// thread for background monitoring of port events
TComThread = class(TThread)
private
FComPort: TCustomSerialPort;
FStopEvent: THandle;
FEvents: TComEvents;
protected
procedure DispatchComMsg;
procedure DoEvents;
procedure Execute; override;
procedure SendEvents;
procedure Stop;
public
constructor Create(AComPort: TCustomSerialPort);
destructor Destroy; override;
end;
// timoeout properties for read/write operations
TComTimeouts = class(TPersistent)
private
FComPort: TCustomSerialPort;
FReadInterval: Integer;
FReadTotalM: Integer;
FReadTotalC: Integer;
FWriteTotalM: Integer;
FWriteTotalC: Integer;
procedure SetComPort(const AComPort: TCustomSerialPort);
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: TCustomSerialPort 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: TCustomSerialPort;
FOutCTSFlow: Boolean;
FOutDSRFlow: Boolean;
FControlDTR: TDTRFlowControl;
FControlRTS: TRTSFlowControl;
FXonXoffOut: Boolean;
FXonXoffIn: Boolean;
FDSRSensitivity: Boolean;
FTxContinueOnXoff: Boolean;
FXonChar: Char;
FXoffChar: Char;
procedure SetComPort(const AComPort: TCustomSerialPort);
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: TCustomSerialPort 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: TCustomSerialPort;
FBits: TParityBits;
FCheck: Boolean;
FReplace: Boolean;
FReplaceChar: Char;
procedure SetComPort(const AComPort: TCustomSerialPort);
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: TCustomSerialPort 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: TCustomSerialPort;
FInputSize: Integer;
FOutputSize: Integer;
procedure SetComPort(const AComPort: TCustomSerialPort);
procedure SetInputSize(const Value: Integer);
procedure SetOutputSize(const Value: Integer);
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
property ComPort: TCustomSerialPort read FComPort;
published
property InputSize: Integer read FInputSize write SetInputSize default 1024;
property OutputSize: Integer read FOutputSize write SetOutputSize default 1024;
end;
// main component
TCustomSerialPort = class(TComponent)
private
FEventThread: TComThread;
FThreadCreated: Boolean;
FHandle: THandle;
FWindow: THandle;
FUpdateCount: Integer;
FTriggersOnRxChar: 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;
FSem: THandle;
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;
procedure Lock;
procedure UnLock;
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 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 Open;
procedure Close;
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);
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
TSerialPort = class(TCustomSerialPort)
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;
TDaemonTimerState = (tsPrepare, tsSendAT, tsSlience, tsSwitch, tsSendCmd, tsCheckConnection, tsWaitForLineSilence);
TSerialCommDevice = class(TCustomCommDevice)
protected
FInitData: string;
FDaemonTimer: TTimer;
FDaemonTimerState: TDaemonTimerState;
FInTimer: Boolean;
ComPort: TSerialPort;
FCommEverFinished: Boolean;
FSem: THandle;
procedure OnDaemonTimer(Sender: TObject); virtual;
procedure SetActived(value: Boolean); override;
procedure SetBaudRate(value: TUniBaudRate); override;
procedure SetDeviceName(value: string); override;
procedure CommRxChar(Sender: TObject; Count: Integer); virtual;
procedure OpenDevice; override;
procedure CloseDevice; override;
procedure CommDSR(Sender: TObject; OnOff: Boolean);
procedure Lock;
procedure UnLock;
public
constructor Create; override;
destructor Destroy; override;
class function TypeImplemented(value: TUniDeviceType): Boolean; override;
class procedure EnumDevice(Device: TStrings); override;
function InitiativelyConnect(Params: string): Boolean; override;
procedure CloseConnection; override;
procedure SendData(Data: string); override;
function GetDataAndClearBuf: string; override;
published
property Actived;
property BaudRate;
property DeviceName;
property DeviceType;
property Busy;
property OnInitState;
property OnConnectState;
property OnDataArrive;
end;
TModemCommDevice = class(TSerialCommDevice)
private
FInitCommand: TStrings;
FLastConnectionTime: DWord;
FRecentData: string;
CheckingOffLine: Boolean;
LastCheckOffLineTick: DWord;
OffLine: Boolean;
InInternalBusy: Boolean;
protected
procedure OnDaemonTimer(Sender: TObject); override;
procedure CommRxChar(Sender: TObject; Count: Integer); override;
function GetBusy: Boolean; override;
public
constructor Create; override;
destructor Destroy; override;
procedure SendData(Data: string); override;
class function TypeImplemented(value: TUniDeviceType): Boolean; override;
function InitiativelyConnect(Params: string): Boolean; override;
end;
// aditional procedures
procedure InitAsync(var AsyncPtr: PAsync);
procedure DoneAsync(var AsyncPtr: PAsync);
procedure EnumComPorts(Ports: TStrings);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -