diff --git a/prj.devmgr/Delphi12Athens/mr.devmgr.dpk b/prj.devmgr/Delphi12Athens/mr.devmgr.dpk
index 2a2cb55..960556b 100644
--- a/prj.devmgr/Delphi12Athens/mr.devmgr.dpk
+++ b/prj.devmgr/Delphi12Athens/mr.devmgr.dpk
@@ -31,10 +31,9 @@ package mr.devmgr;
requires
rtl,
- vcl;
-// spring.core,
-// mr.dpgrtl,
-// mr.jtag;
+ vcl,
+ mr.jtag,
+ spring.base;
contains
mr.drv in '..\..\src.devmgr\drv\mr.drv.pas',
@@ -66,6 +65,8 @@ contains
m.eeprom in '..\..\src.devmgr\dev\usb\trinity\modules\eeprom\m.eeprom.pas',
m.eeprom.types in '..\..\src.devmgr\dev\usb\trinity\modules\eeprom\m.eeprom.types.pas',
m.cfg in '..\..\src.devmgr\dev\usb\trinity\modules\cfg\m.cfg.pas',
- m.cfg.types in '..\..\src.devmgr\dev\usb\trinity\modules\cfg\m.cfg.types.pas';
+ m.cfg.types in '..\..\src.devmgr\dev\usb\trinity\modules\cfg\m.cfg.types.pas',
+ mr.drv.usb.notifier in '..\..\src.devmgr\drv\usb\mr.drv.usb.notifier.pas',
+ mr.drv.trinity in '..\..\src.devmgr\drv\usb\mr.drv.trinity.pas';
end.
diff --git a/prj.devmgr/Delphi12Athens/mr.devmgr.dproj b/prj.devmgr/Delphi12Athens/mr.devmgr.dproj
index 3b0445c..d4687a7 100644
--- a/prj.devmgr/Delphi12Athens/mr.devmgr.dproj
+++ b/prj.devmgr/Delphi12Athens/mr.devmgr.dproj
@@ -60,7 +60,7 @@
mr_devmgr
1033
CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
- .270
+ .290
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
@@ -85,7 +85,6 @@
false
true
mr Device Manager for USB devices
- .290
false
@@ -102,6 +101,8 @@
+
+
@@ -132,6 +133,8 @@
+
+
Base
@@ -168,7 +171,7 @@
-
+
mr.devmgr.bpl
true
diff --git a/src.devmgr/dev/mr.dev.pas b/src.devmgr/dev/mr.dev.pas
index 360f0e3..e103f09 100644
--- a/src.devmgr/dev/mr.dev.pas
+++ b/src.devmgr/dev/mr.dev.pas
@@ -5,9 +5,9 @@ uses
mr.drv;
type
- TDevice = class(TInterfacedObject)
+ TDevice = class
protected
- fDriver: TDriver;
+ fDriver : TDriver;
public
procedure Open; virtual; abstract;
diff --git a/src.devmgr/dev/usb/trinity/modules/lcd/m.lcd.types.pas b/src.devmgr/dev/usb/trinity/modules/lcd/m.lcd.types.pas
index d4f9e83..33efc3e 100644
--- a/src.devmgr/dev/usb/trinity/modules/lcd/m.lcd.types.pas
+++ b/src.devmgr/dev/usb/trinity/modules/lcd/m.lcd.types.pas
@@ -14,7 +14,7 @@ type
procedure Cls;
procedure GotoXY( x,y: word);
procedure putc( const c: AnsiChar);
-// procedure puts( const s: AnsiString);
+ procedure puts( const s: AnsiString);
end;
implementation
diff --git a/src.devmgr/dev/usb/trinity/mr.trinity.hex.pas b/src.devmgr/dev/usb/trinity/mr.trinity.hex.pas
index 5a3e9d3..a1f90b3 100644
--- a/src.devmgr/dev/usb/trinity/mr.trinity.hex.pas
+++ b/src.devmgr/dev/usb/trinity/mr.trinity.hex.pas
@@ -429,7 +429,7 @@ begin
// blk.Address;
// blk.BlockLength;
s := Format('%3d %4.4x-%4.4x (%4.4x)'#13, [i,blk.Address,blk.Address+blk.BlockLength, blk.BlockLength]);
- writeln(s);
+// writeln(s);
INC(i);
end;
diff --git a/src.devmgr/dev/usb/trinity/mr.trinity.pas b/src.devmgr/dev/usb/trinity/mr.trinity.pas
index d3407fa..24285c6 100644
--- a/src.devmgr/dev/usb/trinity/mr.trinity.pas
+++ b/src.devmgr/dev/usb/trinity/mr.trinity.pas
@@ -41,7 +41,7 @@ type
// -----------------------------------------------------------------------------------
// TTrinity
// -----------------------------------------------------------------------------------
- TTrinity = class (TUsbDevice, ITrinity, IIIC, ILCD, ILED, IEEPROM, IJTAG, ICFG)
+ TTrinity = class (TUsbDevice)
protected
fCaps : TCapabilities;
fCaps64 : Int64;
@@ -76,17 +76,17 @@ type
fModCFG : ICFG;
fModIIC : IIIC;
fModEPR : IEEPROM;
- fModJTAG : IJTAG;
+ fModJTG : IJTAG;
fModLCD : ILCD;
fModLED : ILED;
- protected
- property cfg : ICFG read fModCFG implements ICFG;
- property iic : IIIC read fModIIC implements IIIC;
- property eeprom : IEEPROM read fModEPR implements IEEPROM;
- property jtag : IJTAG read fModJTAG implements IJTAG;
- property lcd : ILCD read fModLCD implements ILCD;
- property led : ILED read fModLED implements ILED;
+ public
+ property cfg : ICFG read fModCFG;
+ property iic : IIIC read fModIIC;
+ property eeprom : IEEPROM read fModEPR;
+ property jtag : IJTAG read fModJTG;
+ property lcd : ILCD read fModLCD;
+ property led : ILED read fModLED;
// ----------------------------------------------------------------------
// construction / destruction
@@ -159,12 +159,12 @@ begin
fPipe0Class := TTrinityPipe0;
- fModCFG := TmodCFG .Create( self);
- fModIIC := TmodIIC .Create( self);
- fModEPR := TmodEEPROM .Create( self);
- fModLCD := TmodLCD .Create( self);
- fModLED := TmodLED .Create( self);
- fModJTAG := TmodJTAG .Create( self);
+ fModCFG := TmodCFG .Create( self);
+ fModIIC := TmodIIC .Create( self);
+ fModEPR := TmodEEPROM .Create( self);
+ fModLCD := TmodLCD .Create( self);
+ fModLED := TmodLED .Create( self);
+ fModJTG := TmodJTAG .Create( self);
end;
// ================================================================================================
@@ -172,11 +172,16 @@ end;
// ================================================================================================
procedure TTrinity.BeforeDestruction;
begin
+ fModCFG := nil;
+ fModIIC := nil;
+ fModEPR := nil;
+ fModLCD := nil;
+ fModLED := nil;
+ fModJTG := nil;
+
inherited
end;
-
-
function TTrinity.Capabilities: TCapabilities;
begin
result := fCaps
@@ -244,6 +249,7 @@ begin
fCaps64 := PInt64(@buf)^;
fCaps := DecodeCapabilities(fCaps64);
end
+
end
end;
diff --git a/src.devmgr/dev/usb/trinity/mr.trinity.types.pas b/src.devmgr/dev/usb/trinity/mr.trinity.types.pas
index 79e13a9..5993186 100644
--- a/src.devmgr/dev/usb/trinity/mr.trinity.types.pas
+++ b/src.devmgr/dev/usb/trinity/mr.trinity.types.pas
@@ -86,7 +86,7 @@ begin
if cap in caps then
begin
if result <> '' then
- result := result +',';
+ result := result +', ';
case cap of
capSER : result := result +'SER';
@@ -99,9 +99,7 @@ begin
capLCD2 : result := result +'LCD2';
end;
- end;
-
-
+ end
end;
end.
diff --git a/src.devmgr/drv/mr.drv.pas b/src.devmgr/drv/mr.drv.pas
index 370f617..72c791f 100644
--- a/src.devmgr/drv/mr.drv.pas
+++ b/src.devmgr/drv/mr.drv.pas
@@ -3,7 +3,11 @@ unit mr.drv;
interface
type
- TDriver = class abstract( TInterfacedObject)
+ TDriver = class abstract
+ protected
+ class var
+ fInterfaceGuid : string;
+
protected
fDeviceHandle : THandle;
fDevicePath : string;
@@ -13,8 +17,11 @@ type
procedure Close; virtual; abstract;
public
- property DevicePath : string read fDevicePath;
- property DeviceHandle : THandle read fDeviceHandle;
+ class property InterfaceGUID: string read fInterfaceGuid;
+
+ public
+ property DevicePath : string read fDevicePath;
+ property DeviceHandle : THandle read fDeviceHandle;
end;
TDriverClass = class of TDriver;
diff --git a/src.devmgr/drv/usb/mr.drv.trinity.pas b/src.devmgr/drv/usb/mr.drv.trinity.pas
new file mode 100644
index 0000000..368e9e6
--- /dev/null
+++ b/src.devmgr/drv/usb/mr.drv.trinity.pas
@@ -0,0 +1,24 @@
+unit mr.drv.trinity;
+
+interface
+uses
+ mr.drv.usb.winusb;
+
+type TTrinityDriver = class (TWinUsbDriver)
+ class constructor CreateClass;
+end;
+
+
+implementation
+uses
+ mr.dev.manager;
+
+class constructor TTrinityDriver.CreateClass;
+begin
+ fInterfaceGUID := '{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}';
+end;
+
+initialization
+ RegisterDriver( TTrinityDriver);
+
+end.
diff --git a/src.devmgr/drv/usb/mr.drv.usb.notifier.pas b/src.devmgr/drv/usb/mr.drv.usb.notifier.pas
new file mode 100644
index 0000000..c4999d2
--- /dev/null
+++ b/src.devmgr/drv/usb/mr.drv.usb.notifier.pas
@@ -0,0 +1,188 @@
+unit mr.drv.usb.notifier;
+
+interface
+uses
+ System.Classes,
+ Winapi.Windows,
+ Winapi.Messages,
+ mr.drv.usb;
+
+const
+ DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
+
+ DBT_DEVICEARRIVAL = $8000; // system detected a new device
+ DBT_DEVICEQUERYREMOVE = $8001;
+ DBT_DEVICEQUERYREMOVEFAILED= $8002;
+ DBT_DEVICEREMOVEPENDING = $8003;
+ DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
+ DBT_DEVICETYPESPECIFIC = $8005;
+
+
+
+
+type
+ TusbNotifyEvent = procedure( APath: string; ADriverClass: TUsbDriverClass) of object;
+
+ PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
+ DEV_BROADCAST_HDR = packed record
+ dbch_size : DWORD;
+ dbch_devicetype: DWORD;
+ dbch_reserved : DWORD;
+ end;
+
+ PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
+ DEV_BROADCAST_DEVICEINTERFACE = record
+ dbcc_size : DWORD;
+ dbcc_devicetype: DWORD;
+ dbcc_reserved : DWORD;
+ dbcc_classguid : TGUID;
+ dbcc_name : char;
+ end;
+
+type
+ TusbNotifier = class
+ private
+ fDeviceInterface : string;
+ fDriverClass : TUsbDriverClass;
+ fNotifyHandle : HDEVNOTIFY;
+ FWindowHandle : HWND;
+
+ FOnUSBArrival : TusbNotifyEvent;
+ FOnUSBRemove : TusbNotifyEvent;
+
+ procedure WndProc(var Msg: TMessage);
+ function USBRegister: Boolean;
+
+ protected
+ procedure WMDeviceChange(var Msg: TMessage); dynamic;
+
+ public
+ constructor Create( ADeviceInterface: string; ADriverClass: TUsbDriverClass);
+ destructor Destroy; override;
+
+ public
+ property OnUSBArrival : TusbNotifyEvent read FOnUSBArrival write FOnUSBArrival;
+ property OnUSBRemove : TusbNotifyEvent read FOnUSBRemove write FOnUSBRemove;
+
+ property DeviceInterface: string read fDeviceInterface;
+ end;
+
+implementation
+uses
+ Vcl.Forms,
+ System.SysUtils;
+
+{ TusbNotifier }
+
+// ================================================================================================
+// constructor
+//
+// '{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}' [trinity.inf]
+// ================================================================================================
+constructor TusbNotifier.Create( ADeviceInterface: string; ADriverClass: TUsbDriverClass);
+begin
+ inherited Create;
+
+ fDeviceInterface := ADeviceInterface;
+ fDriverClass := ADriverClass;
+ fWindowHandle := AllocateHWnd(WndProc);
+
+ UsbRegister
+end;
+
+// ================================================================================================
+// destructor
+// ================================================================================================
+destructor TusbNotifier.Destroy;
+begin
+ if fNotifyHandle <> nil then
+ UnregisterDeviceNotification( fNotifyHandle);
+
+ DeallocateHWnd( fWindowHandle);
+ inherited
+end;
+
+// ================================================================================================
+// UsbRegister
+// ================================================================================================
+function TusbNotifier.USBRegister: Boolean;
+var
+ dbi : DEV_BROADCAST_DEVICEINTERFACE;
+ size : Integer;
+
+begin
+ size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
+
+ ZeroMemory(@dbi, Size);
+
+ dbi.dbcc_size := Size;
+ dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
+ dbi.dbcc_classguid := StringToGUID( fDeviceInterface);
+ dbi.dbcc_reserved := 0;
+ dbi.dbcc_name := #0;
+
+ fNotifyHandle := RegisterDeviceNotification( fWindowHandle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
+
+ result := fNotifyHandle <> nil
+end;
+
+// ================================================================================================
+// WndProc
+// ================================================================================================
+procedure TusbNotifier.WndProc(var Msg: TMessage);
+begin
+ if Msg.Msg = WM_DEVICECHANGE then
+ begin
+ try
+ WMDeviceChange(Msg)
+
+ except
+ Application.HandleException(Self)
+ end
+ end
+
+ else
+ Msg.Result := DefWindowProc( fWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam)
+end;
+
+// ================================================================================================
+// WM Device Change
+// ================================================================================================
+procedure TusbNotifier.WMDeviceChange(var Msg: TMessage);
+var
+ devType : Integer;
+ devHdr : PDevBroadcastHdr;
+
+begin
+ if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
+ begin
+ devHdr := PDevBroadcastHdr( Msg.lParam);
+ devType := devHdr^.dbch_devicetype;
+
+ if devType = DBT_DEVTYP_DEVICEINTERFACE then
+ begin // USB Device
+ var x := PDevBroadcastDeviceInterface( Msg.LParam);
+ var p := PChar( @x.dbcc_name);
+ var s := '';
+
+ while p^ <> #0 do
+ begin
+ s := s + p^;
+ INC(p)
+ end;
+
+ if Msg.wParam = DBT_DEVICEARRIVAL then
+ begin
+ if Assigned( fOnUSBArrival) then
+ FOnUSBArrival( s, fDriverClass)
+ end
+
+ else begin
+ if Assigned( fOnUSBRemove) then
+ FOnUSBRemove( s, fDriverClass)
+ end
+ end
+ end
+end;
+
+end.
diff --git a/src.devmgr/drv/usb/mr.drv.usb.pas b/src.devmgr/drv/usb/mr.drv.usb.pas
index c7089be..ec22a01 100644
--- a/src.devmgr/drv/usb/mr.drv.usb.pas
+++ b/src.devmgr/drv/usb/mr.drv.usb.pas
@@ -16,7 +16,6 @@ type
TScanCallback = reference to procedure( DevicePath: string);
-
TUsbDeviceInfo = class
private
fDriverClass : TUsbDriverClass;
@@ -41,27 +40,14 @@ type
IUsbDriverMap = IDictionary;
-
-
-
TAnsiStringList = TList;
TList = spring.Collections.IList;
- TUsbDriver = class abstract(TDriver, IUsbDriver)
+ TUsbDriver = class abstract(TDriver)
public
class procedure Scan( ScanCallback: TScanCallback); virtual; abstract;
- public
- class procedure ParseInstanceId( InstanceId : string;
- var VendorID : word;
- var ProductID : word;
- var Location : string;
- var Description : string);
-
- protected
- class var fDriverID: TGUID;
-
protected
fVendorID : word;
fProductID : word;
@@ -138,6 +124,8 @@ type
implementation
uses
mr.dev.usb,
+ mr.dev.manager,
+ System.Win.Registry,
System.SysUtils;
{ TUsbDriver }
@@ -160,7 +148,7 @@ begin
fDevicePath := DevicePath;
fDeviceSpeed := LowSpeed;
- ParseInstanceId( fDevicePath, fVendorID, fProductID, fLocation, fDescription);
+ ParseDevicePath( fDevicePath, fVendorID, fProductID, fLocation, fDescription);
end;
// @@@: INTERNALS +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -172,57 +160,6 @@ end;
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-// ================================================================================================
-// parse instance id
-// ================================================================================================
-class procedure TUsbDriver.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;
-
- VendorId := StrToInt('$'+Copy( id, 5, 4));
- ProductId := StrToInt('$'+Copy( id, 14, 4));
- Location := loc;
- Description := dsc;
-end;
{ TUsbDeviceInfo }
@@ -244,7 +181,7 @@ begin
fDevicePath := DevicePath;
fDriverClass := DriverClass;
- DriverClass.ParseInstanceId( fDevicePath, fVendorID, fProductID, fLocation, fDescription)
+ ParseDevicePath( fDevicePath, fVendorID, fProductID, fLocation, fDescription)
end;
// ================================================================================================
diff --git a/src.devmgr/drv/usb/mr.drv.usb.types.pas b/src.devmgr/drv/usb/mr.drv.usb.types.pas
index d3a13db..d823bd8 100644
--- a/src.devmgr/drv/usb/mr.drv.usb.types.pas
+++ b/src.devmgr/drv/usb/mr.drv.usb.types.pas
@@ -7,7 +7,7 @@ uses
const
// Standard request codes (btw not used)
CTRL_GET_STATUS = 0;
- CTRL_CLEAR_FEATURE = 1;
+ CTRL_CLR_FEATURE = 1;
CTRL_SET_FEATURE = 3;
CTRL_SET_ADDRESS = 5;
CTRL_GET_DESCRIPTOR = 6;
@@ -109,8 +109,8 @@ type
// -----------------------------------------------------------------------------------
PusbTransferSizeInfo = ^TusbTransferSizeInfo;
TusbTransferSizeInfo = packed record
- EndpointAddress : byte;
- TransferSize : cardinal;
+ EndpointAddress : byte;
+ TransferSize : cardinal;
end;
{$Z4}
@@ -140,9 +140,11 @@ type
1: (
SetupDat : array [2..7] of byte;
);
+
end;
+
type
IUsbDriver = interface
['{786E9A46-F7FE-4A8C-8BB8-563AB8C51BD5}']
diff --git a/src.devmgr/drv/usb/mr.drv.usb.winusb.pas b/src.devmgr/drv/usb/mr.drv.usb.winusb.pas
index 9598d51..66d1d00 100644
--- a/src.devmgr/drv/usb/mr.drv.usb.winusb.pas
+++ b/src.devmgr/drv/usb/mr.drv.usb.winusb.pas
@@ -9,16 +9,11 @@ uses
type
TWinUsbInterfaceHandle = THandle;
-
-
TWinUsbDriver = class( TUsbDriver)
public
class procedure Scan( ScanCallback: TScanCallback); override;
-
-
-
protected
fWinUsbHandle : TWinUsbInterfaceHandle;
@@ -36,10 +31,14 @@ type
function GetAssociatedInterface
(
InterfaceIndex : byte;
- var InterfaceHandle): boolean; override;
+ var InterfaceHandle
+ ): boolean; override;
- function QueryInterfaceSettings( AlternateSettingNumber : byte;
- var AlternateSettingDescriptor : TUsbAlternateSettingDescriptor): boolean; override;
+ function QueryInterfaceSettings
+ (
+ AlternateSettingNumber : byte;
+ var AlternateSettingDescriptor : TUsbAlternateSettingDescriptor
+ ): boolean; override;
function QueryPipe
(
@@ -91,9 +90,6 @@ type
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
-
-
-
end;
implementation
@@ -243,17 +239,17 @@ end;
procedure TWinUsbDriver.BeforeDestruction;
begin
Close;
+
+ fWinUsbHandle := INVALID_HANDLE_VALUE;
+ fDeviceHandle := INVALID_HANDLE_VALUE;
+
inherited;
end;
// ================================================================================================
// Open
//
-// Note:
-// fDevicePath is in the form:
-// 'USB\VID_04B4&PID_8613\6&26c545a4&0&1#Cypress FX2
-//
-// it must be converted into:
+// DevicePath must be in the form of:
// \\?\USB#VID_04B4&PID_8613#6&26c545a4&0&1#{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}
// ================================================================================================
procedure TWinUsbDriver.Open;
@@ -270,13 +266,14 @@ begin
// Prepare device path
// ---------------------------------------------------------------
// strip device description
- i := Pos('#', path);
+{ i := Pos('#', path);
if i > 0 then
path := Copy( path, 1, i-1);
path := ReplaceStr(path,'\','#');
- path := '\\?\'+path+'#'+GuidToString(fDriverID);
+ path := '\\?\'+path+'#'+fInterfaceGuid;
+}
// ---------------------------------------------------------------
// open
@@ -546,9 +543,9 @@ var
s : string;
begin
- dsc := CreateComObject( CLSID_FunctionDiscovery) as IFunctionDiscovery;
-
try
+ dsc := CreateComObject( CLSID_FunctionDiscovery) as IFunctionDiscovery;
+
cat := FCTN_CATEGORY_PNP;
hr := dsc.GetInstanceCollection(cat, nil, true, fcts);
@@ -562,18 +559,14 @@ begin
begin
if 'WinUSB' = propv.pwszVal then
begin
+ // \\?\USB#VID_04B4&PID_8613#6&26c545a4&0&1#{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}
+
props.GetValue( PKEY_Device_InstanceId, propv);
- s := propv.pwszVal;
- props.GetValue( PKEY_Device_DeviceDesc, propv);
- s := s +'#'+ propv.pwszVal;
+ s := StringReplace( propv.pwszVal, '\', '#', [rfReplaceAll]);
+ s := Uppercase('\\?\' +s +'#' +fInterfaceGuid);
- ScanCallback( s);
-
-// if Map.ContainsKey( s) then
-// Map.Remove( s);
-//
-// Map.Add( s, TUsbDeviceInfo.Create(s, self))
+ ScanCallback( s)
end
end
end
@@ -635,9 +628,8 @@ initialization
// The device path must look like this:
// \\?\USB#VID_04B4&PID_8613#6&26c545a4&0&1#Cypress-FX2
// --------------------------------------------------------------------------------
- TWinUsbDriver.fDriverID := StringToGuid('{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}');
-
- RegisterDriver( TWinUsbDriver);
+// TWinUsbDriver.fDriverID := StringToGuid('{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}');
+// RegisterDriver( TWinUsbDriver);
end;
diff --git a/src.devmgr/mr.dev.manager.pas b/src.devmgr/mr.dev.manager.pas
index fe0c0ba..ed77f18 100644
--- a/src.devmgr/mr.dev.manager.pas
+++ b/src.devmgr/mr.dev.manager.pas
@@ -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.