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

Type

  TnrUsbDevice = class;
  TnrUsbPort   = class;
  TnrUsbHub    = class;
  TnrUsbHost   = class;
  TnrUSBManager = class;

  TnrUsbPipe = class(TnrDevice)
  private
    fEnabled: boolean;
    fStatus: string;
//    fIndex:integer;
    PipeInfo:PUSB_PIPE_INFO;
    fDevice:TnrUsbDevice;
    function GetMaxPacketSize: cardinal;
    function GetTransferType: TnrUsbTransferType;
    function GetDirectIn: boolean;
    function GetDirectOut: boolean;
    function GetPipeID:byte;
  protected
  public
    constructor Create(aOwner:TnrUsbDevice);
    destructor Destroy; override;
    property Enabled:boolean read fEnabled;
    property Status:string read fStatus;
    property MaxPacketSize:cardinal read GetMaxPacketSize;
    property TransferType:TnrUsbTransferType read GetTransferType;
    property DirectionOut:boolean read GetDirectOut;
    property DirectionIn:boolean read GetDirectIn;
    property ID:byte read GetPipeID;
//    property PipeIndex:integer read fIndex;
  end;

  TnrUsbDevice = class(TnrDevice)
  private
    List:TList;
    slDescriptors:TStringList;
    fPort:TnrUsbPort;
    configDesc:PUSB_CONFIGURATION_DESCRIPTOR;
    fProductID: word;
    fVendorID: word;
    fMaxPacketSize: word;
    fSpeed: TnrUSBSpeed;
    fVerLo: byte;
    fVerHi: byte;
    fDriverLetters: string;
    function GetPipe(Index: integer): TnrUsbPipe;
    function GetPipeCount: integer;
    function GetMaxPower: cardinal;
    function GetIsSelfPower: boolean;
    function GetIsWakeUp: boolean;
    function GetIsBusPower: boolean;
    function GetDescriptors: TStrings;
  protected
    procedure Update;
    procedure UpdateStorageInfo;
    function Add:integer;
    procedure Clear;
    function GetDescriptorString(hUsb:dword; i:integer) : string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure UpdateDescriptors;
    property Pipes[Index:integer]:TnrUsbPipe read GetPipe;
    property PipeCount:integer read GetPipeCount;
    property Port:TnrUsbPort read fPort;
    property MaxPower:cardinal read GetMaxPower;
    property IsWakeUp:boolean read GetIsWakeUp;
    property IsSelfPower:boolean read GetIsSelfPower;
    property IsBusPower:boolean read GetIsBusPower;
    property VendorID:word read fVendorID;
    property ProductID:word read fProductID;
    property MaxPacketSize:word read fMaxPacketSize;
    property Speed:TnrUSBSpeed read fSpeed;
    property VerHi:byte read fVerHi;
    property VerLo:byte read fVerLo;
    property Descriptors:TStrings read GetDescriptors;
    property DriverLetters:string read fDriverLetters;
  end;

  TnrUsbPort = class(TnrDevice)
  private
    List:TList;
    fHub:TnrUsbHub;
    fPortIndex: integer;
    ConnectInfo:PUSB_NODE_CONNECTION_INFORMATION;
    fHandle : THandle;
    function GetDevice(Index: integer): TnrUsbDevice;
    function GetCount: integer;
  protected
    procedure Clear;
    procedure EnumDevices(hHub:THandle);
  public
    constructor Create;
    destructor Destroy; override;
    property DeviceCount:integer read GetCount;
    property Devices[Index:integer]:TnrUsbDevice read GetDevice;
    property PortIndex:integer read fPortIndex;
    property Hub:TnrUsbHub read fHub;
  end;

  TnrUsbHub = class(TnrUsbDevice)
  private
    List:TList;
    fHost:TnrUsbHost;
    fPort:TnrUsbPort;
    HubInfo:USB_NODE_INFORMATION;
    fHandle : THandle;
    function GetPort(Index: integer): TnrUsbPort;
    function GetCount: integer;
    function GetMaxPower: cardinal;
    function GetIsSelfPower: boolean;
  protected
    procedure Clear;
    function Add:integer;
    procedure Update(hHub:THandle);
  public
    constructor Create;
    destructor Destroy; override;
    property PortCount:integer read GetCount;
    property Ports[Index:integer]:TnrUsbPort read GetPort;
    property Host:TnrUsbHost read fHost;
    property Port:TnrUsbPort read fPort;
    property MaxPower:cardinal read GetMaxPower;
    property IsSelfPower:boolean read GetIsSelfPower;
  end;

  TnrUsbHost = class(TnrDevice)
  private
    List:TList;
    fHandle: THandle;
    function GetHub(Index: integer): TnrUsbHub;
    function GetCount: integer;
  protected
    fManager:TnrUSBManager;
    procedure Clear;
    function AddHubWithName(HubName:string;ParentPort:TnrUsbPort):TnrUsbHub;
    procedure ReloadHubs(hHost:THandle);
  public
    constructor Create(aOwner:TnrUSBManager);
    destructor Destroy; override;
    property HubCount:integer read GetCount;
    property Hubs[Index:integer]:TnrUsbHub read GetHub;
  end;

  TnrUSBManager = class
  private
    fRequestDescriptors:boolean;
    List:TList;
    function GetHost(Index: integer): TnrUsbHost;
    function GetCount: integer;
    function GetDriverInfo(s:string):TnrDevice;
    function GetVolumeInfo(s:string):string;
    procedure Logging(Mess: string);
  protected
    slClassDevices:TStringList;
    slDisks : TStringList;
    function OpenHostController(No:integer):THandle;
    function AddHost:integer;
    procedure EnumDisks;
    //procedure EnumUSBClassDevices;
    procedure ReloadHosts;
    procedure Clear;
  public
    Log:TnrCustomLogFile;
    constructor Create;
    destructor Destroy;override;
    procedure Update;
    property HostCount:integer read GetCount;
    property Hosts[Index:integer]:TnrUsbHost read GetHost;
    property RequestDescriptors:boolean read fRequestDescriptors write fRequestDescriptors;
  end;

  function GetUsbManager:TnrUSBManager;

