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

unit mr.dev.manager;

interface
uses
   System.Classes,
   mr.drv.usb,
   mr.dev.usb;

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

   DeviceConnectEvent    = procedure(ADevicePath    : string) of object;


procedure   RegisterDriver(         ADriverClass   : TUsbDriverClass);

procedure   RegisterDevice(         AVendorID      : word;
                                    AProductID     : word;
                                    ACapabilities  : int64;
                                    ADeviceClass   : TUsbDeviceClass);

procedure   GetDeviceList(          ACallback      : GetDeviceListCallback;
                                    AVendorID      : word = 0;
                                    AProductID     : word = 0);

function    AllocateDevice(         ADevicePath    : string): TUsbDevice;
procedure   DeallocateDevice(   var ADevice        : TUsbDevice);


function    ParseDevicePath(  InstanceId  : string;
                          var VendorID    : word;
                          var ProductID   : word;
                          var Location    : string;
                          var Description : string): boolean;



procedure   RegisterUsbConnectEventHandler(     AEventHandler: DeviceConnectEvent);
procedure   RegisterUsbDisconnectEventHandler(  AEventHandler: DeviceConnectEvent);



implementation
uses
   Winapi.Windows,
   System.SysUtils,
   System.Win.Registry,
   Spring.Collections,
   mr.drv.usb.notifier;

//   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;

   TDeviceManager = class
      private
         fOnDeviceArrival  : DeviceConnectEvent;
         fOnDeviceRemoval  : DeviceConnectEvent;

      private
         fUsbDeviceSetups  : IDictionary< cardinal,   TUsbDeviceSetup>;
         fUsbDevices       : IDictionary< string,     TUsbDeviceDescriptor>;
         fUsbNotifiers     : IDictionary< string,     TusbNotifier>;

         procedure   DoUsbArrival(     ADevicePath    : string;
                                       ADriverClass   : TUsbDriverClass);

         procedure   DoUsbRemoval(     ADevicePath    : string;
                                       ADriverClass   : TUsbDriverClass);

      public
         procedure   RegisterDriver(   ADriverClass   : TUsbDriverClass);

         procedure   RegisterDevice(   AVendorID      : word;
                                       AProductID     : word;
                                       ACapabilities  : int64;
                                       ADeviceClass   : TUsbDeviceClass);


         procedure   GetDeviceList(    ACallback      : GetDeviceListCallback;
                                       AVendorID      : word = 0;
                                       AProductID     : word = 0);

         function    AllocateDevice(   ADevicePath    : string): TUsbDevice;
         procedure   DeallocateDevice( ADevice        : TUsbDevice);

      public
         constructor Create;
         destructor  Destroy; override;

      public
         property    OnDeviceArrival   : DeviceConnectEvent    read  fOnDeviceArrival  write fOnDeviceArrival;
         property    OnDeviceRemoval   : DeviceConnectEvent    read  fOnDeviceRemoval  write fOnDeviceRemoval;
   end;

var
   gDeviceManager: TDeviceManager;

function DeviceManager: TDeviceManager; forward;

procedure RegisterUsbConnectEventHandler( AEventHandler: DeviceConnectEvent);
begin
   DeviceManager.OnDeviceArrival := AEventHandler
end;

procedure RegisterUsbDisconnectEventHandler( AEventHandler: DeviceConnectEvent);
begin
   DeviceManager.OnDeviceRemoval := AEventHandler;
end;


// ================================================================================================
// parse device path
//
// '\\?\USB#VID_04B4&PID_8613#7&2ec9f839&0&17#{cdde880f-898a-4dab-b0ea-51fba32c1d82}'
// ================================================================================================
function ParseDevicePath(  InstanceId  : string;
                       var VendorID    : word;
                       var ProductID   : word;
                       var Location    : string;
                       var Description : string): boolean;
var
   id : string;
   loc: string;
   dsc: string;

begin
   result := false;

   if Copy( InstanceId, 1, 8) = '\\?\USB#'
      then InstanceId := Copy( InstanceId, 9)
      else exit;

   var items := InstanceId.Split(['#']);

   if Length(items) = 3 then
   begin
      id  := items[0];
      loc := items[1];
      dsc := items[2];
   end

   else
      exit;

   var ids := id.Split(['&']);

   if Length(ids) = 2 then
   begin
      VendorID  := StrToInt('$'+Copy( ids[0], 5, 4));
      ProductID := StrToInt('$'+Copy( ids[1], 5, 4));
   end

   else
      exit;

   Location    := Uppercase(loc);

   var reg     := TRegistry.Create;
   reg.RootKey := HKEY_LOCAL_MACHINE;

   if reg.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\USB\'+id +'\'+ loc) then
   begin
      Description := reg.ReadString('DeviceDesc');
      var i := Pos( ';', Description);

      if i > 0 then
         Description := Copy( Description, i+1);

      reg.CloseKey
   end;

   SetLength( items, 0);
   SetLength( ids,   0);

   result := true
end;


// ================================================================================================
// DeviceManager (singleton pattern)
// ================================================================================================
function DeviceManager: TDeviceManager;
begin
   if gDeviceManager = nil then
      gDeviceManager := TDeviceManager.Create;

   result := gDeviceManager
end;

// ================================================================================================
// register driver
// ================================================================================================
procedure RegisterDriver( ADriverClass: TUsbDriverClass);
begin
   DeviceManager.RegisterDriver( ADriverClass)
end;

// ================================================================================================
// register device
// ================================================================================================
procedure RegisterDevice(  AVendorID      : word;
                           AProductID     : word;
                           ACapabilities  : int64;
                           ADeviceClass   : TUsbDeviceClass);
begin
   DeviceManager.RegisterDevice( AVendorID, AProductID, ACapabilities, ADeviceClass)
end;

// ================================================================================================
// Get Device List
// ================================================================================================
procedure GetDeviceList(   ACallback      : GetDeviceListCallback;
                           AVendorID      : word  = 0;
                           AProductID     : word  = 0);
begin
   DeviceManager.GetDeviceList( ACallback, AVendorID, AProductID)
end;

// ================================================================================================
// Allocate Device
// ================================================================================================
function AllocateDevice(   ADevicePath    : string): TUsbDevice;
begin
   result := DeviceManager.AllocateDevice( ADevicePath)
end;

// ================================================================================================
// Deallocate Device
// ================================================================================================
procedure DeallocateDevice( var ADevice: TUsbDevice);
begin
   DeviceManager.DeallocateDevice( ADevice)
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;
//


{ TUsbDeviceDescriptor }

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

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

begin
   inherited Create;

   fAllocated  := false;
   fDevicePath := DevicePath;

   if not ParseDevicePath( fDevicePath, vid, pid, fLocation, dsc) then
      fLocation := ''
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;

{ TDeviceManager }
// ================================================================================================
// constructor
// ================================================================================================
constructor TDeviceManager.Create;
begin
   inherited;

   fUsbDeviceSetups  := TCollections.CreateDictionary< cardinal,  TUsbDeviceSetup>     ([doOwnsValues]);
   fUsbDevices       := TCollections.CreateDictionary< string,    TUsbDeviceDescriptor>([doOwnsValues]);
   fUsbNotifiers     := TCollections.CreateDictionary< string,    TusbNotifier>        ([doOwnsValues]);
end;

// ================================================================================================
// destructor
// ================================================================================================
destructor TDeviceManager.Destroy;
begin
   fUsbDeviceSetups  := nil;
   fUsbDevices       := nil;
   fUsbNotifiers     := nil;

   inherited
end;

// ================================================================================================
// get device list
// ================================================================================================
procedure TDeviceManager.GetDeviceList(   ACallback : GetDeviceListCallback;
                                          AVendorID : word = 0;
                                          AProductID: word = 0);
begin
   for var udd in fUsbDevices.Values do
      if ((AVendorID = 0) and (AProductID = 0)) or
         ((AVendorID = udd.VendorID) and (AProductID = udd.ProductID)) then
         with udd do
            if not ACallback( VendorID, ProductID, Description, Location, DevicePath) then
               break
end;

// ================================================================================================
// allocate device
// ================================================================================================
function TDeviceManager.AllocateDevice( ADevicePath: string): TUsbDevice;
var
   udd: TUsbDeviceDescriptor;

begin
   result := nil;

   assert( fUsbDeviceSetups <> nil);
   assert( fUsbDevices      <> nil);

   if fUsbDevices.TryGetValue( ADevicePath, udd) then
   begin
      if 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( udd.DevicePath);
            var dev := ds.DeviceClass.Create( drv);

            exit(dev)
         end
      end

      else begin
         udd.Allocated := true
      end;

   end
