tcomm1.pas

串口Tcomm组件 实现串行通信 很真实的

    FParityCheck:=False;
    if Ord(FParity)<>0 then FParityCheck:=True;
    if FParityCheck then
      dcb.Flags:=dcb.Flags or dcb_ParityCheck;//激活校验位检查
    //设置硬件流量控制
    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;

//指定传输速度
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;
      //决定每次的指令要返回多少的字符（以字节为单位）
      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)//清除通信端口数据
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) //清除通信端口数据
        else
          begin
            //读取数据
            if ReadFile(hComm,szInputBuffer,ReadLen,nBytesRead,nil) then
            //接收通信端口的数据
            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('Samples', [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;

end.