设备读写通用对象 Delphi下创建

因为要在delphi下读写USB设备，而ReadFile和WriteFile同步是很麻烦的事，同时在主线程里操作这两个读写函数也不合适。在DELPHI下搞过串口编程的很多人知道有名的SPCOMM控件，其实只要稍稍对SPCOMM改进一下就可以读写任何设备文件了（当然你要提供设备的符号名SymbolicName）,如果是串口当然还是“COM1，COM2...”,如果是其他设备就需要在注册表里查找以下了，例如我知道我的USB设备的GUID是“{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}”，查找一下，马上可以找到它的符号名“//?/Root#NEWDEVICECLASS#0004#{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}”。在对象的UsbName属性里输入上面的符号名，同时保留了OnReceiveData，OnRequestHangup两个事件属性。更多说明还是看实现代码吧。

{

PROPERTY
========
你自己看吧

METHOD
======

  procedure StartUsb

      Start a Usbunication for this Usb port.
      If failure, raise EUsbsError exception and EUsbsError.Message contain
      following string:
          'This usb already opened'
          'Error opening usb'
          'File handle is not a Usb handle'
          'Cannot setup Usb buffer'
          'Unable to create event'
          'Unable to create read thread'
          'Unable to create write thread'

  procedure StopUsb

      Stop and end all Usbunication threads for this Usb port.
      No any return.

  function WriteUsbData( pDataToWrite: PChar;
                          dwSizeofDataToWrite: Word ): Boolean

      Send a String to the Write Thread to be written to the Usb.
      This subroutine will return immediately. The send operation will
      do in background.
      Parameters:
          pszStringToWrite     - string to Write to Usb port.
          nSizeofStringToWrite - length of pszStringToWrite.
      Return:
          TRUE : if the PostMessage to write thread is successful.
          FALSE: if PostMessage fails or Write thread doesn't exist.

 
EVENT HANDLER
=============

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

      When The input buffer contains received data
      the event handler is called
      Sender : point to TUsb object which raise this call
      Buffer : the buffer which contains received data
      BufferLength : the size of received data in Buffer

LEGALITIES
==========

This component is totally free (along with source code).

James Deng     http://blog.youkuaiyun.com/yueyahe  dyong0329@sina.com

}

unit SPUsb;
// This Usbunications Component is implemented using separate Read and Write
// threads. Messages from the threads are posted to the Usb control which is
// an invisible window. To handle data from the usb 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 usb port, some
// changes to this component are needed ('StartUsb' currently opens the usb
// port). The 'OnRequestHangup' event is included to assist this.
//   
// James Deng
// 04/03/2006
// DYong0329@sina.com

//   ****Special Note：this unit SPUsb adapt From SPCOMM ****//

interface

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

const
     // messages from read/write threads
     PWM_GOTUSBDATA = WM_USER + 1;
     PWM_REQUESTHANGUP = WM_USER + 2;

     PWM_SENDDATAEMPTY = WM_USER + 5;
type
    EUsbsError = class( Exception );
    TReceiveDataEvent = procedure(Sender: TObject; Buffer: Pointer;
                                  BufferLength: Word) of object;
type
    TReadThread = class( TThread )
    protected
      procedure Execute; override;
    public
      hUsbFile:          THandle;
      hCloseEvent:        THandle;
      hUsb32Window:      THandle;

      function SetupReadEvent( lpOverlappedRead: POverlapped;
                               lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
                               var lpnNumberOfBytesRead: DWORD ): 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
      hUsbFile:          THandle;
      hCloseEvent:        THandle;
      hUsb32Window:      THandle;
      pFSendDataEmpty:    ^Boolean;
      procedure PostHangupCall;
    end;

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

      FUsbName:          String;
      FOnReceiveData:     TReceiveDataEvent;
      FOnRequestHangup:   TNotifyEvent;
      procedure UsbWndProc( var msg: TMessage );

    protected
      { Protected declarations }
      procedure CloseReadThread;
      procedure CloseWriteThread;
      procedure ReceiveData(Buffer: PChar; BufferLength: Word);

      procedure RequestHangup;
    public
      { Public declarations }
      property Handle: THandle read hUsbFile;
      property SendDataEmpty : Boolean read FSendDataEmpty;//? will be del
      constructor Create( AOwner: TComponent ); override;
      destructor Destroy; override;
      procedure StartUsb;
      procedure StopUsb;
      function WriteUsbData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
    
    published
      { Published declarations }
      property UsbName: String read FUsbName write FUsbName;
      property OnReceiveData: TReceiveDataEvent
               read FOnReceiveData write FOnReceiveData;

      property OnRequestHangup: TNotifyEvent       {挂起通知}
               read FOnRequestHangup write FOnRequestHangup; 
    end;

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

// Default size of the Input Buffer used by this code.
     INPUTBUFFERSIZE = 4096;// 4k

procedure Register;

implementation

(******************************************************************************)
//   TSPUsb PUBLIC METHODS
(******************************************************************************)

constructor TSPUsb.Create( AOwner: TComponent );
begin
     inherited Create( AOwner );

     ReadThread := nil;
     WriteThread := nil;
     hUsbFile := 0;
     hCloseEvent := 0;
     FSendDataEmpty := True;

     //You can Find this string from Regester
     FUsbName := '//?/ROOT#WAHBOOK#0000#{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}';

{AllocateHWnd(WndProc)创建一个看不见的窗口，返回他的句柄，并指定WndProc为窗口的消息处理过程}
     if not (csDesigning in ComponentState) then
        FHWnd := AllocateHWnd(UsbWndProc) 
end;

destructor TSPUsb.Destroy;
begin
     if not (csDesigning