end;

// ================================================================================================
// deallocate device
// ================================================================================================
procedure TDeviceManager.DeallocateDevice( ADevice: TUsbDevice);
var
   udd: TUsbDeviceDescriptor;

begin
   if ADevice <> nil then
   begin
      if fUsbDevices.TryGetValue( ADevice.DevicePath, udd) then
         udd.Allocated := false;

      FreeAndNil( ADevice)
   end
end;

// ================================================================================================
// register driver
// ================================================================================================
procedure TDeviceManager.RegisterDriver( ADriverClass: TUsbDriverClass);
begin
   if Assigned( ADriverClass) then
   begin
      // --------------------------------------------------
      // register for usb arrival/removal notifications
      // --------------------------------------------------
      var guid := ADriverClass.InterfaceGUID;

      if guid <> '' then
      begin
         if not fUsbNotifiers.ContainsKey( guid) then
         begin
            var noti := TusbNotifier.Create( guid, ADriverClass);

            noti.OnUSBArrival := DoUsbArrival;
            noti.OnUSBRemove  := DoUsbRemoval;

            fUsbNotifiers.Add( guid, noti);
         end;

         // --------------------------------------------------
         // scan for already connected devices
         // --------------------------------------------------
         ADriverClass.Scan(
            procedure( ADevicePath: string)
            var
               vid   : word;
               pid   : word;
               loc   : string;
               dsc   : string;
               uds   : TUsbDeviceSetup;

            begin
               ParseDevicePath( ADevicePath, vid, pid, loc, dsc);
               var key := (vid shl 16) + pid;

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

                  fUsbDeviceSetups.Add( key, uds)
               end;

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

               // --------------------------------------------------------------
               // add usb device
               // --------------------------------------------------------------
               if not fUsbDevices.ContainsKey( ADevicePath) then
               begin
                  var udd := TUsbDeviceDescriptor.Create( ADevicePath);
                  udd.DeviceSetup   := uds;

                  fUsbDevices.Add( ADevicePath, udd)
               end
            end)
      end
   end
end;

// ================================================================================================
// register device
// ================================================================================================
procedure TDeviceManager.RegisterDevice(  AVendorID      : word;
                                          AProductID     : word;
                                          ACapabilities  : int64;
                                          ADeviceClass   : TUsbDeviceClass);
var
   key: cardinal;
   uds: TUsbDeviceSetup;

begin
   key := (AVendorID shl 16) + AProductID;

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

      fUsbDeviceSetups.Add( key, uds);
   end;

   uds.DeviceClass  := ADeviceClass;
end;


// ================================================================================================
// USB device connected
// ================================================================================================
procedure TDeviceManager.DoUsbArrival( ADevicePath: string; ADriverClass: TUsbDriverClass);
var
   vid   : word;
   pid   : word;
   loc   : string;
   dsc   : string;

   uds   : TUsbDeviceSetup;
   udd   : TUsbDeviceDescriptor;

begin
   ADevicePath := Uppercase( ADevicePath);
   ParseDevicePath( ADevicePath, vid, pid, loc, dsc);

   // --------------------------------------------------------------
   // add device
   // --------------------------------------------------------------
   var key := (vid shl 16) + pid;

   if fUsbDeviceSetups.TryGetValue( key, uds) then
   begin
      if not Assigned( uds.DriverClass) then
         uds.DriverClass := ADriverClass;

      if not fUsbDevices.ContainsKey( ADevicePath) then
      begin
         udd := TUsbDeviceDescriptor.Create( ADevicePath);
         udd.DeviceSetup := uds;

         fUsbDevices.Add( ADevicePath, udd);

       if Assigned( fOnDeviceArrival) then
            fOnDeviceArrival( ADevicePath)
      end
   end
end;

// ================================================================================================
// USB device disconnected
// ================================================================================================
procedure TDeviceManager.DoUsbRemoval( ADevicePath: string; ADriverClass: TUsbDriverClass);
begin
   ADevicePath := Uppercase( ADevicePath);

   if fUsbDevices.ContainsKey( ADevicePath) then
   begin
      if Assigned( fOnDeviceRemoval) then
         fOnDeviceRemoval( ADevicePath);

      fUsbDevices.Remove( ADevicePath)
   end
end;

initialization

finalization
   if gDeviceManager <> nil then
      gDeviceManager.Free

end.