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( '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;