原创 Delphi USB Bulk USB Driver Interface

unit usbdriver;

{
CTRL EndPoint 0 - Read/Write
BULK EndPoint 1 - Read Only
BULK EndPoint 2 - Write Only
}

interface

uses
  Windows, SysUtils;

type
  THDEVINFO = THANDLE;

type
  // types for asynchronous calls
  TOperationKind = (okWrite, okRead);
  TAsync = record
    Overlapped: TOverlapped;
    Kind: TOperationKind;
    Data: Pointer;
    Size: Integer;
  end;
  PAsync = ^TAsync;

//------------------------------------------------------------------------------
// GUID
//------------------------------------------------------------------------------
type
  P_GUID_ = ^_GUID_;
  _GUID_ = record
    Data1: DWord;
    Data2: word;
    Data3: word;
    Data4: array [0..7] of Byte;
  end;

const

  USB_DRIVER_GUID : _GUID_ = ( //bulkusb.sys from w2k3 ddk bulkusr.h
    Data1 : $BCFD69CB;
    Data2 : $5B89;
    Data3 : $44C8;
    Data4 : ($95, $6c, $3F, $B6, $46, $80, $B5, $7A));

//------------------------------------------------------------------------------
// SP_DEVICE_INTERFACE_DETAIL_DATA_A, *PSP_DEVICE_INTERFACE_DETAIL_DATA_A;
//------------------------------------------------------------------------------
  type
    P_SP_INTERF_DETAIL_ = ^_SP_INTERF_DETAIL_;
    _SP_INTERF_DETAIL_ = packed record
      cbSize: DWord;
      DevPath: char;
    end;

//------------------------------------------------------------------------------
// SP_DEVICE_INTERFACE_DATA, *PSP_DEVICE_INTERFACE_DATA;
//------------------------------------------------------------------------------
  type
    P_SP_INTERF_ = ^_SP_INTERF_;
    _SP_INTERF_ = record
      cbSize: DWord;
      Guid: _GUID_;
      Flags: DWord;
      Reserve: Pointer;
    end;

//------------------------------------------------------------------------------
// SP_DEVINFO_DATA, *PSP_DEVINFO_DATA;
//------------------------------------------------------------------------------
  type
    P_SP_INFO_ = ^_SP_INFO_;
    _SP_INFO_ = record
      cbSize: DWord;
      Guid: _GUID_;
      DevInst: DWord;
      Reserve: DWord;
    end;

//------------------------------------------------------------------------------
//HANDLES for usb BulkIn/BulkOut
//------------------------------------------------------------------------------
var
  hMyDevice       : THANDLE;
  hMyDevPipeIn    : THANDLE;
  hMyDevPipeOut   : THANDLE;

const
  PipeInName  : string = '\Pipe00';
  PipeOutName : string = '\Pipe01';

function usbOpenMyDevice() : boolean;
procedure usbCloseMyDevice();

function usbOpenMyDevPipeOut() : boolean;
function usbOpenMyDevPipeIn() : boolean;

procedure usbCloseMyDevPipeOut();
procedure usbCloseMyDevPipeIn();

//with HMyDevPipeIn always
function usbRead(TimeOut : DWord; dwCount : DWord; var Buffer): integer;

//with HMyDevPipeOut always
function usbWrite(TimeOut : DWord; dwCount : DWord; const Buffer): integer;

implementation

function SetupDiGetClassDevsA(Guid: P_GUID_; Enumrator: PChar; hPar: THANDLE;
  Flags: DWord ): THANDLE; stdcall; external 'SETUPAPI.DLL';

function SetupDiEnumDeviceInterfaces(DevInfo: THANDLE; InfoData: P_SP_INFO_;
  Guid: P_GUID_; Index: DWord; DevInterfD: P_SP_INTERF_ )
    : bool; stdcall; external 'SETUPAPI.DLL';

function SetupDiDestroyDeviceInfoList( hPar: THANDLE )
  : bool; stdcall; external 'SETUPAPI.DLL';

function SetupDiGetDeviceInterfaceDetailA( DevInfo: THANDLE;
  InterData: P_SP_INTERF_; InfoDetail: P_SP_INTERF_DETAIL_; DetailSize: DWord;
    ReqSize: PDWord; InfoData: P_SP_INFO_ )
      : bool; stdcall; external 'SETUPAPI.DLL';

