设备读写通用对象 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.csdn.net/yueyahe  [email protected]

}

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
// [email protected]

//   ****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 in ComponentState) then
        DeallocateHWnd(FHwnd);
       
     inherited Destroy;
end;

//
//  FUNCTION: StartUsb

//  PURPOSE: Starts communications over the usb port.
//    StartUsb makes sure there isn't communication in progress already,
//    creates a Usb file, and creates the read and write threads.
procedure TSPUsb.StartUsb;
var
   hNewUsbFile:   THandle;
begin
     // Are we already doing usb?
     if (hUsbFile <> 0) then
        raise EUsbsError.Create( 'This usb device already opened' );

     hNewUsbFile := CreateFile( PChar(FUsbName),
                                 GENERIC_READ or GENERIC_WRITE,
                                 0, {not shared}
                                 nil, {no security ??}
                                 OPEN_EXISTING,
                                 FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
                                 0 {template} );

     if hNewUsbFile = INVALID_HANDLE_VALUE then
        raise EUsbsError.Create( 'Error opening usb device' );

     // It is ok to continue.
     hUsbFile := hNewUsbFile;

     // Create the event that will signal the threads to close.
     hCloseEvent := CreateEvent( nil, True, False, nil );
     if hCloseEvent = 0 then
     begin
          CloseHandle( hUsbFile );
          hUsbFile := 0;
          raise EUsbsError.Create( 'Unable to create event' )
     end;

     // Create the Read thread.
     try
        ReadThread := TReadThread.Create( True {suspended} );
     except
           ReadThread := nil;
           CloseHandle( hCloseEvent );
           CloseHandle( hUsbFile );
           hUsbFile := 0;
           raise EUsbsError.Create( 'Unable to create read thread' )
     end;
     ReadThread.hUsbFile := hUsbFile;
     ReadThread.hCloseEvent := hCloseEvent;
     ReadThread.hUsb32Window := FHWnd;
     // Usb threads should have a higher base priority than the UI thread.
     // If they don't, then any temporary priority boost the UI thread gains
     // could cause the USB threads to loose data.
     ReadThread.Priority := tpHighest;

     // Create the Write thread.
     try
        WriteThread := TWriteThread.Create( True {suspended} );
     except
           CloseReadThread;
           WriteThread := nil;
           CloseHandle( hCloseEvent );
           CloseHandle( hUsbFile );
           hUsbFile := 0;
           raise EUsbsError.Create( 'Unable to create write thread' )
     end;
     WriteThread.hUsbFile := hUsbFile;
     WriteThread.hCloseEvent := hCloseEvent;
     WriteThread.hUsb32Window := FHWnd;
     WriteThread.pFSendDataEmpty := @FSendDataEmpty;
    
     WriteThread.Priority := tpHigher;

     ReadThread.Resume;
     WriteThread.Resume

     // Everything was created ok.  Ready to go!
end; {TSPUsb.StartUsb}

//
//  FUNCTION: StopUsb
//
//  PURPOSE: Stop and end all communication threads.
procedure TSPUsb.StopUsb;
begin
     // No need to continue if we're not communicating.
     if hUsbFile = 0 then
        Exit;

     // Close the threads.Using Tusb's functiong
     CloseReadThread;
     CloseWriteThread;

     // Not needed anymore.
     CloseHandle( hCloseEvent );

     // Now close the usb port handle.
     CloseHandle( hUsbFile );
     hUsbFile := 0
end; {TSPUsb.StopUsb}

//
//  FUNCTION: WriteUsbData(PChar, Word)
//
//  PURPOSE: Send a String to the Write Thread to be written to the Usb.
//    This is a wrapper function so that other modules don't care that
//    Usb writing is done via PostMessage to a Write thread.
//
//  RETURN VALUE:TRUE or FALSE.
function TSPUsb.WriteUsbData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
   Buffer: Pointer;
