// Device manager uses WinUSB driver by default!!!

unit mr.dev.manager;

interface
uses
//   Vcl.Dialogs,
   System.Classes,
   mr.drv.usb,
   mr.dev.usb;
//   dev.usb.trinity.types;

type
   GetDeviceListCallback = reference to function(  VendorID    : word;
                                                   ProductID   : word;
                                                   Description : string;
                                                   Location    : string;
                                                   DevicePath  : string): boolean;

procedure   RegisterDriver(      DriverClass : TUsbDriverClass);
//
procedure   RegisterDevice(      VendorID    : word;
                                 ProductID   : word;
                                 Capabilities: int64;
                                 DeviceClass : TUsbDeviceClass);
//
function    AllocateDevice(      DevicePath  : string): TUsbDevice;
//                                 Capabilities: TCapabilities = [];
//                                 IgnoreCap   : boolean = false): TUsbDevice;
//
//function    AllocateDeviceBySN(  SerialNumber: AnsiString;
//                                 Capabilities: TCapabilities = [];
//                                 IgnoreCap   : boolean = false): TUsbDevice;
//
procedure   DeallocateDevice( var Device  : TUsbDevice);
//
procedure   GetDeviceList( Callback    : GetDeviceListCallback;
                           VendorID    : word  = 0;
                           ProductID   : word  = 0);


implementation
uses
   system.SysUtils,
   spring.Collections;

procedure   ParseInstanceId(  InstanceId  : string;
                          var VendorID    : word;
                          var ProductID   : word;
                          var Location    : string;
                          var Description : string); forward;



//   SysUtils,
//   Generics.Collections,
//   drv.usb.winusb,
//   dev.usb.trinity,
//   dev.usb.trinity.utils;
//
//type
//
//type
//   TUsbDriverMap  = TDictionary      <AnsiString, TUsbDriverClass>;
//   TUsbDeviceMap  = TObjectDictionary<AnsiString, TUsbDeviceInfo>;
//
//var
//   UsbDriverAlloc : TUsbDriverMap   = nil;
//   UsbDriverMap   : TUsbDriverMap   = nil;
//   UsbDeviceMap   : TUsbDeviceMap   = nil;
//
//

type
   TUsbDeviceSetup = class
      strict protected
         fDriverClass : TUsbDriverClass;
         fDeviceClass : TUsbDeviceClass;

         fVendorID    : word;
         fProductID   : word;
         fDescription : string;

      public
         property    DriverClass : TUsbDriverClass read  fDriverClass   write fDriverClass;
         property    DeviceClass : TUsbDeviceClass read  fDeviceClass   write fDeviceClass;
         property    VendorID    : word            read  fVendorID      write fVendorID;
         property    ProductID   : word            read  fProductID     write fProductID;
         property    Description : string          read  fDescription   write fDescription;
   end;

   TUsbDeviceDescriptor = class
      strict protected
         fDeviceSetup   : TUsbDeviceSetup;
         fDevicePath    : string;
         fLocation      : string;
         fAllocated     : boolean;

      strict protected
         function    GetDriverClass : TUsbDriverClass;
         function    GetDeviceClass : TUsbDeviceClass;
         function    GetDescription : string;
         function    GetVendorID    : word;
         function    GetProductID   : word;

      public
         constructor Create( DevicePath: string); reintroduce;
         destructor  Destroy; override;

      public
         property    Allocated      : boolean         read  fAllocated     write fAllocated;
         property    DeviceSetup    : TUsbDeviceSetup read  fDeviceSetup   write fDeviceSetup;
         property    DevicePath     : string          read  fDevicePath;
         property    Location       : string          read  fLocation;

         property    VendorID       : word            read  GetVendorId;
         property    ProductID      : word            read  GetProductID;
         property    Description    : string          read  GetDescription;
   end;

var
   UsbDeviceSetups   : IDictionary< cardinal, TUsbDeviceSetup>;
   UsbDevices        : IDictionary< string, TUsbDeviceDescriptor>;

// ================================================================================================
// Register Driver
// ================================================================================================
procedure RegisterDriver( DriverClass: TUsbDriverClass);
var
   vid: word;
   pid: word;
   loc: string;
   dsc: string;
   key: cardinal;

   uds: TUsbDeviceSetup;
   udd: TUsbDeviceDescriptor;

