tcomm1.pas

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

unit TComm1;

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;//  每次执行输入时所读取的字符串长度
    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
    { Protected declarations }
     procedure ProcTimer(Sender:TObject);
     procedure ReceiveData();
     procedure ReceiveError(EvtMask : DWORD);
     procedure ModemStateChange(ModemEvent :DWORD);
  public
    { Public declarations }
    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
    { Published declarations }
    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;
    FPortOpen:=False;
    FCommPort:=pnCOM2;//默认COM2
    FBaudRate:=br9600;
    FHwHandShaking:=hhNone;
    FSwHandShaking:=shNone;
    FDataBits:=DB8;
    FParity:=None;
    FStopBits:=SB1;
    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('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;

(************************************************************)
//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;
    dcb.Flags:=1;//必须指定为1
    dcb.Parity:=Ord(FParity);//校验位的指定