Var
  csUsbReloadLock:TRTLCriticalSection;

implementation
uses sysutils, shellapi, nrsysutils, nrwin32di;

Const
   pipeTypeCaption : array [TnrUsbTransferType] of string = ('Unknown', 'Control',
                           'Isochronous', 'Bulk', 'Interrupt');
Var
  vGlobalUsbManager: TnrUSBManager = nil;

function GetUsbManager:TnrUSBManager;
begin
  if vGlobalUsbManager = nil then begin
    vGlobalUsbManager := TnrUSBManager.Create;
    InitializeCriticalSection(csUsbReloadLock);
  end;

  Result := vGlobalUsbManager;
end;

{ TnrUSBManager }


constructor TnrUSBManager.Create();
begin
  inherited Create;
  List := TList.Create;
  slClassDevices := TStringList.Create;
  slDisks := TStringList.Create;
end;

destructor TnrUSBManager.Destroy;
begin
  Clear;
  slDisks.Free;
  slClassDevices.Free;
  List.Free;
  inherited Destroy;
end;

procedure TnrUSBManager.Logging(Mess: string);
begin
  if Assigned(Log) then Log.AddLog(dlSimple, Mess);
end;

function TnrUSBManager.OpenHostController(No: integer): THandle;
begin
  Result := CreateFile(PChar('\\.\HCD'+Char(No+$30)),
          GENERIC_WRITE+GENERIC_READ, FILE_SHARE_WRITE+FILE_SHARE_READ,
          nil, OPEN_EXISTING, 0,0);
end;

procedure TnrUSBManager.Update;
begin
  ReloadHosts;
end;

function TnrUSBManager.GetHost(Index: integer): TnrUsbHost;
begin
  if (Index >= 0) and (Index < List.Count)
    then Result := TnrUsbHost(List[Index])
    else Result := nil;
