{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Class for WinUSB API                            }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 07 Nov 2010                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
{$MINENUMSIZE 4}
unit nrusb_winusb_api;
interface
uses windows, nrusbw32, nrusb_usb_api;

Type

  TnrWinUsbApi = class(TnrCustomUsbApi)
  private
    hDevice:THandle;
    hWinUsb:THandle;
  public
    function Open(nameSymbolic:string): THandle; override;
    procedure Close; override;
    function IsValid:boolean; override;
    function Write(idPipe:integer; data: pointer; len: integer; ovl:POVERLAPPED ):integer; override;
    function Read(idPipe:integer; data: pointer; len: integer; ovl:POVERLAPPED ):integer; override;
    function ResetPipe(idPipe:integer):boolean;  override;
    function AbortPipe(idPipe:integer): boolean;  override;
    function FlushPipe(idPipe:integer):boolean;  override;
    function ControlTransfer(request: TnrUsbRequest;
                            {packet : WINUSB_SETUP_PACKET;
                            data : Pointer;
                            len: dword;}
                            var sz : dword;
                            ovl:POVERLAPPED): boolean; override;
    function GetOverlappedResult(ovl:POVERLAPPED; var szRead:dword; timeout: dword):boolean; override;
    procedure PreparePipe(const idPipe:integer; const timeout:integer; const TransferType:TnrUsbTransferType); override;
  end;
  
implementation
uses nrwin32di;

Type
  TnrUsbPipePolicy = (uppShortPacketTerminate,
                      uppAutoClearStall,
//                      uppTransferTimout,
                      uppIgnoreShortPackets,
                      uppAllowPartialReads,
                      uppAutoFlush,
                      uppRawIO);
  TnrUsbPipePolicies = set of TnrUsbPipePolicy;


Var
  hWinUsbDLL : THandle = 0;

Const
  CS_WinUsb                 = 'Winusb.dll';

//  SHORT_PACKET_TERMINATE  = $01;
//  AUTO_CLEAR_STALL        = $02;
  PIPE_TRANSFER_TIMEOUT   = $03;
//  IGNORE_SHORT_PACKETS    = $04;
//  ALLOW_PARTIAL_READS     = $05;
//  AUTO_FLUSH              = $06;
//  RAW_IO                  = $07;
//  MAXIMUM_TRANSFER_SIZE   = $08;


function AllocWinUsbDLL:boolean;
begin
  if hWinUsbDLL = 0
    then hWinUsbDLL := LoadLibrary(CS_WinUsb);
  Result := (hWinUsbDLL <> 0);
end;

function WinUsb_Initialize(DeviceHandle:dword; var InterfaceHandle:THandle):boolean;
var p:function (DeviceHandle:dword; var InterfaceHandle:THandle):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_Initialize');
    if @p <> nil
      then Result := p(DeviceHandle,InterfaceHandle);
  end;
end;

function WinUsb_Free(InterfaceHandle:THandle):boolean;
var p:function (InterfaceHandle:THandle):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_Free');
    if @p <> nil
      then Result := p(InterfaceHandle);
  end;
end;

function WinUsb_QueryDeviceInformation(InterfaceHandle:THandle; InformationType:dword;
    var BufferLength:dword; Buffer:pointer):boolean;
var p:function (InterfaceHandle:THandle; InformationType:dword;
    var BufferLength:dword; Buffer:pointer):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_QueryDeviceInformation');
    if @p <> nil
      then Result := p(InterfaceHandle, InformationType, BufferLength, Buffer);
  end;
end;

function WinUsb_WritePipe(InterfaceHandle:THandle; PipeId:byte;
   Buffer:pointer; BufferLength:dword; var LengthTransferred:dword;
   Overlapped:POVERLAPPED):boolean;
var p:function (InterfaceHandle:THandle; PipeId:byte;
   Buffer:pointer; BufferLength:dword; var LengthTransferred:dword;
   Overlapped:POVERLAPPED):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_WritePipe');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId,Buffer,BufferLength,
                       LengthTransferred, Overlapped);
  end;
