📄 commx.pas
字号:
//**********************************************************************//
// //
// 乣 俼俽俀俁俀俠捠怣僐儞億乕僱儞僩 Ver 1.02 乣 //
// //
// 摦嶌娐嫬丗 倂倝値倓倧倵倱 俋俆乛俋俉乛俶俿係 //
// 巊梡狠蔬沧丗 俢倕倢倫倛倝 係.侽 (Build 5.108) //
// //
// 僼傽僀儖柤丗 俠倧倣倣倃丏倫倎倱 //
// //
// 惂嶌幰柤丗 僄僢僋僗 (KYY06770) //
// //
// 嵟廔峏怴擔晅丗 俋俋乛侽係乛俁侽 //
// //
// 仸 憲怣偲庴怣偵僗儗僢僪偲儊僢僙乕僕傪巊梡偟丄僶僢僋僌儔僂儞僪偱 //
// 張棟傪峴偄側偑傜岠棪傛偔幚峴偱偒傞傛偆偵側偭偰偄傞丅 //
// //
//**********************************************************************//
unit CommX;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
//**********************************************************************//
// //
// 捠怣偺庬椶偺掕媊 //
// //
//**********************************************************************//
TCommParityBits = (cpbNone, cpbOdd, cpbEven);
TCommStopBits = (csb1, csb1p5, csb2);
TCommFlowCtrls = (cfcRtsCts, cfcDtrDsr, cfcXonXoff, cfcHalfHigh, cfcHalfLow, cfcNone);
//**********************************************************************//
// //
// 椺奜捠抦梡偺僋儔僗 //
// //
//**********************************************************************//
ECommError = class(Exception);
//**********************************************************************//
// //
// 僀儀儞僩 //
// //
//**********************************************************************//
// 庴怣捠抦僀儀儞僩
TCommReceiveEvent = procedure(Sender: TObject; ReceiveSize: Integer) of Object;
// 僽儗乕僋怣崋僀儀儞僩
TCommBreakEvent = procedure(Sender: TObject) of Object;
// 捠怣僄儔乕僀儀儞僩
TCommErrEvent = procedure(Sender: TObject; ErrorState: Integer) of Object;
//**********************************************************************//
// //
// 憲怣梡僗儗僢僪偺僋儔僗 //
// //
//**********************************************************************//
TCommTransThread = class(TThread)
private
FOwner : TComponent; // 恊僐儞億乕僱儞僩
CommHandle : THandle; // 捠怣梡僼傽僀儖僴儞僪儖
CommWindow : THandle; // 僂傿儞僪僂偺僴儞僪儖
procedure HalfCtrlStart;
procedure HalfCtrlEnd;
protected
procedure Execute; override;
public
StartHandle : THandle; // 僗儗僢僪巒摦僔僌僫儖
MsgClearFlg : Boolean; // 儊僢僙乕僕丒僋儕傾僼儔僌
constructor Create(Owner: TComponent; Handle: THandle; Window: THandle);
end;
//**********************************************************************//
// //
// 庴怣梡僗儗僢僪偺僋儔僗 //
// //
//**********************************************************************//
TCommReceiveThread = class(TThread)
private
CommHandle : THandle; // 捠怣梡僼傽僀儖僴儞僪儖
CommWindow : THandle; // 僂傿儞僪僂偺僴儞僪儖
protected
procedure Execute; override;
public
ExitHandle : THandle; // 僀儀儞僩懸偪廔椆僔僌僫儖
constructor Create(Handle: THandle; Window: THandle);
end;
//**********************************************************************//
// //
// 捠怣僐儞億乕僱儞僩偺拪徾僋儔僗 //
// //
//**********************************************************************//
TCustomCommX = class(TComponent)
private
FHWnd : HWnd; // 僂傿儞僪僂偺僴儞僪儖
FOnReceive : TCommReceiveEvent; // 庴怣捠抦僀儀儞僩
FOnBreak : TCommBreakEvent; // 僽儗乕僋怣崋僀儀儞僩
FOnError : TCommErrEvent; // 捠怣僄儔乕僀儀儞僩
TransThread : TCommTransThread; // 憲怣梡僗儗僢僪
ReceiveThread : TCommReceiveThread; // 庴怣梡僗儗僢僪
Critical1 : TRTLCriticalSection; // 僋儕僥傿僇儖僙僋僔儑儞侾
Critical2 : TRTLCriticalSection; // 僋儕僥傿僇儖僙僋僔儑儞俀
function IsSignal(Signal: DWORD): Boolean;
protected
FHandle : THandle; // 捠怣梡僴儞僪儖
FPortNo : Integer; // 捠怣億乕僩斣崋
FBitRate : Integer; // 捠怣懍搙乮儃乕儗乕僩乯
FCharSize : Integer; // 侾暥帤偺價僢僩悢
FParityBit : TCommParityBits; // 僷儕僥傿僠僃僢僋偺曽幃
FStopBit : TCommStopBits; // 僗僩僢僾價僢僩悢
FFlowCtrl : TCommFlowCtrls; // 僼儘乕惂屼曽幃
FTimeOutTrans : Integer; // 憲怣僞僀儉傾僂僩帪娫乮倣倱乯
FTimeOutReceive : Integer; // 庴怣僞僀儉傾僂僩帪娫乮倣倱乯
FBufLenTrans : Integer; // 憲怣僶僢僼傽挿
FBufLenReceive : Integer; // 庴怣僶僢僼傽挿
FDCB : TDCB; // 俢俠俛峔憿懱
ReadHandle : THandle; // 撉傒崬傒廔椆僔僌僫儖
RecvOverLap : TOverlapped; // 庴怣梡僆乕僶乕儔僢僾峔憿懱
TransBufLen : Integer; // 憲怣懸婡僶僀僩悢
TransCnt : Integer; // 憲怣僉儏乕偵憲偭偨夞悢
procedure ThreadCreate;
procedure SetPortNo(const PortNo: Integer);
procedure SetBitRate(const BitRate: Integer);
procedure SetCharSize(const CharSize: Integer);
procedure SetParityBit(const ParityBit: TCommParityBits);
procedure SetStopBit(const StopBit: TCommStopBits);
procedure SetFlowCtrl(const FlowCtrl: TCommFlowCtrls);
procedure SetTimeOutTrans(const TimeOut: Integer);
procedure SetTimeOutReceive(const TimeOut: Integer);
procedure SetTimeOut;
procedure SetBufLenTrans(const BufLen: Integer);
procedure SetBufLenReceive(const BufLen: Integer);
procedure SetBufferLength;
procedure WndProc(var Msg: TMessage);
procedure ReceiveEvent;
procedure BreakEvent;
procedure ErrEvent(const ErrorWord: DWORD);
property PortNo : Integer read FPortNo write SetPortNo default 1;
property BitRate : Integer read FBitRate write SetBitRate default 9600;
property CharSize : Integer read FCharSize write SetCharSize default 8;
property ParityBit : TCommParityBits read FParityBit write SetParityBit default cpbNone;
property StopBit : TCommStopBits read FStopBit write SetStopBit default csb1;
property FlowCtrl : TCommFlowCtrls read FFlowCtrl write SetFlowCtrl default cfcRtsCts;
property TimeOutTrans : Integer read FTimeOutTrans write SetTimeOutTrans default 3000;
property TimeOutReceive : Integer read FTimeOutReceive write SetTimeOutReceive default 3000;
property BufLenTrans : Integer read FBufLenTrans write SetBufLenTrans default 2048;
property BufLenReceive : Integer read FBufLenReceive write SetBufLenReceive default 2048;
property Handle : THandle read FHandle;
property OnReceive : TCommReceiveEvent read FOnReceive write FOnReceive;
property OnBreak : TCommBreakEvent read FOnBreak write FOnBreak;
property OnError : TCommErrEvent read FOnError write FOnError;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure PortOpen;
procedure PortClose;
function TransChar(const c: Char): Boolean;
function TransString(const s: string): Boolean;
function TransBlock(const Data; BufSize: Integer): Boolean; virtual;
function ReceiveChar: Integer;
function ReceiveBlock(Buf: PChar; const MaxSize: Integer): Integer; virtual;
procedure ClearTransBuf;
procedure ClearReceiveBuf;
function GetTransLength: Integer;
function GetReceiveLength: Integer;
procedure SetRtsSignal(const Signal: Boolean);
procedure SetDtrSignal(const Signal: Boolean);
function IsCtsSignal: Boolean;
function IsDsrSignal: Boolean;
function IsRingSignal: Boolean;
function IsRlsdSignal: Boolean;
procedure SendBreak;
published
end;
//**********************************************************************//
// //
// 捠怣僐儞億乕僱儞僩偺僋儔僗 //
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -