Rework
This commit is contained in:
+426
-199
@@ -4,11 +4,9 @@ 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;
|
||||
@@ -17,40 +15,44 @@ type
|
||||
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);
|
||||
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
|
||||
system.SysUtils,
|
||||
spring.Collections;
|
||||
|
||||
procedure ParseInstanceId( InstanceId : string;
|
||||
var VendorID : word;
|
||||
var ProductID : word;
|
||||
var Location : string;
|
||||
var Description : string); forward;
|
||||
|
||||
|
||||
Winapi.Windows,
|
||||
System.SysUtils,
|
||||
System.Win.Registry,
|
||||
Spring.Collections,
|
||||
mr.drv.usb.notifier;
|
||||
|
||||
// SysUtils,
|
||||
// Generics.Collections,
|
||||
@@ -118,155 +120,185 @@ type
|
||||
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
|
||||
UsbDeviceSetups : IDictionary< cardinal, TUsbDeviceSetup>;
|
||||
UsbDevices : IDictionary< string, TUsbDeviceDescriptor>;
|
||||
gDeviceManager: TDeviceManager;
|
||||
|
||||
function DeviceManager: TDeviceManager; forward;
|
||||
|
||||
procedure RegisterUsbConnectEventHandler( AEventHandler: DeviceConnectEvent);
|
||||
begin
|
||||
DeviceManager.OnDeviceArrival := AEventHandler
|
||||
end;
|
||||
|
||||
procedure RegisterUsbDisconnectEventHandler( AEventHandler: DeviceConnectEvent);
|
||||
begin
|
||||
DeviceManager.OnDeviceRemoval := AEventHandler;
|
||||
end;
|
||||
|
||||
|
||||
// ================================================================================================
|
||||
// Register Driver
|
||||
// parse device path
|
||||
//
|
||||
// '\\?\USB#VID_04B4&PID_8613#7&2ec9f839&0&17#{cdde880f-898a-4dab-b0ea-51fba32c1d82}'
|
||||
// ================================================================================================
|
||||
procedure RegisterDriver( DriverClass: TUsbDriverClass);
|
||||
function ParseDevicePath( InstanceId : string;
|
||||
var VendorID : word;
|
||||
var ProductID : word;
|
||||
var Location : string;
|
||||
var Description : string): boolean;
|
||||
var
|
||||
vid: word;
|
||||
pid: word;
|
||||
id : string;
|
||||
loc: string;
|
||||
dsc: string;
|
||||
key: cardinal;
|
||||
|
||||
uds: TUsbDeviceSetup;
|
||||
udd: TUsbDeviceDescriptor;
|
||||
|
||||
begin
|
||||
if UsbDevices = nil then
|
||||
UsbDevices := tCollections.CreateDictionary< string, TUsbDeviceDescriptor>([doOwnsValues]);
|
||||
result := false;
|
||||
|
||||
if UsbDeviceSetups = nil then
|
||||
UsbDeviceSetups := TCollections.CreateDictionary< cardinal, TUsbDeviceSetup>([doOwnsValues]);
|
||||
if Copy( InstanceId, 1, 8) = '\\?\USB#'
|
||||
then InstanceId := Copy( InstanceId, 9)
|
||||
else exit;
|
||||
|
||||
DriverClass.Scan( procedure( DevicePath: string)
|
||||
begin
|
||||
DriverClass.ParseInstanceId( DevicePath, vid, pid, loc, dsc);
|
||||
key := (vid shl 16) + pid;
|
||||
var items := InstanceId.Split(['#']);
|
||||
|
||||
// --------------------------------------------------------------
|
||||
// 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;
|
||||
if Length(items) = 3 then
|
||||
begin
|
||||
id := items[0];
|
||||
loc := items[1];
|
||||
dsc := items[2];
|
||||
end
|
||||
|
||||
UsbDeviceSetups.Add( key, uds)
|
||||
end;
|
||||
else
|
||||
exit;
|
||||
|
||||
uds.DriverClass := DriverClass;
|
||||
uds.Description := dsc;
|
||||
var ids := id.Split(['&']);
|
||||
|
||||
// --------------------------------------------------------------
|
||||
// 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;
|
||||
if Length(ids) = 2 then
|
||||
begin
|
||||
VendorID := StrToInt('$'+Copy( ids[0], 5, 4));
|
||||
ProductID := StrToInt('$'+Copy( ids[1], 5, 4));
|
||||
end
|
||||
|
||||
udd.DeviceSetup := uds
|
||||
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 Device
|
||||
// register driver
|
||||
// ================================================================================================
|
||||
procedure RegisterDevice( VendorID : word;
|
||||
ProductID : word;
|
||||
Capabilities: int64;
|
||||
DeviceClass : TUsbDeviceClass);
|
||||
var
|
||||
key: cardinal;
|
||||
uds: TUsbDeviceSetup;
|
||||
|
||||
procedure RegisterDriver( ADriverClass: TUsbDriverClass);
|
||||
begin
|
||||
if UsbDeviceSetups = nil then
|
||||
UsbDeviceSetups := TCollections.CreateDictionary< cardinal, TUsbDeviceSetup>([doOwnsValues]);
|
||||
DeviceManager.RegisterDriver( ADriverClass)
|
||||
end;
|
||||
|
||||
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;
|
||||
// ================================================================================================
|
||||
// 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( Callback : GetDeviceListCallback;
|
||||
VendorID : word = 0;
|
||||
ProductID : word = 0);
|
||||
procedure GetDeviceList( ACallback : GetDeviceListCallback;
|
||||
AVendorID : word = 0;
|
||||
AProductID : 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
|
||||
DeviceManager.GetDeviceList( ACallback, AVendorID, AProductID)
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Allocate Device
|
||||
// ================================================================================================
|
||||
function AllocateDevice( DevicePath: string): TUsbDevice;
|
||||
var
|
||||
udd: TUsbDeviceDescriptor;
|
||||
|
||||
function AllocateDevice( ADevicePath : string): TUsbDevice;
|
||||
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
|
||||
result := DeviceManager.AllocateDevice( ADevicePath)
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Deallocate Device
|
||||
// ================================================================================================
|
||||
procedure DeallocateDevice( var Device: TUsbDevice);
|
||||
var
|
||||
udd: TUsbDeviceDescriptor;
|
||||
|
||||
procedure DeallocateDevice( var ADevice: TUsbDevice);
|
||||
begin
|
||||
if Assigned(Device) then
|
||||
begin
|
||||
if UsbDevices.TryGetValue( Device.DevicePath, udd) then
|
||||
udd.Allocated := false;
|
||||
|
||||
// FreeAndNil( Device)
|
||||
end
|
||||
DeviceManager.DeallocateDevice( ADevice)
|
||||
end;
|
||||
|
||||
|
||||
@@ -356,64 +388,8 @@ 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 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
@@ -427,7 +403,7 @@ end;
|
||||
// ================================================================================================
|
||||
// constructor
|
||||
// ================================================================================================
|
||||
constructor TUsbDeviceDescriptor.Create(DevicePath: string);
|
||||
constructor TUsbDeviceDescriptor.Create( DevicePath: string);
|
||||
var
|
||||
vid: word;
|
||||
pid: word;
|
||||
@@ -439,7 +415,8 @@ begin
|
||||
fAllocated := false;
|
||||
fDevicePath := DevicePath;
|
||||
|
||||
ParseInstanceId( fDevicePath, vid, pid, fLocation, dsc)
|
||||
if not ParseDevicePath( fDevicePath, vid, pid, fLocation, dsc) then
|
||||
fLocation := ''
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
@@ -490,8 +467,258 @@ 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.
|
||||
|
||||
Reference in New Issue
Block a user