//指定传输速度
procedure TComm.SetBaudRate( Rate : TBaudRate );
begin
if Rate = FBaudRate then
Exit;
FBaudRate := Rate;
if hComm <> 0 then
_SetCommState
end;
//硬件流量控制
procedure TComm.SetHwHandShaking( c: THwHandShaking);
begin
if c = FHwHandShaking then
Exit;
FHwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//软件交握指定
procedure TComm.SetSwHandShaking( c : TSwHandShaking );
begin
if c = FSwHandShaking then
Exit;
FSwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//设置数据位数
procedure TComm.SetDataBits( Size : TDataBits );
begin
if Size = FDataBits then
Exit;
FDataBits := Size;
if hComm <> 0 then
_SetCommState
end;
//设置极性检查方式
procedure TComm.SetParity( p : TParity );
begin
if p = FParity then
Exit;
FParity := p;
if hComm <> 0 then
_SetCommState
end;
//设置停止位
procedure TComm.SetStopBits( Bits : TStopBits );
begin
if Bits = FStopBits then
Exit;
FStopBits := Bits;
if hComm <> 0 then
_SetCommState
end;
//读取CD状态
function TComm.ReadCDHolding():Boolean;
begin
Result:=FCDHolding;
end;
//读取DSR状态
function TComm.ReadDSRHolding():Boolean;
begin
Result:=FDSRHolding;
end;
//读取RI状态
function TComm.ReadRIHolding():Boolean;
begin
Result:=FRIHolding;
end;
//读取CTS状态
function TComm.ReadCTSHolding():Boolean;
begin
Result:=FCTSHolding;
end;
//设置DTR状态
procedure TComm.SetDTRStatus(b:Boolean);
begin
if hComm=0 then exit ;
FDTR:=b;
if b then
EscapeCommFunction(hComm,SETDTR) //将DTR升至高电压
else
EscapeCommFunction(hComm,CLRDTR);//将DTR降至低电压
end;
//设置RTS状态
procedure TComm.SetRTSStatus(b:Boolean);
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
exit ;
end;
FRTS:=b;
if b then
EscapeCommFunction(hComm,SETRTS) //将RTS升至高电压
else
EscapeCommFunction(hComm,CLRRTS); //将RTS降至低电压
end;
//返回数据
function TComm.ReadInputData():String;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
//决定每一次的指令要返回多少的字符(以Byte为单位)
ReadProcess;
Result:=FInputData;
end;
//返回数据
function TComm.ReadInputByte(var AP:PByte):DWORD;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
ReadProcess;//执行读取函数
AP:= @FInputByteData[0];//取得数据地址
Result:=High(FInputByteData);//取得数据数组的最高索引值
end;
//读取数据的字节数
function TComm.ReadInDataCount():DWORD;
var
CS: TCOMSTAT;
dwCommError:DWORD;
begin
ClearCommError(hComm,dwCommError,@CS); //取得状态
Result:=CS.cbInQue;
end;
//清空数据缓冲区
procedure TComm.SetInDataCount(StrNO:DWORD);
begin
if StrNo<>0 then exit ;
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
end;
//线路状态的数值
function TComm.ReadCommEvent():DWORD;
begin
Result:=FCommEvent;
end;
//错误状态值的读取
function TComm.ReadCommError():DWORD;
begin
Result:=FCommError;
end;
//设置引发接收事件的阀值
procedure TComm.SetRThreshold(RTNo:DWORD);
begin
FRThreshold:=RTNo;
end;
//以下是实际的读取动作
Procedure TComm.ReadProcess;
var
nBytesRead: DWORD;
dwCommError: DWORD;
CS: TCOMSTAT;
i,ReadLen: DWORD;
begin
//使用ClearCommError得知有多少的数据在缓冲区中
//并得知错误种类
ClearCommError(hComm,dwCommError,@CS); //取得状态
FCommError:=dwCommError; //错误数值
if cs.cbInQue <>0 then //若缓冲区有数据,则读取
begin
if InputLen=0 then //指定读取的数据数
ReadLen:=cs.cbInQue
else
ReadLen:=InputLen;
if cs.cbInQue > sizeof(szInputBuffer) then
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
else
begin
//读取数据
if ReadFile(hComm, szInputBuffer,ReadLen,nBytesRead,nil) then // 接收COM 的数据
begin
//取出数据
FInputData:=Copy(szInputBuffer,1,ReadLen);
//设置字节数组长度
SetLength(FInputByteData,ReadLen);
//将数据搬到数组中
for i:=0 to ReadLen-1 do
FInputByteData[i]:=ord(szInputBuffer[i]);
end; //ReadFile Loop
end;//else Loop
end; //cs.binQue Loop
end;
//取得线路的状态
procedure TComm.GetModemState;
var
dwModemState : DWORD;
begin
if hComm=0 then
begin
raise ECommError.Create('COM Port is not opened yet!');
end;
//取得线路状态
FCommEvent:=0;
if GetCommModemStatus( hComm, dwModemState ) then
begin
//判断CD状态
if (dwModemState and MS_RLSD_ON)=MS_RLSD_ON then
begin
if not FCDHolding then FCommEvent:= EV_RLSD;
FCDHolding:=True;
end
else
begin
if FCDHolding then FCommEvent:= EV_RLSD;
FCDHolding:=False;
end;
//判断DSR状态
if (dwModemState and MS_DSR_ON)=MS_DSR_ON then
begin
if not FDSRHolding then FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=True;
end
else
begin
if FDSRHolding then FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=False;
end;
//判断RI状态
if (dwModemState and MS_RING_ON)=MS_RING_ON then
begin
if not FRIHolding then FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=True;
end
else
begin
if FRIHolding then FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=False;
end;
//判断CTS状态
if (dwModemState and MS_CTS_ON)=MS_CTS_ON then
begin
if not FCTSHolding then FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=True;
end
else
begin
if FCTSHolding then FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=False;
end;
end;
end;
procedure Register;
begin
RegisterComponents('UserVcl', [TComm])
end;
//组件的定时器程序,在此会决定事件是否被触发
procedure TComm.ProcTimer(Sender: TObject);
var
tmpValue: DWORD;
dwCommError:DWORD;
CS: TCOMSTAT;
begin
if hComm=0 then exit;
//若设置读取的字符数,检查并触发事件
ClearCommError(hComm,dwCommError,@CS); //取得状态
FCommError:=dwCommError; //错误数值
if FRThreshold>0 then
begin
if cs.cbInQue >=FRthreshold then
ReceiveData();
end;
GetModemState;
Application.ProcessMessages; //看有无其它的指令需执行,以免锁住
//检查线路状态是否发生改变,若改变则触发事件
tmpValue:=ReadCommEvent;
if tmpValue<>0 then ModemStateChange(tmpValue);
Application.ProcessMessages; //看有无其它的指令需执行,以免锁住
//若发生错误,则引发错误
tmpValue:=ReadCommError;
if tmpValue<>0 then ReceiveError(tmpValue);
Application.ProcessMessages; //看有无其它的指令需执行,以免锁住
end;
if hNewCommFile = INVALID_HANDLE_VALUE then
raise ECommError.Create( 'Error opening serial port' );
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;
//以下是通信参数的设置
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;
dcb.Flags := 1; //必须指定为1
dcb.Parity := Ord( FParity );//Parity的指定
FParityCheck:=False;
if Ord(FParity)<>0 then FParityCheck:=True;
if FParityCheck then
dcb.Flags := dcb.Flags or dcb_ParityCheck; // Enable parity check
// 设置硬件流量控制
Case FHwHandShaking of
hhNone:;
hhNoneRTSON:
dcb.Flags := dcb.Flags or dcb_RTSControlEnable;
hhRTSCTS:
dcb.Flags := dcb.Flags or dcb_RTSControlHandShake or dcb_OutxCtsFlow;
end;
//设置软件流量控制
Case FSwHandShaking of
shNone:;
shXonXoff:
dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
end;
//设置数据位数
dcb.ByteSize := Ord( FDataBits ) + 5;
//设置停止位数
dcb.StopBits := Ord( FStopBits );
//将设置写入
SetCommState( hComm, dcb )
end;
procedure TComm.SetPortOpen(b:Boolean);
begin
if b then //若指定打开通信端口,则…
begin
if FPortOpen then
begin
MessageDlg('COM Port has been opened!', mtError, [mbOK], 0);
exit;
end; //FportOpen loop
OpenComm; //打开通信端口
exit;
end; //b loop
CloseComm;
end;