//------------------------------------------------------------------------------
// use SetupDiGetClassDevsA
//------------------------------------------------------------------------------
const DIGCF_DEFAULT         = $001;
const DIGCF_PRESENT         = $002;
const DIGCF_ALLCLASSES      = $004;
const DIGCF_PROFILE         = $008;
const DIGCF_DEVICEINTERFACE = $010;

//------------------------------------------------------------------------------
// initialization of PAsync variables used in asynchronous calls
//------------------------------------------------------------------------------
procedure InitAsync(var AsyncPtr: PAsync);
begin
  New(AsyncPtr);
  with AsyncPtr^ do
  begin
    FillChar(Overlapped, SizeOf(TOverlapped), 0);
    Overlapped.hEvent := CreateEvent(nil, True, FALSE, nil);
    Data := nil;
    Size := 0;
  end;
end;

//------------------------------------------------------------------------------
// clean-up of PAsync variable
//------------------------------------------------------------------------------
procedure DoneAsync(var AsyncPtr: PAsync);
begin
  with AsyncPtr^ do
  begin
    CloseHandle(Overlapped.hEvent);
    if Data <> nil then
      FreeMem(Data);
  end;
  Dispose(AsyncPtr);
  AsyncPtr := nil;
end;

//------------------------------------------------------------------------------
// prepare PAsync variable for read/write operation
//------------------------------------------------------------------------------
procedure PrepareAsync(AKind: TOperationKind; const Buffer;
  Count: Integer; AsyncPtr: PAsync);
begin
  with AsyncPtr^ do
  begin
    Kind := AKind;
    if Data <> nil then
      FreeMem(Data);
    GetMem(Data, Count);
    Move(Buffer, Data^, Count);
    Size := Count;
  end;
end;

//------------------------------------------------------------------------------
// wait for asynchronous operation to end : TimeOut : Result = -1
//------------------------------------------------------------------------------
function WaitForAsync(hReadOrWrite : THandle; TimeOut : DWord; var AsyncPtr: PAsync): Integer;
var
  BytesTrans, Signaled: DWORD;
  Success: Boolean;
begin
  result := -1;                 //Signaled = WAIT_OBJECT_TIMEOUT
  if WAIT_OBJECT_0 <> WaitForSingleObject(AsyncPtr^.Overlapped.hEvent, TimeOut) then Exit;
  if not GetOverlappedResult(hReadOrWrite, AsyncPtr^.Overlapped, BytesTrans, False) then Exit;
  Result := BytesTrans;
end;