end;

function TnrUSBManager.AddHost: integer;
begin
  Result := List.Add(TnrUsbHost.Create(Self));
end;

function TnrUSBManager.GetCount: integer;
begin
  Result := List.Count;
end;

procedure TnrUSBManager.ReloadHosts;
var Hndl:THandle;
    i,j:integer;
begin
  Clear;
  try

    EnterCriticalSection(csUsbReloadLock);

    EnumDisks;
    DiEnumInstalledDevices(@GUID_DEVCLASS_USB, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_HIDCLASS, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_BLUETOOTH, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_INFRARED, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_MULTIPORTSERIAL, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_MULTIFUNCTION, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_PORTS, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_MODEM, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_MEDIA, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_BATTERY, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_BIOMETRIC, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_GPS, True, True, false, slClassDevices);
    DiEnumInstalledDevices(@GUID_DEVCLASS_NODRIVER, True, True, false, slClassDevices);

    for i:=0 to MAX_CountUsbPorts - 1 do begin
      Hndl := OpenHostController(i);
      if Hndl <> INVALID_HANDLE_VALUE then begin
        j := AddHost;
        Hosts[j].NameSymbolic := '\\.\HCD' + Char(i+$30);
        Hosts[j].RegKey := GetKeyName(Hndl,IOCTL_GET_HCD_DRIVERKEY_NAME);
        Hosts[j].Description := GetDescription(Hosts[j].RegKey);
        Hosts[j].NameFriendly := Hosts[j].Description;
        Hosts[j].ReloadHubs(Hndl);
        CloseHandle(Hndl);
      end;
    end;

  finally
    LeaveCriticalSection(csUsbReloadLock);
  end;
end;

procedure TnrUSBManager.Clear;
var i:integer;
begin
  for i := 0 to HostCount - 1 do Hosts[i].Free;
  List.Clear;
  for i := 0 to slClassDevices.Count - 1 do slClassDevices.Objects[i].Free;
  slClassDevices.Clear;
  slDisks.Clear;
end;

function TnrUSBManager.GetDriverInfo(s: string): TnrDevice;
var i:integer;
begin
  Result := nil;
  i := slClassDevices.IndexOf(s);
  if i >= 0 then Result := TnrDevice(slClassDevices.Objects[i]);
end;

procedure TnrUSBManager.EnumDisks;
var chDisk,sDd,s:string;
    i, j, len:integer;
    p:PWideChar;
    id:dword;
