comm32.pas

一个非常好的Pcomm控件及例。通过试例

unit Comm32;

interface

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

const
 PWM_GOTCOMMDATA = WM_USER + 1;
 PWM_REQUESTHANGUP = WM_USER + 2;

type
 ECommsError = class( Exception );

 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;
   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;
    function WriteComm( pDataToWrite: LPCSTR; dwSizeofDataToWrite: DWORD ): Boolean;
    procedure PostHangupCall;
   end;

   TReceiveDataEvent = procedure(Sender:TObject; Buffer: Pointer; BufferLength: Word ) of object;

   TComm32 = class( TComponent )
    private
    { Private declarations }
     ReadThread:      TReadThread;
     WriteThread:     TWriteThread;
     FCommsLogFileName,
     FCommPort:	       string;
     hCloseEvent:      THandle;
     FOnReceiveData:   TReceiveDataEvent;
     FOnRequestHangup: TNotifyEvent;
     FHWnd:	       THandle;
     FBaudRate:	       DWORD;
     FBits:	       DWORD;
     FStopBits:	       DWORD;
     FReadInterval:Integer;
     procedure SetCommsLogFileName( LogFileName: string );
     function GetReceiveDataEvent: TReceiveDataEvent;
     procedure SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
     function GetRequestHangupEvent: TNotifyEvent;
     procedure SetRequestHangupEvent( ARequestHangupEvent: TNotifyEvent );
     procedure CommWndProc( var msg: TMessage );
    protected
     { Protected declarations }
     procedure CloseReadThread;
     procedure CloseWriteThread;
     procedure ReceiveData( Buffer: PChar; BufferLength: Word );
     procedure RequestHangup;
    public
     { Public declarations }
     hCommFile: THandle;
     constructor Create( AOwner: TComponent ); override;
     destructor Destroy; override;
     function StartComm: Boolean;
     procedure StopComm;
     function WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
    published
     { Published declarations }
     property BaudRate: DWORD read FBaudRate write FBaudRate;
     property Bits: DWORD read FBits write FBits;
     property StopBits: DWORD read FStopBits write FStopBits;
     property CommPort: string read FCommPort write FCommPort;
     property CommsLogFileName: string read FCommsLogFileName write SetCommsLogFileName;
     property OnReceiveData: TReceiveDataEvent read GetReceiveDataEvent write SetReceiveDataEvent;
     property OnRequestHangup: TNotifyEvent read GetRequestHangupEvent write SetRequestHangupEvent;
     property ReadInterval: Integer read FReadInterval write FReadInterval default 20;
    end;

const
	PWM_COMMWRITE = WM_USER+1;
	INPUTBUFFERSIZE = 2048;

var
	CommsLogFile:	Text;

procedure LogDebugInfo( outstr: PChar );
procedure LogDebugLastError( dwLastError: DWORD; szPrefix: LPSTR );
procedure Register;

implementation

var
 CommsLogName: string; 

constructor TComm32.Create( AOwner: TComponent );
begin
 inherited Create( AOwner );
 FCommPort := 'COM2';
 FCommsLogFileName := '';
 CommsLogName := '';
 ReadThread := nil;
 WriteThread := nil;
 hCommFile := 0;
 if not (csDesigning in ComponentState) then
 	FHWnd := AllocateHWnd(CommWndProc);
 FReadInterval:=25;
end;

destructor TComm32.Destroy;
begin
	if not (csDesigning in ComponentState) then
	begin
		DeallocateHWnd(FHwnd);
	end;
	inherited Destroy;
end;

function TComm32.StartComm: Boolean;
var
	commtimeouts:	TCommTimeouts;
	dcb:				Tdcb;
	commprop:		TCommProp;
	fdwEvtMask:		DWORD;
	hNewCommFile: THandle;
begin
 if (hCommFile <> 0) then
  raise ECommsError.Create( '项痱 箧