end;

function WinUsb_ReadPipe(InterfaceHandle:THandle; PipeId:byte;
   Buffer:pointer; BufferLength:dword; var LengthTransferred:dword;
   Overlapped:POVERLAPPED):boolean;
var p:function (InterfaceHandle:THandle; PipeId:byte;
   Buffer:pointer; BufferLength:dword; var LengthTransferred:dword;
   Overlapped:POVERLAPPED):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_ReadPipe');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId,Buffer,BufferLength,
                       LengthTransferred, Overlapped);
  end;
end;

function WinUsb_ResetPipe(InterfaceHandle:THandle; PipeId:byte):boolean;
var p:function (InterfaceHandle:THandle; PipeId:byte):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_ResetPipe');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId);
  end;
end;

function WinUsb_AbortPipe(InterfaceHandle:THandle; PipeId:byte):boolean;
var p:function (InterfaceHandle:dword; PipeId:byte):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_AbortPipe');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId);
  end;
end;

function WinUsb_FlushPipe(InterfaceHandle:THandle; PipeId:byte):boolean;
var p:function (InterfaceHandle:dword; PipeId:byte):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_FlushPipe');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId);
  end;
end;

function WinUsb_GetPipePolicy(InterfaceHandle:THandle; PipeId:byte;
        PolicyType:dword; var ValueLength:dword; Value:pointer):boolean;
var p:function (InterfaceHandle:THandle; PipeId:byte;
        PolicyType:byte;var ValueLength:dword; Value:pointer):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_GetPipePolicy');
    if @p <> nil
      then Result := p(InterfaceHandle,PipeId,PolicyType,ValueLength,Value);
  end;
end;

function WinUsb_SetPipePolicy(InterfaceHandle:THandle; PipeId:byte;
        PolicyType:dword;ValueLength:dword; Value:pointer):boolean;
var p:function (InterfaceHandle:THandle; PipeId:byte;
        PolicyType:dword; ValueLength:dword; Value:pointer):boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_SetPipePolicy');
    if @p <> nil
      then Result := p(InterfaceHandle,PolicyType,PipeId,ValueLength,Value);
  end;
end;

function WinUsb_GetOverlappedResult(
    InterfaceHandle : THandle;
    lpOverlapped : POVERLAPPED;
    var lpNumberOfBytesTransferred : dword;
    bWait : BOOL) : boolean;
var p:function (
    InterfaceHandle : THandle;
    lpOverlapped : POVERLAPPED;
    var lpNumberOfBytesTransferred : dword;
    bWait : BOOL) : boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_GetOverlappedResult');
    if @p <> nil
      then Result := p(InterfaceHandle, lpOverlapped,
                       lpNumberOfBytesTransferred, bWait);
  end;
end;

function WinUsb_ControlTransfer(
    InterfaceHandle : THandle;
    SetupPacket : WINUSB_SETUP_PACKET;
    Buffer : Pointer;
    BufferLength:dword;
    var LengthTransferred : dword;
    lpOverlapped:POVERLAPPED): boolean;
var p:function (
    InterfaceHandle : THandle;
    SetupPacket : WINUSB_SETUP_PACKET;
    Buffer : Pointer;
    BufferLength:dword;
    var LengthTransferred : dword;
    Overlapped:POVERLAPPED): boolean; stdcall;
begin
  Result := False;
  if AllocWinUsbDLL then begin
    @p := GetProcAddress(hWinUsbDLL,'WinUsb_ControlTransfer');
    if @p <> nil
      then Result := p(InterfaceHandle, SetupPacket,
                    Buffer, BufferLength, LengthTransferred,
                    lpOverlapped);
  end;
end;


{ TnrWinUsbApi }

procedure TnrWinUsbApi.Close;
begin
  if hWinUsb <> INVALID_HANDLE_VALUE  then WinUsb_Free(hWinUsb);
  if hDevice <> INVALID_HANDLE_VALUE   then CloseHandle(hDevice);
  hWinUsb := INVALID_HANDLE_VALUE;
  hDevice := INVALID_HANDLE_VALUE;