begin
     if (WriteThread <> nil) and (dwSizeofDataToWrite <> 0) then
     begin
          Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
          Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
  
   {PostThreadMessage is a API,将一条消息投递到指定窗口的消息队列 }
          if PostThreadMessage( WriteThread.ThreadID, PWM_USBWRITE,
                                WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
          begin
               FSendDataEmpty := False;
               Result := True;
               Exit
          end
     end;

     Result := False
end; {TSPUsb.WriteUsbData}

(******************************************************************************)
//  TSPUsb PROTECTED METHODS
(******************************************************************************)
//  FUNCTION: CloseReadThread
//
//  PURPOSE: Close the Read Thread.
procedure TSPUsb.CloseReadThread;
begin
     // If it exists...
     if ReadThread <> nil then
     begin
          // Signal the event to close the worker threads.
          SetEvent( hCloseEvent );

          // Wait 10 seconds for it to exit.  Shouldn't happen.
          if (WaitForSingleObject(ReadThread.Handle, 10000) = WAIT_TIMEOUT) then
             ReadThread.Terminate;
          ReadThread.Free;
          ReadThread := nil
     end
end; {TSPUsb.CloseReadThread}

//
//  FUNCTION: CloseWriteThread
//
//  PURPOSE: Closes the Write Thread.
procedure TSPUsb.CloseWriteThread;
begin
     // If it exists...
     if WriteThread <> nil then
     begin
          // Signal the event to close the worker threads.
          SetEvent(hCloseEvent);

          // Wait 10 seconds for it to exit.  Shouldn't happen.
          if WaitForSingleObject( WriteThread.Handle, 10000 ) = WAIT_TIMEOUT then
             WriteThread.Terminate;
          WriteThread.Free;
          WriteThread := nil
     end
end; {TSPUsb.CloseWriteThread}

procedure TSPUsb.ReceiveData(Buffer: PChar; BufferLength: Word);
begin
     if Assigned(FOnReceiveData) then
        FOnReceiveData( self, Buffer, BufferLength )
end;

procedure TSPUsb.RequestHangup;
begin
     if Assigned(FOnRequestHangup) then
        FOnRequestHangup( Self )
end;

(******************************************************************************)
//  TSPUsb PRIVATE METHODS 消息循环处理
(******************************************************************************)

procedure TSPUsb.UsbWndProc( var msg: TMessage );
begin
     case msg.msg of
          PWM_GOTUSBDATA:
  begin
   ReceiveData( PChar(msg.LParam), msg.WParam );
   LocalFree( msg.LParam )
  end;
          PWM_REQUESTHANGUP:   RequestHangup;

     end
end;

(******************************************************************************)
//  READ THREAD
(******************************************************************************)
//  PROCEDURE: TReadThread.Execute
//
//  PURPOSE: This is the starting point for the Read Thread.
procedure TReadThread.Execute;
var
   szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
   nNumberOfBytesRead:    DWORD;

   HandlesToWaitFor:      array[0..1] of THandle;
   dwHandleSignaled:      DWORD;

   // Needed for overlapped I/O (ReadFile)
   overlappedRead:                TOverlapped;

label
     EndReadThread;
begin

     {if not PostMessage( hUsb32Window, PWM_GOTUSBDATA,
                        1, 1 ) then
     PostHangupCall;   //Only test，by James Deng}

     {The FillChar procedure fills out a section of storage Buffer
     with the same byte or character FillValue FillCount times. }
     FillChar( overlappedRead, Sizeof(overlappedRead), 0 );

     // Lets put an event in the Read overlapped structure.
     overlappedRead.hEvent := CreateEvent( nil, True, True, nil);
     if overlappedRead.hEvent = 0 then
     begin
          PostHangupCall;
          goto EndReadThread
     end;

     // We will be waiting on these objects.
     HandlesToWaitFor[0] := hCloseEvent;
     HandlesToWaitFor[1] := overlappedRead.hEvent;

     // Start waiting for Read events.
     if not SetupReadEvent( @overlappedRead,
                            szInputBuffer, INPUTBUFFERSIZE,
                            nNumberOfBytesRead ) then
        goto EndReadThread;

     // Keep looping until we break out.
     while True do
     begin
          // Wait until some event occurs ( stopping;data to read).
          dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,
                              False, INFINITE);

          // Which event occured?
          CASE dwHandleSignaled of
               WAIT_OBJECT_0:// Signal to end the thread.
               begin
                    goto EndReadThread// Time to exit.
               end;

               WAIT_OBJECT_0 + 1: // Read Event signaled.
               begin
                    // Get the new data!
                    if not HandleReadEvent( @overlappedRead,
                                            szInputBuffer,
                                            INPUTBUFFERSIZE,
                                            nNumberOfBytesRead ) then
                       goto EndReadThread;

                    //SetupReadEvent Again, Wait for more new data.
                    if not SetupReadEvent( @overlappedRead,
                                           szInputBuffer, INPUTBUFFERSIZE,
                                           nNumberOfBytesRead ) then
                       goto EndReadThread
                    {break;}
               end;

               WAIT_FAILED:       // Wait failed.  Shouldn't happen.
               begin
                    PostHangupCall;
                    goto EndReadThread
               end

               else // This case should never occur.
               begin
                    PostHangupCall;
                    goto EndReadThread
               end
              
          end {case dwHandleSignaled}
     end; {while True}

       
 // Time to clean up Read Thread.
 EndReadThread:
     CloseHandle( overlappedRead.hEvent );

end; {TReadThread.Execute}

//
//  FUNCTION: SetupReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
//  PURPOSE: Sets up an overlapped ReadFile

function TReadThread.SetupReadEvent( lpOverlappedRead: POverlapped;
         lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
         var lpnNumberOfBytesRead: DWORD ): Boolean;
var
   dwLastError: DWORD;
label
     StartSetupReadEvent;
begin
     Result := False;

StartSetupReadEvent:

     // Make sure the CloseEvent hasn't been signaled yet.
     // Check is needed because this function is potentially recursive.
     if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
        Exit;

     // Start the overlapped ReadFile.
     {当ReadFile和WriteFile返回FALSE时，不一定就是操作失败，
     线程应该调用GetLastError函数分析返回的结果。例如，在重叠（异步）操作时如果操作还未完成函数就返回，
     那么函数就返回FALSE，而且GetLastError函数返回ERROR_IO_PENDING。}
     {通常情况下，下面的ReadFile都会立即返回FALSE，且LastError was ERROR_IO_PENDING}
     if ReadFile( hUsbFile,
                  lpszInputBuffer^, dwSizeofBuffer,
                  lpnNumberOfBytesRead, lpOverlappedRead ) then
     begin
          // This would only happen if there was data waiting to be read.

          // Handle the data.
          if not HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead ) then
             Exit;

          // Start waiting for more data.
          goto StartSetupReadEvent
     end;

     // ReadFile failed.  Expected because of overlapped I/O.
     dwLastError := GetLastError;

     // LastError was ERROR_IO_PENDING, as expected.
     if dwLastError = ERROR_IO_PENDING then
     begin
          Result := True;
          Exit
     end;

     // Its possible for this error to occur if the
     // service provider has closed the port.  Time to end.
     if dwLastError = ERROR_INVALID_HANDLE then
        Exit;

     // Unexpected error come here. No idea what could cause this to happen.
     PostHangupCall