begin
   if UsbDevices = nil then
      UsbDevices := tCollections.CreateDictionary< string, TUsbDeviceDescriptor>([doOwnsValues]);

   if UsbDeviceSetups = nil then
      UsbDeviceSetups := TCollections.CreateDictionary< cardinal, TUsbDeviceSetup>([doOwnsValues]);

   DriverClass.Scan( procedure( DevicePath: string)
                     begin
                        DriverClass.ParseInstanceId( DevicePath, vid, pid, loc, dsc);
                        key := (vid shl 16) + pid;

                        // --------------------------------------------------------------
                        // add or update (override) an usb device setup entry
                        // --------------------------------------------------------------
                        if not UsbDeviceSetups.TryGetValue( key, uds) then
                        begin
                           uds            := TUsbDeviceSetup.Create;
                           uds.VendorID   := vid;
                           uds.ProductID  := pid;

                           UsbDeviceSetups.Add( key, uds)
                        end;

                        uds.DriverClass   := DriverClass;
                        uds.Description   := dsc;

                        // --------------------------------------------------------------
                        // add or update (override) an usb device entry
                        // --------------------------------------------------------------
                        if not UsbDevices.TryGetValue( DevicePath, udd) then
                        begin
                           udd := TUsbDeviceDescriptor.Create( DevicePath);
                           UsbDevices.Add(DevicePath, udd)
                        end;

                        udd.DeviceSetup := uds
                     end)
end;

// ================================================================================================
// Register Device
// ================================================================================================
procedure RegisterDevice(  VendorID    : word;
                           ProductID   : word;
                           Capabilities: int64;
                           DeviceClass : TUsbDeviceClass);
var
   key: cardinal;
   uds: TUsbDeviceSetup;

begin
   if UsbDeviceSetups = nil then
      UsbDeviceSetups := TCollections.CreateDictionary< cardinal, TUsbDeviceSetup>([doOwnsValues]);

   key := (VendorID shl 16) + ProductID;

   if not UsbDeviceSetups.TryGetValue( key, uds) then
   begin
      uds           := TUsbDeviceSetup.Create;
      uds.VendorID  := VendorID;
      uds.ProductID := ProductID;

      UsbDeviceSetups.Add( key, uds);
   end;

   uds.DeviceClass  := DeviceClass;
end;

// ================================================================================================
// Get Device List
// ================================================================================================
procedure GetDeviceList( Callback  : GetDeviceListCallback;
                         VendorID  : word  = 0;
                         ProductID : word  = 0);
begin
   for var udd in UsbDevices.Values do
      if ((VendorID = 0) and (ProductID = 0)) or
         ((VendorID = udd.VendorID) and (ProductID = udd.ProductID)) then
      begin
         with udd do
            if not Callback( VendorID, ProductID, Description, Location, DevicePath) then
               break
      end
end;

// ================================================================================================
// Allocate Device
// ================================================================================================
function AllocateDevice( DevicePath: string): TUsbDevice;
var
   udd: TUsbDeviceDescriptor;

begin
   result := nil;

   assert( UsbDeviceSetups <> nil);
   assert( UsbDevices      <> nil);

   if UsbDevices.TryGetValue( DevicePath, udd) and not udd.Allocated then
   begin
      var ds := udd.DeviceSetup;
      assert( ds <> nil);

      if (ds.DriverClass <> nil) and (ds.DeviceClass <> nil) then
      begin
         udd.Allocated := true;

         var drv := ds.DriverClass.Create( DevicePath);
         var dev := ds.DeviceClass.Create( drv);

         exit(dev)
      end
   end
end;

// ================================================================================================
// Deallocate Device
// ================================================================================================
procedure DeallocateDevice( var Device: TUsbDevice);
var
   udd: TUsbDeviceDescriptor;

begin
   if Assigned(Device) then
   begin
      if UsbDevices.TryGetValue( Device.DevicePath, udd) then
         udd.Allocated := false;

//      FreeAndNil( Device)
   end
end;


