第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.