begin
  slDisks.Text := Trim(DiGetVolumes(False, True, True, True, True, #13#10));
  //OutputDebugString(PChar('EnumDisks GetDiVolums: ' +slDisks.Text));
  Logging('EnumDisks GetDiVolums: ' + slDisks.Text);
  for i := 0 to slDisks.Count - 1 do begin
    chDisk := slDisks[i];
    sDd :=  RegReadString(HKEY_LOCAL_MACHINE,
            'SYSTEM\MountedDevices', '\DosDevices\' + chDisk + ':');
    if sDd = '' then continue;

    if Length(sDd) = 12 then begin
      p := @sDd[1];
      id := DWord(PDword(p)^);
      s := '';
      for j := 12 downto 5 do begin
        if (sDd[j] = #0 ) and (s = '' ) then continue;
        s := s + IntToHex(Byte(sDd[j]), 2);
      end;

      // trim leading zeros ...
      j := 1;
      len := Length(s);
      while (j <= len) and (s[j] = '0') do Inc(j);

      s := 'Signature' + Format('%X',[id]) + 'Offset' + Copy(s, j , len);

    end else begin
      p := @sDd[1];
      s := String(WideString(p));
      s := ReplaceStrangeChars(s);
    end;
    slDisks[i] := Lowercase(s);
    slDisks.Objects[i] := TObject(chDisk[1]);
    //slDisks.AddObject(Lowercase(s),TObject(chDisk[1]));
    //OutputDebugString(PChar('EnumDisks (' + chDisk[1] + ':) ' + Lowercase(s)));
    //Logging('EnumDisks (' + chDisk[1] + ':) ' + Lowercase(s));
  end;
end;

function TnrUSBManager.GetVolumeInfo(s: string): string;
var i,j:integer;
    s2:string;
begin
  Result := '';
  //OutputDebugString(PChar('GetVolumeInfo for ' + s + ' ...') );
  //Logging('GetVolumeInfo for ' + s + ' ...');

  s := ReplaceStrangeChars(Lowercase(s));
  for i := 0 to slDisks.Count - 1 do begin
    if ((Pos(s, slDisks[i]) > 0) or (Pos(slDisks[i], s) > 0)) and (Length(slDisks[i]) > 3) then begin
      Result := Char(slDisks.Objects[i]);
      //OutputDebugString(PChar(slDisks[i] + ' ' + Result + ' ok') );
      //Logging(slDisks[i] + ' ' + Result + ' ok');
      break;
    end;
  end;

  // second attempt ...
  if Length(Result) = 0 then
    for i := slDisks.Count - 1 downto 0 do begin
      j := Pos('offset', slDisks[i]);
      if j > 0 then begin
        s2 := Copy(slDisks[i], j + 6, Length(slDisks[i]));
        j := Pos(s2, s);
        if (j > 0) and  ((j + Length(s2) - 1) = Length(s))  then begin
          Result := Char(slDisks.Objects[i]);
          //OutputDebugString(PChar(slDisks[i] + ' ' + Result + ' ok2') );
          //Logging(slDisks[i] + ' ' + Result + ' ok2');
          break;
        end;
      end;
    end;

end;

{ TnrUsbPort }

constructor TnrUsbPort.Create;
begin
  inherited;
  List := TList.Create;
  fHandle := INVALID_HANDLE_VALUE;
  ConnectInfo := Pointer(LocalAlloc(LPTR,SizeOf(USB_NODE_CONNECTION_INFORMATION)));
end;

destructor TnrUsbPort.Destroy;
begin
  Clear;
  LocalFree(THandle(ConnectInfo));
  List.Free;
  inherited;
end;

function TnrUsbPort.GetCount: integer;
begin
  Result := List.Count;
end;

function TnrUsbPort.GetDevice(Index: integer): TnrUsbDevice;
begin
  if (Index >= 0) and ( Index < List.Count)
    then Result := TnrUsbDevice( List[Index] )
    else Result := nil;
end;

procedure TnrUsbPort.Clear;
var i:integer;
begin
  for i := 0 to DeviceCount - 1 do
    if (Devices[i] <> nil) and not (Devices[i] is TnrUsbHub)
      then Devices[i].Free;
  List.Clear;
end;

procedure TnrUsbPort.EnumDevices(hHub:THandle);
var rOK:boolean;
    ctl,nBytes:dword;
    i:integer;
    sKey, sdesc:string;
    dev:TnrUsbDevice;
begin
  Clear;
//  dev := nil;
  nBytes := SizeOf(USB_NODE_CONNECTION_INFORMATION);
  ConnectInfo^.ConnectionIndex := PortIndex;
  // try extended request ...
  rOK := DeviceIoControl(hHub,
       IOCTL_USB_GET_NODE_CONNECTION_INFORMATION_EX,
       ConnectInfo,nBytes,ConnectInfo,nBytes,nBytes,nil);

  if not rOK then begin// it fails. try ordinary request ...
    nBytes:=SizeOf(USB_NODE_CONNECTION_INFORMATION);
    rOK := DeviceIoControl(hHub,
       IOCTL_USB_GET_NODE_CONNECTION_INFORMATION,
       ConnectInfo,nBytes,ConnectInfo,nBytes,nBytes,nil);
    if (rOK) and (ConnectInfo^.DeviceDescriptor.bcdUSB < $200)
      then ConnectInfo^.Speed := ConnectInfo^.Speed xor 1;
  end;

  if rOK then begin
    Description := 'Port #' + Char(PortIndex+$30) + ' ';
    if ConnectInfo^.ConnectionStatus<>NoDeviceConnected then begin

      if ConnectInfo^.DeviceIsHub
        then ctl := IOCTL_USB_GET_NODE_CONNECTION_NAME
        else ctl := IOCTL_USB_GET_NODE_CONNECTION_DRIVERKEY_NAME;

      sKey := GetConnectionKeyName(hHub, ctl, PortIndex);
      RegKey := sKey;
      NameSymbolic := fHub.NameSymbolic + '\' + sKey;

      if ConnectInfo^.DeviceIsHub then begin
        Description := Description + '(hub: ';
        dev := fHub.fHost.AddHubWithName(sKey, Self);
        sKey := GetConnectionKeyName(hHub,IOCTL_USB_GET_NODE_CONNECTION_DRIVERKEY_NAME, PortIndex);
      end else begin
        Description := Description + '(device: ';
        dev := TnrUsbDevice.Create;
        dev.fParent := fParent;
        dev.fPort := Self;
        dev.Update;
      end;

      if (sKey <> '') and (dev <> nil)
        then sdesc := GetDescription(sKey)
        else begin
          sdesc := '';
          if fHub.fHost.fManager.fRequestDescriptors and
             (not ConnectInfo^.DeviceIsHub)
            then begin
              dev.UpdateDescriptors;
              i := 0;
              while i < dev.Descriptors.Count do begin
                sdesc := sdesc + dev.Descriptors[i] + ' ';
                inc(i);
              end;
              sdesc := Trim( sdesc );
            end;

          if sdesc = '' then sdesc := 'unknown device';

        end;

      if dev <> nil then begin
        dev.Description := sdesc;
        dev.NameFriendly := dev.Description;
        List.Add(dev);
      end;

      Description := Description + ' ' + sdesc  + ')';

    end else Description := Description + '(free)';

  end else Description := 'Error';
end;

{ TnrUsbHub }

constructor TnrUsbHub.Create;
begin
  inherited;
  List:=TList.Create;
  fHandle := INVALID_HANDLE_VALUE;
end;

destructor TnrUsbHub.Destroy;
begin
  Clear;
  List.Free;
  inherited;
end;

function TnrUsbHub.GetCount: integer;
begin
  Result:=List.Count;
end;

function TnrUsbHub.GetPort(Index: integer): TnrUsbPort;
begin
  if(Index>=0)and(Index<List.Count)
    then Result:=TnrUsbPort(List[Index])
    else Result:=nil;
end;

function TnrUsbHub.Add: integer;
begin
  Result := List.Add(TnrUsbPort.Create);
  TnrUsbPort(List[Result]).fParent := fParent; 
end;

procedure TnrUsbHub.Clear;
var i:integer;
begin
  for i:=0 to PortCount-1 do Ports[i].Free;
  List.Clear;
end;

procedure TnrUsbHub.Update(hHub: THandle);
var i,j:integer;
    nBytes:dword;
    rOK:boolean;
begin
  Clear;
  rOK:=DeviceIoControl(hHub,
       IOCTL_USB_GET_NODE_INFORMATION,
       @HubInfo,sizeof(USB_NODE_INFORMATION),
       @HubInfo,sizeof(USB_NODE_INFORMATION),
       nBytes,nil);
  if rOK then
  for i:=1 to HubInfo.HubInformation.HubDescriptor.bNumberOfPorts
  do begin
    j:=Add;
    Ports[j].Description := 'Port['+IntToStr(i)+']';
    Ports[j].NameFriendly :=Ports[j].Description;
    Ports[j].fPortIndex:=i;
    Ports[j].fHub:=Self;
    Ports[j].EnumDevices(hHub);
  end;
end;

function TnrUsbHub.GetMaxPower: cardinal;
begin
  Result:=HubInfo.HubInformation.HubDescriptor.bHubControlCurrent;
end;

function TnrUsbHub.GetIsSelfPower: boolean;
begin
  Result:=HubInfo.HubInformation.HubIsBusPowered;
end;

{ TnrUsbHost }

constructor TnrUsbHost.Create(aOwner:TnrUSBManager);
begin
  inherited Create;
  fHandle := INVALID_HANDLE_VALUE;
  List:=TList.Create;
  fManager := aOwner;
end;

destructor TnrUsbHost.Destroy;
begin
  Clear;
  List.Free;
  inherited;
end;

function TnrUsbHost.GetCount: integer;
begin
  Result:=List.Count;
end;

function TnrUsbHost.GetHub(Index: integer): TnrUsbHub;
begin
  if(Index>=0)and(Index<List.Count)
    then Result:=TnrUsbHub(List[Index])
    else Result:=nil;
end;

procedure TnrUsbHost.Clear;
var i:integer;
begin
  for i := 0 to HubCount - 1 do Hubs[i].Free;
  List.Clear;
end;

procedure TnrUsbHost.ReloadHubs(hHost:THandle);
var sRootHub:string;
    hub:TnrUsbHub;
begin
  Clear;
  sRootHub := GetKeyName(hHost,IOCTL_USB_GET_ROOT_HUB_NAME);
  hub := AddHubWithName(sRootHub,nil);
  if hub <> nil then begin
    hub.Description := 'Root Hub';
    List.Add(hub);
  end;
end;

function TnrUsbHost.AddHubWithName(HubName:string; ParentPort:TnrUsbPort):TnrUsbHub;
var hHub:THandle;
begin  // Try to hub the open device
  Result := nil;
  hHub := CreateFile(PChar('\\.\'+HubName), GENERIC_WRITE,FILE_SHARE_WRITE,
                                nil,OPEN_EXISTING,0,0);

  if hHub <> INVALID_HANDLE_VALUE then begin
    Result := TnrUsbHub.Create;
    Result.fParent := fParent;
    Result.NameSymbolic := '\\.\' + HubName;
    Result.fHost := Self;
    Result.fPort := ParentPort;
    Result.NameFriendly := 'USB Hub:' + HubName;
    Result.Update(hHub);
    CloseHandle(hHub);
  end;
end;

{ TnrUsbDevice }

function TnrUsbDevice.Add: integer;
begin
  Result := List.Add(TnrUsbPipe.Create(Self));
end;

procedure TnrUsbDevice.Clear;
var i:integer;
begin
  if configDesc <> nil then LocalFree(Cardinal(configDesc));
  configDesc := nil;
  for i:=0 to List.Count-1 do Pipes[i].Free;
  List.Clear;
  slDescriptors.Clear;
end;

constructor TnrUsbDevice.Create;
begin
  inherited;
  List := TList.Create;
  slDescriptors := TStringList.Create;
end;

destructor TnrUsbDevice.Destroy;
begin
  Clear;
  List.Free;
  slDescriptors.Free;
  inherited;
end;

procedure TnrUsbDevice.Update;
var i, j : integer;
    hF : THandle;
    dev:TnrDevice;
begin
  Clear;
  for i := 0 to Integer(fPort.ConnectInfo^.NumberOfOpenPipes) - 1 do begin
    j := Add;
    Pipes[j].NameSymbolic := fPort.NameSymbolic + Format('\PIPE%.2u',[i]);
    Pipes[j].fIndex := i;
    Pipes[j].PipeInfo := @fPort.ConnectInfo^.PipeList[i];
    Pipes[j].NameFriendly := 'Pipe ['+IntToStr(j+1)+'] ' + pipeTypeCaption[Pipes[j].TransferType] + ' ' + IntToStr(Pipes[j].MaxPacketSize);
    if (Pipes[j].DirectionOut and Pipes[j].DirectionIn)
      then Pipes[j].Description :=  Pipes[j].NameFriendly  + ' IN/OUT'
    else begin
      if Pipes[j].DirectionOut then Pipes[j].Description :=  Pipes[j].NameFriendly  + ' OUT';
      if Pipes[j].DirectionIn then Pipes[j].Description :=  Pipes[j].NameFriendly  + ' IN';
    end;
  end;

  fVerLo := fPort.ConnectInfo^.DeviceDescriptor.bcdUSB and $F;
  fVerHi := fPort.ConnectInfo^.DeviceDescriptor.bcdUSB shr 8;

  fSpeed := TnrUSBSpeed(fPort.ConnectInfo^.Speed);

  fProductID:=fPort.ConnectInfo^.DeviceDescriptor.idProduct;
  fVendorID:=fPort.ConnectInfo^.DeviceDescriptor.idVendor;
  fMaxPacketSize:=fPort.ConnectInfo^.DeviceDescriptor.bMaxPacketSize0;

  hF := CreateFile(PChar(Port.fHub.NameSymbolic),
                 GENERIC_WRITE+GENERIC_READ,0,nil,OPEN_EXISTING,0,0);
  if hF <> INVALID_HANDLE_VALUE then begin
    configDesc := PUSB_CONFIGURATION_DESCRIPTOR(GetDescriptor(hF, Port.PortIndex, USB_CONFIGURATION_DESCRIPTOR_TYPE, 0));
  end;

  dev  := fPort.fHub.fHost.fManager.GetDriverInfo(fPort.RegKey);
  if dev <> nil then begin
    RegKey := dev.RegKey;
    Service := dev.Service;
    InstanceId := dev.InstanceId;
    GuidClass := dev.GuidClass;
    BusRelations := Trim(StringReplace(dev.BusRelations,';',#13#10,[rfReplaceAll]));
    NameSymbolic := RegReadString(HKEY_LOCAL_MACHINE, RegKey, 'SymbolicName');
    DevInst := dev.DevInst;
    Manufacturer := dev.Manufacturer; 
    if (AnsiCompareText(Service,'USBSTOR') = 0) or (AnsiCompareText(Service,'USBCCGP') = 0)
      then UpdateStorageInfo;

  end;

end;

procedure TnrUsbDevice.UpdateStorageInfo;
var s:string;
    slBusRel:TStringList;
    slBusRelVol:TStringList;
    i,j :integer;
begin
  fDriverLetters := '';
  if BusRelations = '' then exit;

  slBusRelVol := TStringList.Create;
  slBusRel := TStringList.Create;
  slBusRel.Text := BusRelations;

  for i := 0 to slBusRel.Count - 1 do begin
    slBusRelVol.Text := DiGetRelations(slBusRel[i], #13#10, True);
    if slBusRelVol.Count = 0
      then begin
        slBusRelVol.Text := DiGetRelations(slBusRel[i], #13#10, False);
      end;

    for j := 0 to slBusRelVol.Count - 1 do begin
      s := fPort.fHub.fHost.fManager.GetVolumeInfo(slBusRelVol[j]);
      if s <> '' then fDriverLetters := fDriverLetters + s +': ';
    end;
  end;

  slBusRelVol.Free;
  slBusRel.Free;
end;

function TnrUsbDevice.GetPipe(Index: integer): TnrUsbPipe;
begin
  Result := nil;
  if index < PipeCount then Result := TnrUsbPipe(List[Index]);
end;

function TnrUsbDevice.GetPipeCount: integer;
begin
  Result:=List.Count;
end;

function TnrUsbDevice.GetMaxPower: cardinal;
begin
  if (configDesc<>nil) and ((configDesc^.bmAttributes and $80)<>0)
    then Result:=configDesc^.MaxPower * 2
    else Result:=0;
end;

function TnrUsbDevice.GetIsSelfPower: boolean;
begin
  Result:=((configDesc<>nil)and
           ((configDesc^.bmAttributes and $40)<>0));
end;

function TnrUsbDevice.GetIsWakeUp: boolean;
begin
  Result:=((configDesc<>nil)and
           ((configDesc^.bmAttributes and $20)<>0));
end;

function TnrUsbDevice.GetIsBusPower: boolean;
begin
  Result:=((configDesc<>nil)and
           ((configDesc^.bmAttributes and $80)<>0));
end;

function TnrUsbDevice.GetDescriptorString(hUsb:dword; i:integer) : string;
var
  pwcDesc : PWideChar;
begin
  Result := '';
  try
    pwcDesc := Pointer(GetDescriptor(hUsb, Port.PortIndex, USB_STRING_DESCRIPTOR_TYPE, i));
    if pwcDesc <> nil then begin
      pwcDesc := Pointer(Dword(pwcDesc) + 2);
      Result := String(WideString(pwcDesc));
    end;
  except
  end;
end;

procedure TnrUsbDevice.UpdateDescriptors;
var s:string;
    i:integer;
    hF:THandle;
    //pwcDesc : PWideChar;
begin
  slDescriptors.Clear;
  hF := CreateFile(PChar(Port.fHub.NameSymbolic),
                 GENERIC_WRITE + GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
  if hF <> INVALID_HANDLE_VALUE then begin
    i := 1;
    repeat
      s := GetDescriptorString(hF, i);
      if Length(s) > 0 then slDescriptors.Add(s);
      i := i +1;
    until (Length(s) = 0) or (i > 16);

    i := Port.ConnectInfo^.DeviceDescriptor.iManufacturer;
    if (i > 0) then begin
      if (i <= slDescriptors.Count)
        then Manufacturer := slDescriptors[i - 1]
        else Manufacturer := GetDescriptorString(hF, i);
    end;

    i := Port.ConnectInfo^.DeviceDescriptor.iProduct;
    if (i > 0) then begin
      if (i <= slDescriptors.Count)
        then Description := slDescriptors[i - 1]
        else Description := GetDescriptorString(hF, i);
    end;

    i := Port.ConnectInfo^.DeviceDescriptor.iSerialNumber;
    if (i > 0) then begin
      if (i <= slDescriptors.Count)
        then SerialNumber := slDescriptors[i - 1]
        else SerialNumber := GetDescriptorString(hF, i);
    end;

    CloseHandle(hF);
  end;

end;

function TnrUsbDevice.GetDescriptors: TStrings;
begin
  Result := TStrings(slDescriptors);
end;


{ TnrUsbPipe }

constructor TnrUsbPipe.Create(aOwner:TnrUsbDevice);
begin
  inherited Create;
  Handle := INVALID_HANDLE_VALUE;
  fDevice := aOwner;
end;

destructor TnrUsbPipe.Destroy;
begin
  inherited Destroy;
end;

function TnrUsbPipe.GetMaxPacketSize: cardinal;
begin
  if PipeInfo <> nil
    then Result := PipeInfo^.EndpointDescriptor.wMaxPacketSize
    else Result := 0;
end;

function TnrUsbPipe.GetTransferType: TnrUsbTransferType;
begin
  Result:=uttUnknown;
  if PipeInfo<>nil then
    case (PipeInfo^.EndpointDescriptor.bmAttributes and 3) of
      0: Result:=uttControl;
      1: Result:=uttIsochronous;
      2: Result:=uttBulk;
      3: Result:=uttInterrupt;
    end;
end;

function TnrUsbPipe.GetDirectIn: boolean;
begin
  Result:=False;
  if PipeInfo<>nil
    then Result:=((PipeInfo^.EndpointDescriptor.bEndpointAddress and $80)<>0);
end;

function TnrUsbPipe.GetDirectOut: boolean;
begin
  Result:=False;
  if PipeInfo<>nil
    then Result:=((PipeInfo^.EndpointDescriptor.bEndpointAddress and $80)=0);
end;

function TnrUsbPipe.GetPipeID: byte;
begin
  if PipeInfo <> nil
    then Result := PipeInfo^.EndpointDescriptor.bEndpointAddress
    else Result := 0;
end;

initialization

finalization

  if vGlobalUsbManager <> nil then begin
    vGlobalUsbManager.Free;
    DeleteCriticalSection(csUsbReloadLock);
  end;

end.