//// ================================================================================================
//// allocate device by serial number
//// ================================================================================================
//function AllocateDeviceBySN(  SerialNumber: AnsiString;
//                              Capabilities: TCapabilities = [];
//                              IgnoreCap   : boolean = false): TUsbDevice;
//var
//   vid   : word;
//   pid   : word;
//   loc   : string;
//   dsc   : string;
//
//   drv   : TUsbDriver;
//   drvc  : TUsbDriverClass;
//
//   dev   : TUsbDevice;
//   devc  : TUsbDeviceClass;
//
//   tri   : TTrinity;
//   inf   : TUsbDeviceInfo;
//   cap   : TCapabilities;
//   sn    : AnsiString;
//
//   path  : AnsiString;
//
//begin
//   result := nil;
//
//   if Assigned( UsbDriverMap) and Assigned(UsbDeviceMap) then
//   begin
//      for path in UsbDriverMap.Keys do
//      begin
//         ParseInstanceID( path, vid, pid, loc, dsc);
//
//         drvc  := UsbDriverMap.Items[path];
//         devc  := nil;
//         cap   := [];
//
//         if (vid = $16d0) and (pid = $0712) then
//         begin
//            try
//               drv := drvc.Create(path);
//               tri := TTrinity.Create(drv);
//
//               tri.Open;
//               cap := tri.Capabilities;
//               sn  := tri.SerialNumber;
//               tri.Close;
//
//               tri.Free;
//
//            except
//
//            end;
//         end;
//
//         for inf in UsbDeviceMap.Values do
//            if (inf.VendorID = vid) and (inf.ProductID = pid) then
//               if (inf.Capabilities * cap = cap) or IgnoreCap then
//               begin
//                  if sn = SerialNumber then
//                  begin
//                     devc := inf.DeviceClass;
//                     break;
//                  end;
//               end;
//
//         if Assigned(devc) then
//         begin
//            drv := drvc.Create(path);
//            dev := devc.Create(drv);
//
//            if not Assigned( UsbDriverAlloc) then
//               UsbDriverAlloc := TUsbDriverMap.Create;
//
//            UsbDriverAlloc.Add( path, drvc);
//            UsbDriverMap.Remove(path);
//
//            result:= dev;
//         end;
//      end
//   end
//end;
//


// ================================================================================================
// parse instnce ID
// ================================================================================================
procedure   ParseInstanceId(  InstanceId  : string;
                          var VendorID    : word;
                          var ProductID   : word;
                          var Location    : string;
                          var Description : string);
var
   i  : integer;
   l  : integer;
   id : string;
   loc: string;
   dsc: string;

begin
   i := 1;
   l := Length(InstanceId);

   while (i<=l) and (InstanceId[i] <> '\') do
      inc(i);

   inc(i);

   while (i<=l) and (InstanceId[i] <> '\') do
   begin
      id  := id  + InstanceId[i];
      inc(i)
   end;

   inc(i);

   while (i<=l) and (InstanceId[i] <> '#') do
   begin
      loc := loc + InstanceId[i];
      inc(i)
   end;

   inc(i);

   while (i<=l) do
   begin
      dsc := dsc + InstanceId[i];
      inc(i)
   end;

   if @VendorID <> nil then
      VendorId    := StrToInt('$'+Copy( id,  5, 4));

   ProductId   := StrToInt('$'+Copy( id, 14, 4));
   Location    := loc;
   Description := dsc
end;

{ TUsbDeviceDescriptor }



// @@@: UsbDeviceDescriptor +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                      UsbDeviceDescriptor
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

// ================================================================================================
// constructor
// ================================================================================================
constructor TUsbDeviceDescriptor.Create(DevicePath: string);
var
   vid: word;
   pid: word;
   dsc: string;

begin
   inherited Create;

   fAllocated  := false;
   fDevicePath := DevicePath;

   ParseInstanceId( fDevicePath, vid, pid, fLocation, dsc)
end;

// ================================================================================================
// destructor
// ================================================================================================
destructor TUsbDeviceDescriptor.Destroy;
begin
   inherited;
end;

// ================================================================================================
// get driver class
// ================================================================================================
function TUsbDeviceDescriptor.GetDriverClass: TUsbDriverClass;
begin
   result := fDeviceSetup.DriverClass
end;

// ================================================================================================
// get device class
// ================================================================================================
function TUsbDeviceDescriptor.GetDeviceClass: TUsbDeviceClass;
begin
   result := fDeviceSetup.DeviceClass
end;

// ================================================================================================
// get vendor ID
// ================================================================================================
function TUsbDeviceDescriptor.GetVendorID: word;
begin
   result := fDeviceSetup.VendorID
end;

// ================================================================================================
// get product ID
// ================================================================================================
function TUsbDeviceDescriptor.GetProductID: word;
begin
   result := fDeviceSetup.ProductID
end;

// ================================================================================================
// get description
// ================================================================================================
function TUsbDeviceDescriptor.GetDescription: string;
begin
   result := fDeviceSetup.Description
end;

initialization

finalization

end.