Initial check in
This commit is contained in:
@@ -0,0 +1,497 @@
|
||||
// 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.
|
||||
Reference in New Issue
Block a user