spcomm.pas

其中包含XPMenu控件和SPComm控件

unit SPComm;
//
// 这是一个串行端口通讯组件, 供 Delphi 2.0 应用程序使用. 适合用来做工业控制及
// 简单传输. 此组件呼叫 Win32 API 来达成所需功能, 请见Communications部份。
//
// 此组件参考 David Wann. 所制作的 COMM32.PAS Version 1.0。原始说明如下：
// This Communications Component is implemented using separate Read and Write
// threads. Messages from the threads are posted to the Comm control which is
// an invisible window. To handle data from the comm port, simply
// attach a handler to 'OnReceiveData'. There is no need to free the memory
// buffer passed to this handler. If TAPI is used to open the comm port, some
// changes to this component are needed ('StartComm' currently opens the comm
// port). The 'OnRequestHangup' event is included to assist this.
//
// David Wann
// Stamina Software
// 28/02/96
// [e-mail]
//
//
// 这个组件完全免费, 欢迎拷贝' 修改或做任何其它用途. 除了单独贩卖此组件.
// This component is totally free(copyleft), you can do anything in any
// purpose EXCEPT SELL IT ALONE.
//
//
// Author?: 小猪工作室 Small-Pig Team         in Taiwan R.O.C.
// Email   : [e-mail]
// Date ? : 1997/5/9
//
// Version 1.01     1996/9/4
//                  - Add setting Parity, Databits, StopBits
//                  - Add setting Flowcontrol:Dtr-Dsr, Cts-Rts, Xon-Xoff
//                  - Add setting Timeout information for read/write
//
// Version 1.02     1996/12/24
//                  - Add Sender parameter to TReceiveDataEvent
//
// Version 2.0      1997/4/15
//                  - Support separatly DTR/DSR and RTS/CTS hardware flow control setting
//                  - Support separatly OutX and InX software flow control setting
//                  - Log file(for debug) may used by many comms at the same time
//                  - Add DSR sensitivity property
//                  - You can set error char. replacement when parity error
//                  - Let XonLim/XoffLim and XonChar/XoffChar setting by yourself
//                  - You may change flow-control when comm is still opened
//                  - Change TComm32 to TComm
//                  - Add OnReceiveError event handler
//                  - Add OnReceiveError event handler when overrun, framing error,
//                    parity error
//                  - Fix some bug
//
// Version 2.01     1997/4/19
//                  - Support some property for modem
//                  - Add OnModemStateChange event hander when RLSD(CD) change state
//
// Version 2.02     1997/4/28
//                  - Bug fix: When receive XOFF character, the system FAULT!!!!
//
// Version 2.5      1997/5/9
//                  - Add OnSendDataEmpty event handler when all data in buffer
//                    are sent(send-buffer become empty) this handler is called.
//                    You may call send data here.
//                  - Change the ModemState parameters in OnModemStateChange
//                    to ModemEvent to indicate what modem event make this call
//                  - Add RING signal detect. When RLSD changed state or
//                    RING signal was detected, OnModemStateChange handler is called
//                  - Change XonLim and XoffLim from 100 to 500
//                  - Remove TWriteThread.WriteData member
//                  - PostHangupCall is re-design for debuging function 
//                  - Add a boolean property SendDataEmpty, True when send buffer
//                    is empty
//====================== 使用说明: =============================================
//      Delphi 是新一代可视化开发工具，它具有功能强大、简便易用和代码执行速度快等特点，
//  是全球公认的快速应用开发工具技术的先驱者，它越来越在构架企业信息系统方面发挥着重要作用。
//  由于Delphi 这些显著特点，许多程序员选择Delphi作为开发工具编制各种应用程序。但是，
//  令人惋惜的是Delphi没有自带串口通讯的控件，在它的帮助文档里也没有提及串口通讯，
//  这就给编制通讯程序的开发人员带来众多麻烦，影响了开发进度，下面就这一技术进行讨论。
//
//      用Delphi 实现串口通讯，常用的几种方法为：使用控件如MSCOMM和SPCOMM，使用
//  API函数或者在Delphi 中调用其它串口通讯程序。利用API编写串口通信程序较为复杂，
//  需要掌握大量通信知识，其优点是可实现的功能更强大，应用面更广泛，更适合于编写
//  较为复杂的低层次通信程序。相比较而言，利用SPComm控件则相对较简单，该控件具有
//  丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操作。
//
//  使用控件这一方法容易掌握，而SPCOMM支持多线程，所以SPCOMM控件的应用更加广泛。
//  结合实例详细介绍SPCOMM的使用。
//
//  SPCOMM的主要属性，方法和事件
//
//  1.属性
//  CommName：填写COM1,COM2…等串口的名字,在打开串口前，必须填写好此值。
//  BaudRate:设定波特率9600，4800等，根据实际需要来定，在串口打开后也可
//          更改波特率，实际波特率随之更改。
//  ParityCheck：奇偶校验。
//  ByteSize：字节长度_5,_6,_7,_8等，根据实际情况设定。
//  Parity：奇偶校验位
//  pBits：停止位
//  SendDataEmpty：这是一个布尔属性，为true时表示发送缓存为空，或者发送队列里
//      没有信息；为False时表示表示发送缓存不为空，或者发送队列里有信息。
//
//  2．方法
//    Startcomm过程用于打开串口，当打开失败时通常会报错，错误主要有7种：
//        ⑴串口已经打开 ；
//        ⑵打开串口错误 ；
//        ⑶文件句柄不是通讯句柄；
//        ⑷不能够安装通讯缓存；
//        ⑸不能产生事件 ；
//        ⑹不能产生读进程；
//        ⑺不能产生写进程；
//    StopComm过程用于关闭串口，没有返回值。
//    WriteCommData(pDataToWrite: PChar;dwSizeofDataToWrite:Word ): boolean 用于发送一个字符串到写线程，发送成功返回true,发送失败返回false, 执行此函数将立即得到返回值，发送操作随后执行。函数有两个参数，其中 pdatatowrite是要发送的字符串，dwsizeofdatatowrite 是发送的长度。
//
//  3．事件
//  OnReceiveData : procedure (Sender: TObject;Buffer: Pointer;BufferLength: Word) of object
//    当输入缓存有数据时将触发该事件，在这里可以对从串口收到的数据进行处理。Buffer中是收到的数据，bufferlength是收到的数据长度。
//  OnReceiveError : procedure(Sender: TObject; EventMask : DWORD)
//    当接受数据时出现错误将触发该事件。
//
//  代码中的ReadFile由于采用了异步方式,所以它只返回数据是否已开始读入,并不返回
//  实际的读入数据,即ReadFile中的nRealRead无效。实际读入的数据是由GetOverlappedResult函数
//  返回的,该函数的最后1个参数值为TRUE,表示它等待异步操作结束后才返回到应用程序。
//  此时,GetOverlappedResult函数与WaitForSingleObject函数等效。


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
  // messages from read/write threads
  PWM_GOTCOMMDATA = WM_USER + 1;
  PWM_RECEIVEERROR = WM_USER + 2;
  PWM_REQUESTHANGUP = WM_USER + 3;
  PWM_MODEMSTATECHANGE = WM_USER + 4;
  PWM_SENDDATAEMPTY = WM_USER + 5;