end; {TReadThread.SetupReadEvent}

//
//  FUNCTION: HandleReadData(LPCSTR, DWORD)
//
//  PURPOSE: Deals with data after its been read from the usb file.
function TReadThread.HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
var
   lpszPostedBytes: LPSTR;
begin
     Result := False;

     // If we got data and didn't just time out empty...
     if dwSizeofBuffer <> 0 then
     begin
          // Do something with the bytes read.

          lpszPostedBytes := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );

          if lpszPostedBytes = nil{NULL} then
          begin
               // Out of memory
               PostHangupCall;
               Exit
          end;

          Move( lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer );
          lpszPostedBytes[dwSizeofBuffer] := #0;

          Result := ReceiveData( lpszPostedBytes, dwSizeofBuffer )
     end
end; {TReadThread.HandleReadData}

//
//  FUNCTION: HandleReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
//  PURPOSE: Retrieves and handles data when there is data ready.
//
//  PARAMETERS:
//    lpOverlappedRead      - address of overlapped structure to use.
//    lpszInputBuffer       - Buffer to place incoming bytes.
//    dwSizeofBuffer        - size of lpszInputBuffer.
//    lpnNumberOfBytesRead  - address of DWORD to place the number of read bytes.
function TReadThread.HandleReadEvent( lpOverlappedRead: POverlapped;
         lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
         var lpnNumberOfBytesRead: DWORD ): Boolean;
var
   dwLastError: DWORD;