end;

function TnrWinUsbApi.Open(nameSymbolic: string): THandle;
begin
  Result := CreateFile(PChar(nameSymbolic),
      GENERIC_READ + GENERIC_WRITE,
      FILE_SHARE_READ + FILE_SHARE_WRITE,
      nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED, 0);

  if Result <> INVALID_HANDLE_VALUE then begin
    if not WinUsb_Initialize(Result, hWinUsb) then begin
       CloseHandle(Result);
       hWinUsb := INVALID_HANDLE_VALUE;
       Result := INVALID_HANDLE_VALUE;
    end;
  end;
  hDevice := Result;
end;

function TnrWinUsbApi.IsValid: boolean;
begin
  Result := (hWinUsb <> INVALID_HANDLE_VALUE) and (hDevice <> INVALID_HANDLE_VALUE);
end;

function TnrWinUsbApi.Read(idPipe: integer; data: pointer; len: integer;
  ovl: POVERLAPPED): integer;
var sz:dword;
begin
  Result := 0;
  if IsValid then begin
    if ovl <> nil then ZeroMemory(ovl, SizeOf(TOVERLAPPED) - SizeOf(THandle));
    if WinUsb_ReadPipe(hWinUsb, idPipe, data, len, sz, ovl) then begin
      Result := sz;
    end else OutputDebugString('Read Error');
  end;
end;

function TnrWinUsbApi.Write(idPipe: integer; data: pointer; len: integer;
  ovl: POVERLAPPED): integer;
var sz:dword;
begin
  Result := 0;
  if IsValid then begin
    if ovl <> nil then ZeroMemory(ovl, SizeOf(TOVERLAPPED) - SizeOf(THandle) );
    if WinUsb_WritePipe(hWinUsb, idPipe, data, len, sz, ovl) then begin
      Result := sz;
    end else OutputDebugString('Write Error');
  end;
end;

function TnrWinUsbApi.AbortPipe(idPipe: integer): boolean;
begin
  Result := IsValid and WinUsb_AbortPipe(hWinUsb, idPipe);
end;

function TnrWinUsbApi.ResetPipe(idPipe: integer):boolean;
begin
  Result := IsValid and WinUsb_ResetPipe(hWinUsb, idPipe);
end;

function TnrWinUsbApi.FlushPipe(idPipe: integer): boolean;
begin
  Result := IsValid and WinUsb_FlushPipe(hWinUsb, idPipe);
end;

function TnrWinUsbApi.ControlTransfer(request: TnrUsbRequest; var sz: dword; ovl: POVERLAPPED): boolean;
var packet : WINUSB_SETUP_PACKET;
begin
  if IsValid then begin
    packet.RequestType := Byte(request.ReqRecipient)  or
                          (Byte(request.ReqType) shl 5) or
                          (Byte(request.ReqDirection) shl 7);
    packet.Request := request.Request;
    packet.Value := request.Value;
    packet.Index := request.Index;
    packet.Length := request.Length;

    Result := WinUsb_ControlTransfer(hWinUsb, packet, request.Data, request.Length, sz, nil);
    if result
      then result := sz = request.Length;
  end else Result := False;
end;

function TnrWinUsbApi.GetOverlappedResult(ovl: POVERLAPPED;
  var szRead: dword; timeout: dword): boolean;
begin
  Result := WinUsb_GetOverlappedResult(hWinUsb, ovl, szRead, boolean(timeout));
end;

procedure TnrWinUsbApi.PreparePipe(const idPipe:integer; const timeout:integer; const TransferType:TnrUsbTransferType);
begin
  WinUsb_SetPipePolicy(hWinUsb,idPipe, PIPE_TRANSFER_TIMEOUT, 4, @timeout);
end;

initialization

finalization
  if hWinUsbDLL <> 0 then FreeLibrary(hWinUsbDLL);

end.