//------------------------------------------------------------------------------
// perform asynchronous write operation
//------------------------------------------------------------------------------
function WriteAsync(hWrite : THandle; const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
var
  Success: Boolean;
  BytesTrans: DWORD;
begin
  result := -1;
 
  PrepareAsync(okWrite, Buffer, Count, AsyncPtr);

  Success := WriteFile(hWrite, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped)
    or (GetLastError = ERROR_IO_PENDING);

  //if Device is not present -- Success is FALSE !   
  if not Success then Exit;
 
  Result := BytesTrans; //if WriteFile is Complete at once
end;

//------------------------------------------------------------------------------
// perform synchronous write operation
//------------------------------------------------------------------------------
function Write(hWrite : THandle; TimeOut : DWord; const Buffer; Count: Integer): Integer;
var
  AsyncPtr: PAsync;
begin
  InitAsync(AsyncPtr);
  try
    Result := WriteAsync(hWrite, Buffer, Count, AsyncPtr);
    if Result = Count then Exit;

    Result := WaitForAsync(hWrite, TimeOut, AsyncPtr);
  finally
    DoneAsync(AsyncPtr);
  end;
end;

//------------------------------------------------------------------------------
// perform asynchronous read operation
//------------------------------------------------------------------------------
function ReadAsync(hRead : THandle; var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
var
  ErrorCode : DWord;
  BytesTrans: DWORD;
begin
  result := -1;

  AsyncPtr^.Kind := okRead;
  //PrepareAsync(okRead, Buffer, Count, AsyncPtr);

  if not ReadFile(hRead, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped) then
  begin
    ErrorCode := GetLastError;
    if (ErrorCode <> ERROR_IO_PENDING) then
    begin
      //ShowMessage(SysErrorMessage(GetLastError));
      Exit;
    end;
  end;

  Result := BytesTrans;
end;

//------------------------------------------------------------------------------
// perform synchronous read operation
//------------------------------------------------------------------------------
function Read(hRead : THandle; TimeOut : DWord; var Buffer; Count: Integer): Integer;
var
  AsyncPtr: PAsync;
begin
  InitAsync(AsyncPtr);
  try
    ReadAsync(hRead, Buffer, Count, AsyncPtr);
    Result := WaitForAsync(hRead, TimeOut, AsyncPtr);
  finally
    DoneAsync(AsyncPtr);
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function OpenOneDevice(
  hDevInfo : THDEVINFO;
  DevInfoData : P_SP_INTERF_;
  sDevNameBuf : PChar) : THANDLE;
var
  iReqLen : DWord;
  iDevDataLen : DWord;
  pDevData : P_SP_INTERF_DETAIL_;
begin
  Result := INVALID_HANDLE_VALUE;

  iReqLen := 0;
  SetupDiGetDeviceInterfaceDetailA(
    hDevInfo, DevInfoData, nil, 0, @iReqLen, nil);

  iDevDataLen := iReqLen; //sizeof(SP_FNCLASS_DEVICE_DATA) + 512;
  try
    GetMem(pDevData, iDevDataLen);
  except
    SetupDiDestroyDeviceInfoList(hDevInfo);
    exit;
  end;
  pDevData.cbSize := sizeof(_SP_INTERF_DETAIL_);

  if not SetupDiGetDeviceInterfaceDetailA(
    hDevInfo, DevInfoData, pDevData, iDevDataLen, @iReqLen, nil) then
  begin
    FreeMem(pDevData);
    SetupDiDestroyDeviceInfoList(hDevInfo);
    exit;
  end;
  StrCopy( sDevNameBuf, @pDevData.DevPath );

  Result := CreateFile(sDevNameBuf,
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, 0, 0);

  FreeMem(pDevData);
  SetupDiDestroyDeviceInfoList(hDevInfo);
end;

//------------------------------------------------------------------------------
function OpenUsbDevice(const pGuid: P_GUID_;
  sDevNameBuf: PChar) : THANDLE;
var
  hDevInfo : THDEVINFO;
  deviceInfoData : _SP_INTERF_;
  nGuessCount : DWord;
  iDevIndex : DWord;
begin
  Result := INVALID_HANDLE_VALUE;
  hDevInfo := SetupDiGetClassDevsA(
    pGuid, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  deviceInfoData.cbSize := sizeof (_SP_INTERF_);
  nGuessCount := $8000;
  for iDevIndex := 0 to nGuessCount-1 do
  begin
    if SetupDiEnumDeviceInterfaces(
      hDevInfo, nil, pGuid, iDevIndex, @deviceInfoData) then
    begin
      Result := OpenOneDevice(hDevInfo, @deviceInfoData, sDevNameBuf);
      if Result <> INVALID_HANDLE_VALUE then
        break
    end
    //No more items
    else if GetLastError() = ERROR_NO_MORE_ITEMS then
        break;
  end;
  SetupDiDestroyDeviceInfoList(hDevInfo);
end;

//------------------------------------------------------------------------------
function GetUsbDeviceFileName(const pGuid: P_GUID_;
  sDevNameBuf: PChar) : boolean;
var
  hDev : THANDLE;
begin
  Result := False;
  hDev := OpenUsbDevice(pGuid, sDevNameBuf);
  if hDev <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(hDev);
    Result := True;
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function OpenMyDeviceEx() : THANDLE;
var
  DeviceName : string;
begin
  SetLength(DeviceName, 1024);
  Result := OpenUsbDevice(@USB_DRIVER_GUID, PChar(DeviceName));  // USB_DRIVER_GUID
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure CloseMyDeviceEx(hDev : THANDLE);
begin
  try
    if hDev <> INVALID_HANDLE_VALUE then
      CloseHandle(hDev);
  except
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function OpenMyDevPipe(PipeName : string) : THANDLE;
var
  completeDeviceName : string;
  completeDevicePipeName : string;
begin
  Result := INVALID_HANDLE_VALUE;
  SetLength(completeDeviceName, 1024);
  SetLength(completeDevicePipeName, 1024);
  if GetUsbDeviceFileName(@USB_DRIVER_GUID, PChar(completeDeviceName)) then
  begin
    completeDevicePipeName := StrPas(PChar(completeDeviceName)) + PipeName;
    Result := CreateFile(
      PChar(completeDevicePipeName),
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      nil, OPEN_EXISTING, 0, 0);
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function OpenMyDevPipeAsync(PipeName : string) : THANDLE;
var
  completeDeviceName : string;
  completeDevicePipeName : string;
begin
  Result := INVALID_HANDLE_VALUE;
  SetLength(completeDeviceName, 1024);
  SetLength(completeDevicePipeName, 1024);
  if GetUsbDeviceFileName(@USB_DRIVER_GUID, PChar(completeDeviceName)) then
  begin
    completeDevicePipeName := StrPas(PChar(completeDeviceName)) + PipeName;
    Result := CreateFile(
      PChar(completeDevicePipeName),
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);  //FILE_FLAG_OVERLAPPED
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure CloseMyDevPipe(hPipe : THANDLE);
begin
  try
    if hPipe <> INVALID_HANDLE_VALUE then
      CloseHandle(hPipe);
  except
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function DeviceConnected() : boolean;
var
  hMyDev : THandle;
begin
  hMyDev := OpenMyDeviceEx();
  Result :=  hMyDev <> INVALID_HANDLE_VALUE;
  CloseMyDeviceEx(hMyDev);
end;

//------------------------------------------------------------------------------
//uses hMyDevPipeOut always
//------------------------------------------------------------------------------
function usbWrite(TimeOut : DWord; dwCount : DWord; const Buffer): integer;
begin
  Result := usbdriver.Write(hMyDevPipeOut, TimeOut, Buffer, dwCount);
end;

//------------------------------------------------------------------------------
//uses hMyDevPipeIn always
//------------------------------------------------------------------------------
function usbRead(TimeOut : DWord; dwCount : DWord; var Buffer): integer;  
begin
  Result := 0;
  while Result = 0  do
  begin
    Result := usbdriver.Read(hMyDevPipeIn, TimeOut, Buffer, dwCount);
  end;    // while
end;

function usbOpenMyDevice() : boolean;
begin
  result := False;

  hMyDevice := INVALID_HANDLE_VALUE;
  hMyDevice := OpenMyDeviceEx();
  if hMyDevice = INVALID_HANDLE_VALUE then Exit;

  result := TRUE;
end;

procedure usbCloseMyDevice();
begin
  if hMyDevice <> INVALID_HANDLE_VALUE then
    CloseHandle(hMyDevice);
end;

function usbOpenMyDevPipeOut() : boolean;
begin
  result := False;

  hMyDevPipeOut := INVALID_HANDLE_VALUE;
  hMyDevPipeOut := OpenMyDevPipeAsync(PipeOutName);
  if hMyDevPipeOut = INVALID_HANDLE_VALUE then Exit;

  result := TRUE;
end;

function usbOpenMyDevPipeIn() : boolean;
begin
  result := False;

  hMyDevPipeIn := INVALID_HANDLE_VALUE;
  hMyDevPipeIn := OpenMyDevPipeAsync(PipeInName);
  if hMyDevPipeIn = INVALID_HANDLE_VALUE then Exit;

  result := TRUE;
end;

procedure usbCloseMyDevPipeOut();
begin
  if hMyDevPipeOut <> INVALID_HANDLE_VALUE then
    CloseMyDevPipe(hMyDevPipeOut);
end;

procedure usbCloseMyDevPipeIn();
begin
  if hMyDevPipeIn <> INVALID_HANDLE_VALUE then
    CloseMyDevPipe(hMyDevPipeIn);
end;

end.

/////////////////////////////////////////////////////////////////

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses usbdriver;

{$R *.dfm}

var
  Stop : boolean;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  BulkBuffer : array[0..65535-1] of byte;
  BulkBuffer2 : array[0..65535-1] of byte;
  WriteCount, ReadCount : integer;
begin
  for I := 0 to 65535 - 1 do    // Iterate
  begin
    BulkBuffer := i;
  end;    // for