begin
     Result := False;
    
     if GetOverlappedResult( hUsbFile,
                             lpOverlappedRead^, lpnNumberOfBytesRead, False ) then
     begin
          Result := HandleReadData( lpszInputBuffer, lpnNumberOfBytesRead );
          Exit
     end;

     // Error in GetOverlappedResult; handle it.
     dwLastError := GetLastError;

     // Its possible for this error to occur if the
     // service provider has closed the port.  Time to end.
     if dwLastError = ERROR_INVALID_HANDLE then
        Exit;

     // Unexpected error come here. No idea what could cause this to happen.
     PostHangupCall
end; {TReadThread.HandleReadEvent}

function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
begin
     Result := False;
     if not PostMessage( hUsb32Window, PWM_GOTUSBDATA,
                         WPARAM(dwSizeofNewString), LPARAM(lpNewString) ) then
        PostHangupCall
     else
         Result := True
end;

procedure TReadThread.PostHangupCall;
begin
     PostMessage( hUsb32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

(******************************************************************************)
//  WRITE THREAD
(******************************************************************************)
//  PROCEDURE: TWriteThread.Execute
//  PURPOSE: The starting point for the Write thread.
//  USBENTS:
//    The Write thread uses a PeekMessage loop to wait for a string to write,
//    and when it gets one, it writes it to the Usb port.  If the CloseEvent
//    object is signaled, then it exits.  The use of messages to tell the
//    Write thread what to write provides a natural desynchronization between
//    the UI and the Write thread.
procedure TWriteThread.Execute;
var
   msg:   TMsg;
   dwHandleSignaled:      DWORD;
   overlappedWrite:       TOverLapped;
   CompleteOneWriteRequire : Boolean;
label
     EndWriteThread;
begin
     // Needed for overlapped I/O.
     FillChar( overlappedWrite, SizeOf(overlappedWrite), 0 );  {0, 0, 0, 0, NULL}

     overlappedWrite.hEvent := CreateEvent( nil, True, True, nil );
     if overlappedWrite.hEvent = 0 then
     begin
          PostHangupCall;
          goto EndWriteThread
     end;

     CompleteOneWriteRequire := True;

     // This is the main loop.  Loop until we break out.
     while True do
     begin
          if not PeekMessage( msg, 0, 0, 0, PM_REMOVE ) then
          begin
               // If there are no messages pending, wait for a message or
               // the CloseEvent.

               pFSendDataEmpty^ := True;

               if CompleteOneWriteRequire then
               begin
                    if not PostMessage( hUsb32Window, PWM_SENDDATAEMPTY, 0, 0 ) then
                    begin
                         PostHangupCall;
                         goto EndWriteThread
                    end
               end;

               CompleteOneWriteRequire := False;

               dwHandleSignaled := MsgWaitForMultipleObjects(1, hCloseEvent, False,
                                   INFINITE, QS_ALLINPUT);

               CASE dwHandleSignaled of
               WAIT_OBJECT_0:     // CloseEvent signaled!
               begin
                    // Time to exit.
                    goto EndWriteThread
               end;

               WAIT_OBJECT_0 + 1: // New message was received.
               begin
                    // Get the message that woke us up by looping again.
                    Continue
               end;

               WAIT_FAILED:       // Wait failed.  Shouldn't happen.
               begin
                    PostHangupCall;
                    goto EndWriteThread
               end
              
               else                // This case should never occur.
               begin
                    PostHangupCall;
                    goto EndWriteThread
               end
               end
          end;

          // Make sure the CloseEvent isn't signaled while retrieving messages.
          if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
             goto EndWriteThread;

          // Process the message.
          // This could happen if a dialog is created on this thread.
          // This doesn't occur in this sample, but might if modified.
          if msg.hwnd <> 0{NULL} then
          begin
               TranslateMessage(msg);
               DispatchMessage(msg);
               Continue
          end;

          // Handle the message.
          case msg.message of
          PWM_USBWRITE:  // New string to write to Usb port.
          begin
               // Write the string to the usb port.  HandleWriteData
               // does not return until the whole string has been written,
               // an error occurs or until the CloseEvent is signaled.
               if not HandleWriteData( @overlappedWrite,
                                       PChar(msg.lParam), DWORD(msg.wParam) ) then
               begin
                    // If it failed, either we got a signal to end or there
                    // really was a failure.

                    LocalFree( HLOCAL(msg.lParam) );
                    goto EndWriteThread
               end;

               CompleteOneWriteRequire := True;
               // Data was sent in a LocalAlloc()d buffer.  Must free it.
               LocalFree( HLOCAL(msg.lParam) )
          end
          end
     end; {end While ,the main loop}

     // Thats the end.  Now clean up.
EndWriteThread:

     //PurgeComm(hUsbFile, PURGE_TXABORT + PURGE_TXCLEAR);{PurgeComm is only for Comm }
     pFSendDataEmpty^ := True;
     CloseHandle(overlappedWrite.hEvent)
end; {TWriteThread.Execute}

//
//  FUNCTION: HandleWriteData(LPOVERLAPPED, LPCSTR, DWORD)
//
//  PURPOSE: Writes a given string to the usb file handle.
//
//  PARAMETERS:
//    lpOverlappedWrite  - Overlapped structure to use in WriteFile
//    pDataToWrite       - String to write.
//    dwNumberOfBytesToWrite - Length of String to write.
//
//  RETURN VALUE:
//    TRUE if all bytes were written.  False if there was a failure to
//    write the whole string.
//
//  USBENTS:
//
//    This function is a helper function for the Write Thread.  It
//    is this call that actually writes a string to the usb file.
//    Note that this call blocks and waits for the Write to complete
//    or for the CloseEvent object to signal that the thread should end.
//    Another possible reason for returning FALSE is if the usb port
//    is closed by the service provider.
//
//
function TWriteThread.HandleWriteData( lpOverlappedWrite: POverlapped;
         pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
var
   dwLastError,

   dwNumberOfBytesWritten,
   dwWhereToStartWriting,

   dwHandleSignaled:       DWORD;
   HandlesToWaitFor: array[0..1] of THandle;
begin
     Result := False;

     dwNumberOfBytesWritten := 0;
     dwWhereToStartWriting := 0; // Start at the beginning.

     HandlesToWaitFor[0] := hCloseEvent;
     HandlesToWaitFor[1] := lpOverlappedWrite^.hEvent;

     // Keep looping until all characters have been written.
     repeat
           // Start the overlapped I/O.
           if not WriteFile( hUsbFile,
                             pDataToWrite[ dwWhereToStartWriting ],
                             dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
                             lpOverlappedWrite ) then
           begin
                // WriteFile failed.  Expected; lets handle it.
                dwLastError := GetLastError;

                // Its possible for this error to occur if the
                // service provider has closed the port.  Time to end.
                if dwLastError = ERROR_INVALID_HANDLE then
                   Exit;

                // Unexpected error.  No idea what.
                if dwLastError <> ERROR_IO_PENDING then
                begin
                     PostHangupCall;
                     Exit
                end;

                // This is the expected ERROR_IO_PENDING case.

                // Wait for either overlapped I/O completion,
                // or for the CloseEvent to get signaled.
                dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,
                                    False, INFINITE);

                case dwHandleSignaled of
                WAIT_OBJECT_0:     // CloseEvent signaled!
                begin
                     // Time to exit.
                     Exit
                end;

                WAIT_OBJECT_0 + 1: // Wait finished.
                begin
                     // Time to get the results of the WriteFile
                     if not GetOverlappedResult(hUsbFile,
                                           lpOverlappedWrite^,
                                           dwNumberOfBytesWritten, True) then
                     begin
                          dwLastError := GetLastError;

                          // Its possible for this error to occur if the
                          // service provider has closed the port.
                          if dwLastError = ERROR_INVALID_HANDLE then
                             Exit;

                          // No idea what could cause another error.
                          PostHangupCall;
                          Exit
                     end
                end;

                WAIT_FAILED: // Wait failed.  Shouldn't happen.
                begin
                     PostHangupCall;
                     Exit
                end

                else // This case should never occur.
                begin
                     PostHangupCall;
                     Exit
                end
                end {case}
           end; {WriteFile failure}

           // Some data was written.  Make sure it all got written.

           Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
           Inc( dwWhereToStartWriting, dwNumberOfBytesWritten )
     until (dwNumberOfBytesToWrite <= 0);  // Write the whole thing!

     // Wrote the whole string.
     Result := True
end; {TWriteThread.HandleWriteData}

procedure TWriteThread.PostHangupCall;
begin
     PostMessage( hUsb32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

procedure Register;
begin
     RegisterComponents('System', [TSPUsb])
end;

end.