{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       TnrUSB class declaration (VCL)                  }
{       Copyright (c) 1997-2010 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 16 MAr 2011                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrusb;
interface
uses nrclasses,nrwin32,windows,nrusbw32,messages,nrddbasew32, classes, nrusbman, nrusb_usb_api;

Type

  TnrUSB = class(TnrBaseIO)
  private
    fDeviceIndex:integer;
    fManager:TnrUsbManager;
    fUsbDevice: TnrUsbDevice;
    fIdVendor:dword;
    fIdProduct:dword;
    fRequestDescriptors:boolean;


    function GetHost(Index: integer): TnrUsbHost;
    function GetHostCount: integer;
    procedure HubLoad(aHub:TnrUsbHub);
    procedure HostsLoad;
    function GetIdProduct: cardinal;
    function GetIdVendor: cardinal;
    procedure SetIdProduct(const Value: cardinal);
    procedure SetIdVendor(const Value: cardinal);
    function GetRequestDescriptors: boolean;
    procedure SetRequestDescriptors(const Value: boolean);
    function CreateAPI: TnrCustomUsbApi;
  protected
    apiUsb : TnrCustomUsbApi;
    procedure DeviceListClear; override;
    function IsHandleValid: boolean; override;
    procedure Open;  override;
    procedure Close; override;
    function RequestDeviceHandle:THandle; override;
    procedure RequestDeviceHandleClose(aHandle: THandle); override;
    function GetAllInfo:boolean;
    procedure DeviceListLoad; override;
    function CheckSelectedDevice:boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    procedure Update; override;
    function GetDeviceIndex: integer; override;
    procedure SetDeviceIndex(const Value: integer);  override;
    function DeviceIndexOf(VendorId, ProductId : dword):integer;
    procedure WriteChar(Pipe:TnrUsbPipe; const Ch:Char);  //overload;  //override;
    function ReadChar(Pipe:TnrUsbPipe):char;  //overload;  //override;
    procedure ResetPipe(Pipe:TnrUsbPipe);
    procedure AbortPipe(Pipe:TnrUsbPipe);
    procedure Eject;
    procedure Reset;
    procedure Remove;
    procedure Enable;
    procedure Disable;
    procedure Restart;
    function ControlRequest(request:TnrUsbRequest):boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property HostCount:integer read GetHostCount;
    property Hosts[Index:integer]:TnrUsbHost read GetHost;
    property UsbDevice:TnrUsbDevice read fUsbDevice write fUsbDevice;
    property Handle;
    property Api:TnrCustomUsbApi read apiUsb;
  published
    property RequestDescriptors:boolean read GetRequestDescriptors write SetRequestDescriptors;
    property DeviceIndex;
    property Active;
    property Log;
    property OnFatalError;
    property IdVendor:cardinal read GetIdVendor write SetIdVendor;
    property IdProduct:cardinal read GetIdProduct write SetIdProduct;
  end;

Const
   strUSBSpeeds :array [TnrUSBSpeed] of string = ('Low', 'Full', 'High');
   strUSBTransferType:array [TnrUsbTransferType] of string = ('Unknown',
       'Control', 'Isochronous', 'Bulk', 'Interrupt');

implementation
uses sysutils,
     shellapi,
{$IFDEF TRIAL}
     dialogs,
{$ENDIF}
     nrwin32di
{$IFDEF NRPRO}
     ,nrusb_winusb_api,
     nrusb_sysusb_api
{$ENDIF}
;


//  pcUSB:PChar='\\.\HCDx'#0;
  {$IFDEF TRIAL}
Const
  MsgText:{$IFNDEF LINUX}PCHar{$ELSE}WideString{$ENDIF}=
    'nrComm Lib '+ nrCommLibVersion + ' Copyright(C) 1997-2011 DeepSoftware' +
    Eoln + Eoln+'You are using the trial version ! Please register !!!' +
    Eoln + 'e-mail:noro@deepsoftware.com'+Eoln+'http://www.deepsoftware.com/' +
    Eoln + 'Do you want to register the nrComm Lib and get the full release now ?';
  {$ENDIF}

function GetCorrectSymbolicName(aStr:string):string;
begin
  if Pos('\??',aStr) = 1
    then Result := '\\.' + Copy(aStr,4,Length(aStr))
    else Result := aStr;
end;

{$IFDEF TRIAL}
function eax:string; forward;
{$ENDIF}


{$IFDEF TRIAL}
Const
  MsgCapt:{$IFNDEF LINUX}PCHar{$ELSE}WideString{$ENDIF}=
    'nrComm Lib '+nrCommLibVersion;
{$ENDIF}

{ TnrUSB }

constructor TnrUSB.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fManager := GetUsbManager;
  fDeviceIndex := -1;
  flClearDeviceListWithFree := False;
//  fOptions := [uoShowHost, uoShowHub, uoShowPort];
  {$IFDEF TRIAL}
  if //(csDesigning in ComponentState) and
     (MessageBox(0,MsgText,MsgCapt,MB_YESNO) <> IDNO)
     then  ShellExecute(0,'open','http://www.deepsoftware.com/nrcomm/buy.html',nil,nil,SW_SHOWDEFAULT);
  {$ENDIF}
//  fPipePair := TnrUSBPipePair.Create(Self);
end;

destructor TnrUSB.Destroy;
begin
  if apiUsb <> nil then apiUsb.Free;
  apiUsb := nil;
  inherited Destroy;
end;

function TnrUSB.GetHost(Index: integer): TnrUsbHost;
begin
  if(Index >= 0) and ( Index < fManager.HostCount)
    then Result := fManager.Hosts[Index]
    else Result := nil;
end;

{$IFDEF TRIAL}
var ecx : integer = $1dce12a1;
{$ENDIF}

function TnrUSB.GetHostCount: integer;
begin
  Result := fManager.HostCount;
end;

procedure TnrUSB.Update;
var indexSave:integer;
begin
  indexSave := DeviceIndex;
  DeviceListLoad;
  DeviceIndex := indexSave;
  inherited Update;
end;

procedure TnrUSB.HubLoad(aHub:TnrUsbHub);
var i,j:integer;
//    dev:TnrUsbDevice;
begin
  for i := 0 to aHub.PortCount-1 do begin
    for j := 0 to aHub.Ports[i].DeviceCount - 1 do begin
      if aHub.Ports[i].Devices[j] is TnrUsbHub
        then HubLoad(TnrUsbHub(aHub.Ports[i].Devices[j]))
        else begin
          if (IdProduct <> 0) and (IdProduct <> aHub.Ports[i].Devices[j].ProductID)
            then continue;
          if (IdVendor <> 0) and (IdVendor <> aHub.Ports[i].Devices[j].VendorID)
            then continue;
          //dev := TnrUsbDevice.Create;
          //dev.Assign(aHub.Ports[i].Devices[j]);
          //AddDevice(dev);
          AddDevice(aHub.Ports[i].Devices[j]);
          Logging(dlDebug, 'Add device into list: ' + aHub.Ports[i].Devices[j].NameFriendly + '|' + aHub.Ports[i].Devices[j].InstanceId);
          //Logging(dlDebug, 'Add device into list: ' + aHub.Ports[i].Devices[j].NameFriendly + '|' + aHub.Ports[i].Devices[j].InstanceId);
        end;
    end;
  end;
end;

procedure TnrUSB.HostsLoad;
var i,j:integer;
begin
  DeviceListClear;
  for i := 0 to HostCount - 1 do
    for j := 0 to Hosts[i].HubCount - 1
      do HubLoad(Hosts[i].Hubs[j]);
end;

procedure TnrUSB.DeviceListLoad;
begin
  Logging(dlDebug, 'Load device list ...');
  {$IFDEF TRIAL}
  Inc(ecx);
  {$ENDIF}
  fManager.RequestDescriptors := fRequestDescriptors;
  fManager.Log := Log;
  fManager.Update;   // force enum global device list
  HostsLoad;         // reload local class device list
end;

procedure TnrUSB.SetDeviceIndex(const Value: integer);
begin
  fUsbDevice := nil;
  if (Value >= 0) and (Value < DeviceCount) then begin
    fDeviceIndex := Value;
    if Device[Value] is TnrUsbDevice
      then fUsbDevice := TnrUsbDevice(Device[Value]);
    inherited SetDeviceIndex(Value);
  end;
end;

function TnrUSB.GetDeviceIndex: integer;
begin
  Result := fDeviceIndex;
end;

function TnrUSB.DeviceIndexOf(VendorId, ProductId: dword): integer;
var i:integer;
begin
  Result := -1;
  for i := 0 to DeviceCount - 1 do
    if Device[i] is TnrUsbDevice then
      if (TnrUsbDevice(Device[i]).VendorID = VendorId) and
         (TnrUsbDevice(Device[i]).ProductID = ProductId) then begin
           Result := i;
           break;
         end;
end;

function TnrUSB.CheckSelectedDevice: boolean;
var sError : string;
begin
  Result := False;
  sError := '';
  if fUsbDevice = nil then sError := 'Device is not selected';
  if sError <> ''
    then DoFatalErrors(ECC_NRUSB, 1, sError, False)
    else Result := True;
end;

function TnrUSB.IsHandleValid: boolean;
begin
  Result := (apiUsb <> nil) and apiUsb.IsValid;
end;

function TnrUSB.CreateAPI: TnrCustomUsbApi;
begin
  {$IFDEF NRPRO}
  if Lowercase(fUsbDevice.Service) =  'winusb'
   then Result := TnrWinUsbApi.Create
   else
     if Lowercase(fUsbDevice.Service) =  'nrusb'
       then Result := TnrSysUsbApi.Create
       else Result := nil;
  {$ELSE}
  Result := nil;
  {$ENDIF}
end;

function TnrUSB.RequestDeviceHandle: THandle;
var s:string;
begin
  s := GetCorrectSymbolicName(fUsbDevice.NameSymbolic);
  apiUsb := CreateAPI;
  if apiUsb <> nil
    then Result := apiUsb.Open(s)
    else Result := inherited RequestDeviceHandle;
end;

procedure TnrUSB.RequestDeviceHandleClose(aHandle: THandle);
begin
  if apiUsb <> nil then apiUsb.Close;
end;

procedure TnrUSB.Open;
var sErr:string;
begin
  if IsHandleValid then Close;

  if not CheckSelectedDevice then exit;

  {$IFDEF TRIAL}
  if (ecx and 3) = 0 then ShowMessage(eax);
  {$ENDIF}

  inherited Open;

  if not IsHandleValid then begin
    if (Lowercase(fUsbDevice.Service) <>  'winusb') and (Lowercase(fUsbDevice.Service) <>  'nrusb')
      then sErr := ' Driver is unknown. You need install NrUsb or WinUsb driver on target device.'
      else sErr := '';
    DoFatalErrors(ECC_NRUSB,GetLastError,'USB device open fails.' + sErr, False);
    exit;
  end;

end;

procedure TnrUSB.Close;
begin
  inherited Close;
  if apiUsb <> nil then begin
    try
      apiUsb.Free;
    finally
      apiUsb := nil;
    end;
  end;
end;

function TnrUSB.GetAllInfo: boolean;
begin
  Result:=False;
end;

procedure TnrUSB.DeviceListClear;
begin
  inherited DeviceListClear;
end;

procedure TnrUSB.WriteChar(Pipe: TnrUsbPipe; const Ch: Char);
begin
  if apiUsb <> nil 
    then apiUsb.Write(Pipe.ID, @Ch, 1, nil);
end;

function TnrUSB.ReadChar(Pipe: TnrUsbPipe): char;
var //sz:dword;
    ch:char;
begin
  Ch := 'A'; // allocate space for input buffer :-)
  if apiUsb <> nil 
    then apiUsb.Read(Pipe.ID, @Ch, 1, nil);
  Result := ch;
end;

procedure TnrUSB.ResetPipe(Pipe: TnrUsbPipe);
begin
  if (apiUsb = nil) or (not apiUsb.ResetPipe(Pipe.ID)) then Logging(dlDetail, 'ResetPipe fails');
end;

procedure TnrUSB.AbortPipe(Pipe: TnrUsbPipe);
begin
  if (apiUsb = nil) or (not apiUsb.AbortPipe(Pipe.ID)) then Logging(dlDetail, 'AbortPipe fails');
end;

{$IFDEF TRIAL}
function eax:string;
Const
  //You are using nrComm Lib trial version!
  //Please register! xor u
  esi:PAnsiChar=
#$2C#$1A#$00#$55#$14#$07#$10#$55#$00#$06#$1C#$1B#$12#$55#$01#$07 +
#$1C#$14#$19#$55#$1B#$07#$36#$1A#$18#$18#$39#$1C#$17#$55#$03#$10 +
#$07#$06#$1C#$1A#$1B#$54#$78#$7F#$25#$19#$10#$14#$06#$10#$55#$07 +
#$10#$12#$1C#$06#$01#$10#$07#$54;

var i:integer;
begin
  Result := '';
  for i := 0 to 55{Length(esi)-1} do Result := Result + Char(Byte(esi[i]) xor Byte('u'));
  Result := Result + #0;
end;

{$ENDIF}

function TnrUSB.GetIdProduct: cardinal;
begin
  Result := fIdProduct;
end;

function TnrUSB.GetIdVendor: cardinal;
begin
  Result := fIdVendor;
end;

procedure TnrUSB.SetIdProduct(const Value: cardinal);
begin
  if fIdProduct <> Value then begin
    fIdProduct := Value;
    HostsLoad;
  end;
end;

procedure TnrUSB.SetIdVendor(const Value: cardinal);
begin
  if  fIdVendor <> Value then begin
    fIdVendor := Value;
    HostsLoad;
  end;
end;

function TnrUSB.GetRequestDescriptors: boolean;
begin
  Result := fRequestDescriptors;
end;

procedure TnrUSB.SetRequestDescriptors(const Value: boolean);
begin
  fRequestDescriptors := Value;
end;

procedure TnrUSB.Eject;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Eject USB device:' + fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiEjectDevice(fUsbDevice.DevInst);
end;

procedure TnrUSB.Reset;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Reset USB device:'  + fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiResetDevice(fUsbDevice.InstanceId);
end;

procedure TnrUSB.Remove;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Remove USB device:'  + fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiRemoveDevice(fUsbDevice.InstanceId);
end;

procedure TnrUSB.Enable;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Enable USB device:'  + fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiEnableDevice(fUsbDevice.InstanceId);
end;

procedure TnrUSB.Disable;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Disable USB device: '  + fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiDisableDevice(fUsbDevice.InstanceId);
end;

procedure TnrUSB.Restart;
begin
  if not CheckSelectedDevice then exit;
  Logging(dlDetail, 'Restart USB device:' +  fUsbDevice.NameFriendly + ' | ' + fUsbDevice.InstanceId);
  DiRestartDevice(fUsbDevice.InstanceId);
end;

procedure TnrUSB.Notification(AComponent: TComponent; Operation: TOperation); 
begin
  if Operation = opRemove then begin
    if Assigned(fManager) and (AComponent = Log) then fManager.Log := nil;
  end;
  inherited Notification(AComponent, Operation);
end;

function TnrUSB.ControlRequest(request: TnrUsbRequest): boolean;
{$IFDEF NRPRO}
var sz:dword;
begin
  result := False;
  if IsHandleValid then begin
    Result := apiUsb.ControlTransfer(request, sz, nil);
//    result := WinUsb_ControlTransfer(fUsbHandle, packet, request.Data, request.Length, sz, nil);
    if result
      then result := sz = request.Length;
  end;
{$ELSE}
begin
  raise Exception.Create('Method is not implemented.');
{$ENDIF}
end;


end.
