xcomdrv.pas

delphi串口通讯控件,简单易用

unit XComDrv;

(**************************************************************************
 *     XComDrv                                                            *
 *                                                                        *
 *     Authors    : Ondrej Urik, Alexander Grischenko                     *
 *     Site       : http://xcomdrv.host.sk                                * 
 *     Mail       : [e-mail]                                       *
 *     Version    : 1.0 $rev. 20 March 2002                               *
 *     Released   : March, 2002                                           *
 *     Platform   : D4-D?, CB4-CB?                                        *
 *                                                                        *
 *                                                                        *
 *     USE AT YOUR OWN RISK. AUTHORS ARE NOT LIABLE FOR ANY DAMAGES       *
 *     CAUSED BY USE OF THIS SOFTWARE. YOU MAY MODIFY THIS UNIT AND ALL   *
 *     OTHER UNITS THAT ARE PART OF THIS PROJECT IN ANY WAY, BUT PLEASE   *
 *     DO NOT CLAIM THAT YOU WROTE THE ORIGINAL.                          *
 *                                                                        *
 *     NOTE                                                               *
 *     1. If you find any bugs or if you got some good ideas that         *
 *     could help or improve any of the components please send a mail     *
 *     to [e-mail]. Thanx.                                         *
 *     2. Unit is designed for Win9x and WinNT platforms. If you find     *
 *     any problems using this unit on WinNT/Win2000/WinME send me short  *
 *     description of the problem to above mail address.                  *
 *                                                                        *
 *     You may modify, distribute and sell XComDrv under any circum-      *
 *     stances. BUT by using this project you agree that the authors      *
 *     (Ondrej Urik, Alexander Grischenko) are not liable for any         *
 *     damage caused, directly or indirectly, by use or abuse of this     *
 *     project.                                                           *
 *                                                                        * 
 *     USE AT YOUR OWN RISK!                                              *
 *                                                                        *
 *     Ondrej Urik                       Alexander Grischenko             *
 *     01826 Plevnik-Drienove 12         Riga                             *
 *     Slovak Republic                   Latvia                           *
 *     [e-mail]              [e-mail]           *
 *                                                                        *
 **************************************************************************)

{$H+,R-,B-}
{$MINENUMSIZE 4}
{$I XCOMSWITCH.INC}

interface

uses
  Windows, SysUtils, Classes, Forms, XAsync;

type
  TDeviceEvent = (deChar, deFlag, deOutEmpty, deCTS, deDSR, deRLSD,
    deBreak, deError, deRing, dePrintError, deIn80Full, deProv1, deProv2);
  TDeviceEvents = set of TDeviceEvent;

  TCommEvent = procedure ( Sender: TObject; const Events: TDeviceEvents ) of object;
  TDataEvent = procedure ( Sender: TObject; const Received: DWORD ) of object;

  TObjectMethod = procedure of object;

  TBaudRate = ( br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
    br19200, br38400, br56000, br57600, br115200, br128000, br256000, brCustom );

  TFlowControl = ( fcNone, fcRtsCts, fcDtrDsr, fcSoftware, fcCustom );

  TRTSSettings = set of ( fsCTSOut, fsRTSEnabled, fsRTSHandshake );
  TDTRSettings = set of ( fsDSROut, fsDTREnabled, fsDTRHandshake );
  TXOnXOffSettings = set of (fsInX, fsOutX);

  TDataBits = ( db4, db5, db6, db7, db8 );
  TStopBits = ( sb1, sb1p5, sb2 );
  TParity = ( paNone, paOdd, paEven, paMark, paSpace );

  TCommOption = ( coAbortOnError, coDiscardNull, coDSRSensitivity,
    coErrorChar, coParityCheck, coTXContinueOnXOff, coLeaveDTROpen );
  TCommOptions = set of TCommOption;

  TBreakStatus = ( brClear, brSet );
  TLockState = set of (loSend, loRead);

  TCustomComm = class;

  TEventState = set of ( esBefore, esAfter );

  TCommPlugin = class ( TComponent )
  private
    FComm: TCustomComm;
  protected
    EventState: TEventState;
    LockState: TLockState;
    function CommValid: boolean;
    procedure SetComm( Value: TCustomComm ); virtual;
    procedure HandleEvents( var Events: TDeviceEvents ); dynamic;
    procedure Notification( AComponent: TComponent; Operation: TOperation ); override;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
  published
    property Comm: TCustomComm read FComm write SetComm;
  end;

  TCommDataControl = class ( TPersistent )
  private
    FDataBits        : TDataBits;
    FParity          : TParity;
    FStopBits        : TStopBits;
    FComm            : TCustomComm;
    procedure SetDataBits( Value: TDataBits );
    procedure SetParity( Value: TParity );
    procedure SetStopBits( Value: TStopBits );
    function GetDataBits: TDataBits;
    function GetParity: TParity;
    function GetStopBits: TStopBits;
  protected
    procedure AssignTo( Dest: TPersistent ); override;
  public
    constructor Create( AComm: TCustomComm ); virtual;
  published
    property DataBits  : TDataBits read GetDataBits write SetDataBits;
    property Parity    : TParity read GetParity write SetParity;
    property StopBits  : TStopBits read GetStopBits write SetStopBits;
  end;

  TCommBuffers = class ( TPersistent )
  private
    FInputSize       : word;
    FInputTime       : word;
    FOutputSize      : word;
    FOutputTime      : word;
    FComm            : TCustomComm;
    procedure SetIOSize( Index: integer; Value: word );
    function GetIOSize( Index: integer ): word;
  protected
    procedure AssignTo( Dest: TPersistent ); override;
  public
    constructor Create( AComm: TCustomComm ); virtual;
  published
    property InputSize     : word index 0 read GetIOSize write SetIOSize;
    property OutputSize    : word index 1 read GetIOSize write SetIOSize;
    property InputTimeout  : word read FInputTime write FInputTime;
    property OutputTimeout : word read FOutputTime write FOutputTime;
  end;

  TCommEventChars = class ( TPersistent )
  private
    FXonChar         : char;
    FXoffChar        : char;
    FErrorChar       : char;
    FEventChar       : char;
    FEofChar         : char;
    FComm            : TCustomComm;
    procedure SetCommChar( Index: integer; Value: char );
    function GetCommChar( Index: integer ): char;
  protected
    procedure AssignTo( Dest: TPersistent ); override;
  public
    constructor Create( AComm: TCustomComm ); virtual;
  published
    property XonChar   : char index 0 read GetCommChar write SetCommChar;
    property XoffChar  : char index 1 read GetCommChar write SetCommChar;
    property EofChar   : char index 2 read GetCommChar write SetCommChar;
    property ErrorChar : char index 3 read GetCommChar write SetCommChar;
    property EventChar : char index 4 read GetCommChar write SetCommChar;
  end;

  TCommTimeoutsEx = class ( TPersistent )
  private
    FReadInterval    : DWORD;
    FReadMultiplier  : DWORD;
    FReadConstant    : DWORD;
    FWriteMultiplier : DWORD;
    FWriteConstant   : DWORD;
    FComm            : TCustomComm;
    procedure SetInterval( Index: integer; Value: DWORD);
    function GetInterval( Index: integer ): DWORD;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create( AComm: TCustomComm ); virtual;
  published
    property ReadInterval    : DWORD index 0 read GetInterval write SetInterval;
    property ReadMultiplier  : DWORD index 1 read GetInterval write SetInterval;
    property ReadConstant    : DWORD index 2 read GetInterval write SetInterval;
    property WriteMultiplier : DWORD index 3 read GetInterval write SetInterval;
    property WriteConstant   : DWORD index 4 read GetInterval write SetInterval;
  end;

  TCommStatus = set of ( csCTSHold, csDTRHold, csRLSDHold, csXOffHold,
    csXOffSent, csEofSent, csWaitingTX );

  TCustomComm = class( TComponent )
  private
    FHandle          : HFILE;
    FBaudRate        : TBaudRate;
    FBaudValue       : DWORD;
    FBuffers         : TCommBuffers;
    FDataControl     : TCommDataControl;
    FDeviceName      : string;
    FDTRSettings     : TDTRSettings;
    FEventChars      : TCommEventChars;
    FEvents          : TDeviceEvents;
    FFlowControl     : TFlowControl;
    FOptions         : TCommOptions;
    FRTSSettings     : TRTSSettings;
    FSynchronize     : boolean;
    FTimeouts        : TCommTimeoutsEx;
    FXOnXOffSettings : TXOnXOffSettings;
    FOnCommEvent     : TCommEvent;
    FOnData          : TDataEvent;
    FOnRead          : TNotifyEvent;
    FOnSend          : TNotifyEvent;
    FCommThread      : TThread;
    FLocked          : TLockState;
    FPaused          : integer;
    FPlugins         : TList;
    FSavedAsyncProc  : TAsyncProc;
    FUpdating        : boolean;
    procedure SetBaudRate( Value: TBaudRate );
    procedure SetBaudValue( Value: DWORD );
    procedure SetBuffers( Value: TCommBuffers );
    procedure SetRTSSettings( Value: TRTSSettings );
    procedure SetDeviceName( Value: string );
    procedure SetDataControl( Value: TCommDataControl );
    procedure SetDTRSettings( Value: TDTRSettings );
    procedure SetEventChars( Value: TCommEventChars );
    procedure SetTimeouts( Value: TCommTimeoutsEx );
    procedure SetFlowControl( Value: TFlowControl );
    procedure SetCommOptions( Value: TCommOptions );
    procedure SetXOnXOffSettings( Value: TXOnXOffSettings );
    {$IFDEF X_DEBUG}
    procedure SetOpened( Value: Boolean );
    {$ENDIF}
    procedure SetPaused( Value: boolean );
    procedure UpdateFlowSettings( Flags: integer );
    function GetBaudRate: TBaudRate;
    function GetBaudValue: DWORD;
    function GetRTSSettings: TRTSSettings;
    function GetDTRSettings: TDTRSettings;
    function GetXOnXOffSettings: TXOnXOffSettings;
    function GetCommOptions: TCommOptions;
    function GetOpened: boolean;
    function GetCommStatus: TCommStatus;
    function GetCount( Index: integer ): DWORD;
    function GetMaxBaud: TBaudRate;
    function GetTotalReceived: DWORD;
    function GetPaused: boolean;
    function UpdateDCB: boolean;
    function UpdateBuffers: boolean;
    function UpdateTimeouts: boolean;
    procedure InternalAsyncProc( Success: boolean; Data: Pointer; Count: Longint );
    {Plugin support}
    procedure AddPlugin( Value: TCommPlugin );
    procedure RemovePlugin( Value: TCommPlugin );
    function GetPlugin( Index: integer ): TCommPlugin;
    function GetPluginCount: integer;
    procedure ClearPlugins;
  protected
    FTotalRead       : DWORD;
    FTotalSent       : DWORD;
    procedure UpdateEvents( Events: TDeviceEvents );
    procedure HandleEvents( Events: TDeviceEvents ); dynamic;
    procedure ReceiveData( Received: DWORD ); dynamic;
    function GetLocked: TLockState; virtual;
    property Plugins[Index: integer]: TCommPlugin read GetPlugin;
    property PluginCount: integer read GetPluginCount;
  public
    property Handle         : HFILE read FHandle;
    property CommStatus     : TCommStatus read GetCommStatus;
    property Locked         : TLockState read GetLocked;
    property MaxBaud        : TBaudRate read GetMaxBaud;
    property InCount        : DWORD index 0 read GetCount;
    property OutCount       : DWORD index 1 read GetCount;
    property Opened         : boolean read GetOpened
      {$IFDEF X_DEBUG}write SetOpened stored False default False{$ENDIF};
    property Paused         : boolean read GetPaused write SetPaused;
    property PauseCount     : integer read FPaused;
    property TotalReceived  : DWORD read GetTotalReceived;
    property TotalSent      : DWORD read FTotalSent;
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;

    function OpenDevice: boolean; virtual;
    procedure CloseDevice; virtual;

    procedure BeginUpdate;
    function EndUpdate: Boolean;

    procedure ToggleBreak( Status: TBreakStatus );
    procedure ToggleDTR( Status: TBreakStatus );
    procedure ToggleRTS( Status: TBreakStatus );
    procedure ToggleXonXoff( Status: TBreakStatus );

    function PurgeIn: boolean;
    function PurgeOut: boolean;

    function SendDataEx( const Data; DataSize, Timeout: DWORD ): DWORD;
    function SendData( const Data; DataSize: DWORD ): DWORD;
    function SendByte( const Value: byte ): boolean;
    function SendString( const Value: string ): boolean;

    function ReadDataEx( var Data; MaxDataSize, Timeout: DWORD ): DWORD;
    function ReadData( var Data; MaxDataSize: DWORD ): DWORD;
    function ReadByte( var Value: byte ): boolean;
    function ReadString( var Value: string ): boolean; overload;
    function ReadString( var Value: string; Len: integer ): boolean; overload;

    function WaitForString( const Value: array of string; Timeout: DWORD ): integer;
    {Async support}
    function InitAsync( AsyncProc: TAsyncProc; AutoClose: boolean ): HASYNC;
    function SendAsync( Async: HASYNC; const Data; DataSize: DWORD ): DWORD;
    function SendStringAsync( Async: HASYNC; const Value: string ): DWORD;
    function ReadAsync( Async: HASYNC; var Data; DataSize: DWORD ): DWORD;
    function ReadStringAsync( Async: HASYNC; var Value: string ): DWORD;
    function WaitAsync( Async: HASYNC; Process: TWaitProc ): boolean;
    function CloseAsync( Async: HASYNC ): boolean;
  protected
    property BaudRate    : TBaudRate read GetBaudRate write SetBaudRate;
    property Buffers     : TCommBuffers read FBuffers write SetBuffers;
    property BaudValue   : DWORD read GetBaudValue write SetBaudValue;
    property RTSSettings : TRTSSettings read GetRTSSettings write SetRTSSettings;
    property DataControl : TCommDataControl read FDataControl write SetDataControl;
    property DeviceName  : string read FDeviceName write SetDeviceName;
    property DTRSettings : TDTRSettings read GetDTRSettings write SetDTRSettings;
    property EventChars  : TCommEventChars read FEventChars write SetEventChars;
    property FlowControl : TFlowControl read FFlowControl write SetFlowControl;
    property MonitorEvents: TDeviceEvents read FEvents write FEvents;
    property Options     : TCommOptions read GetCommOptions write SetCommOptions;
    property Synchronize : boolean read FSynchronize write FSynchronize;
    property Timeouts    : TCommTimeoutsEx read FTimeouts write SetTimeouts;
    property XOnXOffSettings: TXOnXOffSettings read GetXOnXOffSettings write SetXOnXOffSettings;
    property OnCommEvent : TCommEvent read FOnCommEvent write FOnCommEvent;
    property OnData      : TDataEvent read FOnData write FOnData;
    property OnRead      : TNotifyEvent read FOnRead write FOnRead;
    property OnSend      : TNotifyEvent read FOnSend write FOnSend;
  end;

  TXComm = class ( TCustomComm )
  published
    property BaudRate;
    property BaudValue;
    property Buffers;
    property RTSSettings;
    property DataControl;
    property DeviceName;
    property DTRSettings;
    property EventChars;
    property MonitorEvents;
    property FlowControl;
    property Options;
    property Synchronize;
    property Timeouts;
    property XOnXOffSettings;

    property OnCommEvent;
    property OnData;
    property OnRead;
    property OnSend;

    {$IFDEF X_DEBUG}
    property Opened;
    {$ENDIF}
  end;

type  {Modem support}

  TDialType = ( dtPulse, dtTone );
  TConnectType = ( ctDial, ctDirect, ctWait );

  TConnectingEvent = procedure ( Sender: TObject; const ConnectType: TConnectType ) of object;

  TModemSettings = class ( TPersistent )
  private
    FInitString      : string;
    FResetString     : string;
    FDialNumber      : string;
    FSpeed           : Longint;
    FDialType        : TDialType;
    FConnectType     : TConnectType;
    FWaitRings       : byte;
    procedure SetSpeed( Value: longint );
  protected
    procedure AssignTo( Dest: TPersistent ); override;
  public
    constructor Create;
  published
    property DialType    : TDialType read FDialType write FDialType;
    property DialNumber  : string read FDialNumber write FDialNumber;
    property ConnectType : TConnectType read FConnectType write FConnectType;
    property InitString  : string read FInitString write FInitString;
    property ResetString : string read FResetString write FResetString;
    property Speed       : Longint read FSpeed write SetSpeed;
    property WaitRings   : byte read FWaitRings write FWaitRings;
  end;

  THayesAT = record
    Command: string;
    Data: string;
    Result: string;
    ME: integer;
  end;

  THayesATEvent = procedure ( Sender: TObject; AT: THayesAT ) of object;
  TLineStatus = set of ( lsCTS, lsDSR, lsRing, lsCD );
  TModemState = set of ( msInstalled, msConnected, msCommandState, msATSent,
    msConnecting, msWaitingCall, msDisconnecting );

  TCustomModem = class( TCustomComm )
  private
    FModemState      : TModemState;
    FModemSettings   : TModemSettings;
    FOnHayesAT       : THayesATEvent;
    FOnConnect       : TNotifyEvent;
    FOnDisconnect    : TNotifyEvent;
    FOnRing          : TNotifyEvent;
    FOnConnecting    : TConnectingEvent;
    FOnDisconnecting : TNotifyEvent;
    FOnChangeCS      : TNotifyEvent;
    FBuffer          : string;
    FCommand         : string;
    FECChar          : char;
    WLocked          : Boolean;
    WHayesAT         : THayesAT;
    WRegSent         : Boolean;
    WCmdPresent      : Boolean;
    procedure SetModemSettings( Value: TModemSettings );
    function InitCommand( Value: string ): boolean;