type
  TParity = ( None, Odd, Even, Mark, Space );
  TStopBits = ( _1, _1_5, _2 );
  TByteSize = ( _5, _6, _7, _8 );
  TDtrControl = ( DtrEnable, DtrDisable, DtrHandshake );
  TRtsControl = ( RtsEnable, RtsDisable, RtsHandshake, RtsTransmissionAvailable );

  ECommsError = class( Exception );
  TReceiveDataEvent = procedure(Sender: TObject; Buffer: Pointer;
                                BufferLength: Word) of object;
  TReceiveErrorEvent = procedure(Sender: TObject; EventMask : DWORD) of object;
  TModemStateChangeEvent = procedure(Sender: TObject; ModemEvent : DWORD) of object;
  TSendDataEmptyEvent = procedure(Sender: TObject) of object;

const
  //
  // Modem Event Constant
  //
  ME_CTS = 1;
  ME_DSR = 2;
  ME_RING = 4;
  ME_RLSD = 8;

const
  // This is the message posted to the WriteThread
  // When we have something to write.
  PWM_COMMWRITE = WM_USER+1;

  // Default size of the Input Buffer used by this code.
  INPUTBUFFERSIZE = 20480;

type
  TReadThread = class( TThread )
  protected
    procedure Execute; override;
  public
    hCommFile:          THandle;
    hCloseEvent:        THandle;
    hComm32Window:      THandle;

    function SetupCommEvent( lpOverlappedCommEvent: POverlapped;
                             var lpfdwEvtMask: DWORD ): Boolean;
    function SetupReadEvent( lpOverlappedRead: POverlapped;
                             lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
                             var lpnNumberOfBytesRead: DWORD ): Boolean;
    function HandleCommEvent( lpOverlappedCommEvent: POverlapped;
                              var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
    function HandleReadEvent( lpOverlappedRead: POverlapped;
                              lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
                              var lpnNumberOfBytesRead: DWORD ): Boolean;
    function HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
    function ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
    function ReceiveError( EvtMask : DWORD ): BOOL;
    function ModemStateChange( ModemEvent : DWORD ) : BOOL;
    procedure PostHangupCall;
  end;

  TWriteThread = class( TThread )
  protected
    procedure Execute; override;
    function HandleWriteData( lpOverlappedWrite: POverlapped;
                              pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
  public
    hCommFile:          THandle;
    hCloseEvent:        THandle;
    hComm32Window:      THandle;
    pFSendDataEmpty:    ^Boolean;
    procedure PostHangupCall;
  end;

  TComm = class( TComponent )
  private
    { Private declarations }
    ReadThread:         TReadThread;
    WriteThread:        TWriteThread;
    hCommFile:          THandle;
    hCloseEvent:        THandle;
    FHWnd:              THandle;
    FSendDataEmpty:     Boolean;            // True if send buffer become empty

    FCommName:          String;
    FBaudRate:          DWORD;
    FParityCheck:       Boolean;
    FOutx_CtsFlow:      Boolean;
    FOutx_DsrFlow:      Boolean;
    FDtrControl:        TDtrControl;
    FDsrSensitivity:    Boolean;
    FTxContinueOnXoff:  Boolean;
    FOutx_XonXoffFlow:  Boolean;
    FInx_XonXoffFlow:   Boolean;
    FReplaceWhenParityError:    Boolean;
    FIgnoreNullChar:    Boolean;
    FRtsControl:        TRtsControl;
    FXonLimit:          WORD;
    FXoffLimit:         WORD;
    FByteSize:          TByteSize;
    FParity:            TParity;
    FStopBits:          TStopBits;
    FXonChar:           AnsiChar;
    FXoffChar:          AnsiChar;
    FReplacedChar:      AnsiChar;

{ReadIntervalTimeout：定义两个字符到达的最大时间间隔，单位：毫秒,
                     读取完一个字符后，超过了ReadIntervalTimeout，仍未读取到下一个字符，就会发生超时
                     两字符之间最大的延时，当读取串口数据时，一旦两个字符传输的时间差超过该时间，
                     读取函数将返回现有的数据。设置为0表示该参数不起作用。
 ReadTotalTimeoutMultiplier：读取每字符间的超时。
 ReadTotalTimeoutConstant：一次读取串口数据的固定超时。
                     所以在一次读取串口的操作中，其超时为ReadTotalTimeoutMultiplier乘以读取的字节数再加上 ReadTotalTimeoutConstant。
                     将ReadIntervalTimeout设置为MAXDWORD，并将ReadTotalTimeoutMultiplier 和ReadTotalTimeoutConstant设置为0，表示读取操作将立即返回存放在输入缓冲区的字符。
 WriteTotalTimeoutMultiplier：写入每字符间的超时。
 WriteTotalTimeoutConstant：一次写入串口数据的固定超时。
                     所以在一次写入串口的操作中，其超时为WriteTotalTimeoutMultiplier乘以写入的字节数再加上 WriteTotalTimeoutConstant。}
    FReadIntervalTimeout:         DWORD;
    FReadTotalTimeoutMultiplier:  DWORD;
    FReadTotalTimeoutConstant:    DWORD;
    FWriteTotalTimeoutMultiplier: DWORD;
    FWriteTotalTimeoutConstant:   DWORD;

    FOnReceiveData:     TReceiveDataEvent;
    FOnRequestHangup:   TNotifyEvent;
    FOnReceiveError:    TReceiveErrorEvent;
    FOnModemStateChange:TModemStateChangeEvent;
    FOnSendDataEmpty:   TSendDataEmptyEvent;

    FCommError:         DWORD;
    FInputLen:          DWORD;   //每次执行InputData时所读取的字符串长度,默认为0:一次执行全部读取
    FInputBuffer:       array[0..INPUTBUFFERSIZE-1] of Char; //使用读函数调用方式的读缓冲区
    FInputData:         String;
    FInputByteData:     array of Byte;
    FUseRWThread:       Boolean;
    FInputTimeOut:      DWORD;
    FOutputTimeOut:     Word;


    procedure SetBaudRate( Rate : DWORD );
    procedure SetParityCheck( b : Boolean );
    procedure SetOutx_CtsFlow( b : Boolean );
    procedure SetOutx_DsrFlow( b : Boolean );
    procedure SetDtrControl( c : TDtrControl );
    procedure SetDsrSensitivity( b : Boolean );
    procedure SetTxContinueOnXoff( b : Boolean );
    procedure SetOutx_XonXoffFlow( b : Boolean );
    procedure SetInx_XonXoffFlow( b : Boolean );
    procedure SetReplaceWhenParityError( b : Boolean );
    procedure SetIgnoreNullChar( b : Boolean );
    procedure SetRtsControl( c : TRtsControl );
    procedure SetXonLimit( Limit : WORD );
    procedure SetXoffLimit( Limit : WORD );
    procedure SetByteSize( Size : TByteSize );
    procedure SetParity( p : TParity );
    procedure SetStopBits( Bits : TStopBits );
    procedure SetXonChar( c : AnsiChar );
    procedure SetXoffChar( c : AnsiChar );
    procedure SetReplacedChar( c : AnsiChar );

    procedure SetReadIntervalTimeout( v : DWORD );
    procedure SetReadTotalTimeoutMultiplier( v : DWORD );
    procedure SetReadTotalTimeoutConstant( v : DWORD );
    procedure SetWriteTotalTimeoutMultiplier( v : DWORD );
    procedure SetWriteTotalTimeoutConstant( v : DWORD );

    procedure CommWndProc( var msg: TMessage );
    procedure _SetCommState;
    procedure _SetCommTimeout;

    //procedure AddToInputBuffer(Buffer: PChar; BufferLength: Word);
    function ReadInDataCount: DWORD;
    function ReadInputData: String;
    procedure SetInDataCount(const Value: DWORD);
    procedure ReadProcess; //用于读函数调用方式读串口操作.
    function  ReadCommError():DWORD;
    procedure SetUseRWThread(const Value: Boolean);

  protected
    { Protected declarations }
    procedure CloseReadThread;
    procedure CloseWriteThread;
    procedure CloseRWThread;
    procedure CreateAndStartRWThread;
    procedure ReceiveData(Buffer: PChar; BufferLength: Word);
    procedure ReceiveError( EvtMask : DWORD );
    procedure ModemStateChange( ModemEvent : DWORD );
    procedure RequestHangup;
    procedure _SendDataEmpty;
  public
    { Public declarations }
    property InDataCount: DWORD read ReadInDataCount write SetInDataCount; //当前可供用户读取的接收数据字节数
    property InputData: string read ReadInputData;    //供用户调用读取接收数据的函数
    property InputLen: DWORD read FInputLen write FInputLen; //每次执行InputData时所读取的字符串长度,默认为0:一次执行全部读取
    property UseRWThread: Boolean read FUseRWThread write SetUseRWThread;//控制同步还是异步传输,默认为异步
    property OutputTimeout: word read FOutputTimeOut write FOutputTimeout default 500;
    // Input timeout (milliseconds)
    property InputTimeout: DWORD read FInputTimeOut write FInputTimeout default 200;
    function WriteDataToComm(ADataPtr: PChar; ADataSize: DWORD; ATimeout: DWORD=500): Boolean;//写数据到串口,不使用写线程
    function ReadDataFromComm(ADataPtr: PChar; ADataLen: DWORD; ATimeout: DWORD=500): Integer;//从串口读数据,不使用读线程
    function WriteReadDataFromComm(AWriteDataPtr: PChar; AWriteDataLen: DWORD;
        AReadDataPtr: PChar; ATimeout: DWORD=500): Integer;//写数据到串口然后再从串口读数据,不使用读写线程

    property Handle: THandle read hCommFile;
    property SendDataEmpty : Boolean read FSendDataEmpty;
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    procedure StartComm;
    procedure StopComm;
    function WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word): Boolean;
    function GetModemState : DWORD;
  published
    { Published declarations }
    property CommName: String read FCommName write FCommName;
    property BaudRate: DWORD read FBaudRate write SetBaudRate;
    property ParityCheck: Boolean read FParityCheck write SetParityCheck;
    property Outx_CtsFlow: Boolean read FOutx_CtsFlow write SetOutx_CtsFlow;
    property Outx_DsrFlow: Boolean read FOutx_DsrFlow write SetOutx_DsrFlow;
    property DtrControl: TDtrControl read FDtrControl write SetDtrControl;
    property DsrSensitivity: Boolean read FDsrSensitivity write SetDsrSensitivity;
    property TxContinueOnXoff: Boolean read FTxContinueOnXoff write SetTxContinueOnXoff;
    property Outx_XonXoffFlow: Boolean read FOutx_XonXoffFlow write SetOutx_XonXoffFlow;
    property Inx_XonXoffFlow: Boolean read FInx_XonXoffFlow write SetInx_XonXoffFlow;
    property ReplaceWhenParityError: Boolean read FReplaceWhenParityError write SetReplaceWhenParityError;
    property IgnoreNullChar: Boolean read FIgnoreNullChar write SetIgnoreNullChar;
    property RtsControl: TRtsControl read FRtsControl write SetRtsControl;
    property XonLimit: WORD read FXonLimit write SetXonLimit;
    property XoffLimit: WORD read FXoffLimit write SetXoffLimit;
    property ByteSize: TByteSize read FByteSize write SetByteSize;
    property Parity: TParity read FParity write FParity;