📄 tcomm1.pas
字号:
unit TComm1;
// 这是一个串行端口通信组件
// 简单传输. 此组件调用 Win32 API 来达成所需功能
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
extctrls,Dialogs,syncobjs;
type
//类型定义
TBaudRate = ( br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200 );
TComPortNumber = ( pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7,
pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13,
pnCOM14, pnCOM15, pnCOM16 );
TParity = ( None, Odd, Even, Mark, Space );
TStopBits = ( SB1, SB1_5, SB2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
THWHandShaking=(hhNone,hhNoneRTSON,hhRTSCTS);
TSWHandShaking=(shNone,shXonXoff);
//例外声明
ECommError = class( Exception );
//事件函数定位器声明
TReceiveDataEvent = procedure(Sender: TObject) of object;
TReceiveErrorEvent = procedure(Sender: TObject; EventMask : DWORD) of object;
TModemStateChangeEvent = procedure(Sender: TObject; ModemEvent : DWORD) of object;
const
// 输入缓冲区的默认大小
INPUTBUFFERSIZE = 4096;
// Line Status位定义
ME_CTS = 1;
ME_DSR = 2;
ME_RING = 4;
ME_RLSD = 8;
//DCB 位定义
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;
type
TComm = class( TComponent )
private
{ Private declarations }
CommTimer: TTimer; //组件用的定时器
szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
hComm: THandle;
FCommPort: TComPortNumber;
FPortOpen: Boolean;
FBaudRate: TBaudRate;
FParityCheck: Boolean;
FHwHandShaking: THwHandShaking;
FSwHandShaking: TSwHandShaking;
FDataBits: TDataBits;
FParity: TParity;
FStopBits: TStopBits;
FInputLen: DWORD; //每次执行Input时所读取的字符串长度
FRThreshold: DWORD;//设置引发接收事件的阀值
FDTR: Boolean;
FRTS: Boolean;
FInputData: String;
// FByteNo: DWORD; //已读取的字节数
FInputByteData: array of Byte;
FCommEvent: DWORD;
FCommError: DWORD;
FCDHolding: Boolean;
FCTSHolding: Boolean;
FDSRHolding: Boolean;
FRIHolding: Boolean;
//事件
FOnReceiveData: TReceiveDataEvent;
FOnReceiveError: TReceiveErrorEvent;
FOnModemStateChange:TModemStateChangeEvent;
//设置函数
procedure SetBaudRate( Rate : TBaudRate ); //设置速率
procedure SetHwHandShaking( c : THwHandShaking);//硬件交握
procedure SetSwHandShaking( c : TSwHandShaking);//软件交握
procedure SetDataBits( Size : TDataBits );//数据位数
procedure SetParity( p : TParity );//极性检查
procedure SetStopBits( Bits : TStopBits );//停止位
procedure SetInDataCount(StrNo:DWORD);//设成0表示清除FInputData
procedure SetRThreshold(RTNo:DWORD); //接收阀值
procedure SetPortOpen(b:Boolean);//打开通信端口
procedure _SetCommState;//设置通信参数
procedure SetDTRStatus(b:Boolean);//DTR 状态
procedure SetRTSStatus(b:Boolean);//RTS状态
Procedure ReadProcess;//读取数据函数
Procedure GetModemState;//线路状态检测函数
procedure OpenComm;//打开通信端口函数
procedure CloseComm;//开关通信端口函数
function ReadCommEvent():DWORD; //硬件线路状态值读取
function ReadCommError():DWORD; //错误状态值的读取
function ReadInputData():String;//返回收到的数据
function ReadInDataCount():DWORD;//读取有多少数据
function ReadCDHolding:Boolean; //取得CD线路状态
function ReadDSRHolding:Boolean;//取得DSR线路状态
function ReadRIHolding:Boolean;//取得RI线路状态
function ReadCTSHolding:Boolean;//取得CTS线路状态
protected
//给子类继承用
procedure ProcTimer(Sender:TObject);
procedure ReceiveData();
procedure ReceiveError( EvtMask : DWORD );
procedure ModemStateChange( ModemEvent : DWORD );
public
//给应用程序调用用
property Handle: THandle read hComm;
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
function OutputString(DataToWrite: String): Boolean;
function OutputByte(const ByteData:array of Byte):Boolean;
function ReadInputByte(var AP:PByte):DWORD;
published
//属性列表用
property CommPort: TComPortNumber read FCommPort write FCommPort;
property PortOpen:Boolean read FPortOpen write SetPortOpen;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property HwHandShaking: THwHandShaking read FHwHandShaking write SetHwHandShaking;
property SwHandShaking: TSwHandShaking read FSwHandShaking write SetSwHandShaking;
property DataBits: TDataBits read FDataBits write SetDataBits;
property Parity: TParity read FParity write SetParity;
property StopBits: TStopBits read FStopBits write SetStopBits;
property CommEvent:DWORD read ReadCommEvent;
property CommError:DWORD read ReadCommError;
property Input:string read ReadInputData;
property InputLen:DWORD read FInputLen write FInputLen;
property RThreshold:DWORD read FRThreshold write SetRThreshold;
property CDHolding:Boolean read ReadCDHolding;
property DSRHolding:Boolean read ReadDSRHolding;
property RIHolding:Boolean read ReadRIHolding;
property CTSHolding:Boolean read ReadCTSHolding;
property DTREnabled:Boolean read FDTR write SetDTRStatus;
property RTSEnabled:Boolean read FRTS write SetRTSStatus;
property DataCount:DWORD read ReadInDataCount write SetInDataCount;
property OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnReceiveError: TReceiveErrorEvent
read FOnReceiveError write FOnReceiveError;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
end;
procedure Register;
implementation
(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)
constructor TComm.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
CommTimer:=TTimer.Create(Self);
CommTimer.Interval:=100;
CommTimer.OnTimer:=ProcTimer;
hComm := 0; //通信端口Handle先清空
FPortOpen:=False;
FCommPort := pnCOM2; //默认COM2
FBaudRate := br9600; //9600bps
FHwHandShaking := hhNone; //不激活硬件流量控制
FSwHandShaking := shNone; //不激活软件流量控制
FDataBits := DB8; //数据位数=8
FParity := None; //不作同位检查
FStopBits := SB1; //停止位数=1
FInputLen:=0; //默认是一次执行全部读取
CommTimer.Enabled:=True;
end;
destructor TComm.Destroy;
begin
CommTimer.Interval:=0;
CommTimer.Enabled:=False;
inherited Destroy;
end;
//打开通信端口
procedure TComm.OpenComm;
var
hNewCommFile: THandle;
ComStr:String;
begin
ComStr:='COM' + IntToStr(1+ord(FCommPort));
hNewCommFile := CreateFile( PChar(ComStr),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
0,{No Overlapped}
0 {template} );
if hNewCommFile = INVALID_HANDLE_VALUE then
// raise ECommError.Create( '此端口不存在或正在为其他程序占用!' ); //add by hs
raise ECommError.Create( 'Error opening serial port' ); //modify by hs
if not SetupComm( hNewCommFile, INPUTBUFFERSIZE, INPUTBUFFERSIZE ) then
begin
CloseHandle( hComm );
raise ECommError.Create( 'Cannot setup comm buffer' );
end;
// It is ok to continue.
hComm := hNewCommFile;
// 清除湲冲区
PurgeComm( hComm, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
// 通信端口组态
_SetCommState;
{ // 设置事件屏蔽
if not SetCommMask(hComm, EV_CTS or EV_DSR or EV_RLSD or EV_RING ) then
begin
MessageDlg('Set Comm Mask Error!', mtError, [mbOK], 0);
exit ;
end;}
FPortOpen:=True;
end; {TComm.OpenComm}
//关闭通信端口
procedure TComm.CloseComm;
begin
// No need to continue if we're not communicating.
if hComm = 0 then
Exit;
// 实际关闭通信端口
CloseHandle( hComm );
FPortOpen:=False;
hComm := 0
end;
//由通信端口送出字符串数据
function TComm.OutputString(DataToWrite: String ): Boolean;
var
lrc: LongWord;
tmpChar: PChar;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
tmpChar:=PChar(DataToWrite);
if WriteFile(hComm,tmpChar^,Length(DataToWrite), lrc, nil) then
begin
Result:=True;
exit;
end;
Result:=False;
end; {TComm.OutputString}
//传送二进制的数据
function TComm.OutputByte(const ByteData: array of Byte ): Boolean;
var
lrc: LongWord;
i: Integer;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
for i:=Low(ByteData) to High(ByteData) do
WriteFile(hComm,ByteData[i],1,lrc, nil);
Result := True;
end; {TComm.OutputByte}
//数据到达时的事件触发
procedure TComm.ReceiveData();
begin
if Assigned(FOnReceiveData) then
FOnReceiveData(self)
end;
//接收错误时的事件触发
procedure TComm.ReceiveError( EvtMask : DWORD );
begin
if Assigned(FOnReceiveError) then
FOnReceiveError( self, EvtMask )
end;
//线路状态改变时的事件触发
procedure TComm.ModemStateChange( ModemEvent : DWORD );
begin
if Assigned(FOnModemStateChange) then
FOnModemStateChange( self, ModemEvent )
end;
(******************************************************************************)
// TComm PRIVATE 方法
(******************************************************************************)
//以下是通信参数的设置
procedure TComm._SetCommState;
var
dcb: Tdcb;
tmpValue: DWORD;
begin
//取得串行端口设置
GetCommState( hComm, dcb );
//变更传输速率
case FBaudRate of
br110 : tmpValue := 110;
br300 : tmpValue := 300;
br600 : tmpValue := 600;
br1200 : tmpValue := 1200;
br2400 : tmpValue := 2400;
br4800 : tmpValue := 4800;
br9600 : tmpValue := 9600;
br14400 : tmpValue := 14400;
br19200 : tmpValue := 19200;
br38400 : tmpValue := 38400;
br56000 : tmpValue := 56000;
br57600 : tmpValue := 57600;
else
{br115200 :} tmpValue := 115200;
end;
//指定新值
dcb.BaudRate := tmpValue;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -