SPCOMM.PAS 用于Delphi 2010

第1141行: szInputBuffer: array[0..INPUTBUFFERSIZE-1] of PChar;

改为: szInputBuffer: array[0..INPUTBUFFERSIZE-1] of AnsiChar;
第1379行: lpszPostedBytes := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );

改为pszPostedBytes := PAnsiChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );

然后可以通过编译,显示已经添加了控件,实际使用中是否有错误未验证。

以下是新文件内容:

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
// davidwann@hunterlink.net.au
//
//
// 硂じンЧ禣, 舧ī' э┪暗ヴㄤウノ硚. 埃虫縒砪芥じン.
// 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   : spigteam@vlsi.ice.cycu.edu.tw
// 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
//

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;

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;

      FReadIntervalTimeout: DWORD;
      FReadTotalTimeoutMultiplier: DWORD;
      FReadTotalTimeoutConstant: DWORD;
      FWriteTotalTimeoutMultiplier: DWORD;
      FWriteTotalTimeoutConstant: DWORD;
      FOnReceiveData:     TReceiveDataEvent;
      FOnRequestHangup:   TNotifyEvent;
      FOnReceiveError:    TReceiveErrorEvent;
      FOnModemStateChange:TModemStateChangeEvent;
      FOnSendDataEmpty: TSendDataEmptyEvent;

      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;
    protected
      { Protected declarations }
      procedure CloseReadThread;
      procedure CloseWriteThread;
      procedure ReceiveData(Buffer: PChar; BufferLength: Word);
      procedure ReceiveError( EvtMask : DWORD );
      procedure ModemStateChange( ModemEvent : DWORD );
      procedure RequestHangup;
      procedure _SendDataEmpty;
    public
      { Public declarations }
      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;
      property StopBits: TStopBits read FStopBits write SetStopBits;
      property XonChar: AnsiChar read FXonChar write SetXonChar;
      property XoffChar: AnsiChar read FXoffChar write SetXoffChar;
      property ReplacedChar: AnsiChar read FReplacedChar write SetReplacedChar;

      property ReadIntervalTimeout: DWORD         read FReadIntervalTimeout         write SetReadIntervalTimeout;
      property ReadTotalTimeoutMultiplier: DWORD  read FReadTotalTimeoutMultiplier  write SetReadTotalTimeoutMultiplier;
      property ReadTotalTimeoutConstant: DWORD    read FReadTotalTimeoutConstant    write SetReadTotalTimeoutConstant;
      property WriteTotalTimeoutMultiplier: DWORD read FWriteTotalTimeoutMultiplier write SetWriteTotalTimeoutMultiplier;
      property WriteTotalTimeoutConstant: DWORD   read FWriteTotalTimeoutConstant   write SetWriteTotalTimeoutConstant;

      property OnReceiveData: TReceiveDataEvent
               read FOnReceiveData write FOnReceiveData;
      property OnReceiveError: TReceiveErrorEvent
               read FOnReceiveError write FOnReceiveError;
      property OnModemStateChange: TModemStateChangeEvent
               read FOnModemStateChange write FOnModemStateChange;
      property OnRequestHangup: TNotifyEvent
               read FOnRequestHangup write FOnRequestHangup;
      property OnSendDataEmpty: TSendDataEmptyEvent
               read FOnSendDataEmpty write FOnSendDataEmpty;
    end;

const
// This is the message posted to the WriteThread
// When we have something to write.
   

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值