From cb039a3035a2d77daf6766754b0e51326e6843fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=B3ka=20Mikl=C3=B3s?= Date: Thu, 8 Jan 2026 19:04:51 +0100 Subject: [PATCH] Rework --- prj.devmgr/Delphi12Athens/mr.devmgr.dpk | 11 +- prj.devmgr/Delphi12Athens/mr.devmgr.dproj | 9 +- src.devmgr/dev/mr.dev.pas | 4 +- .../usb/trinity/modules/lcd/m.lcd.types.pas | 2 +- src.devmgr/dev/usb/trinity/mr.trinity.hex.pas | 2 +- src.devmgr/dev/usb/trinity/mr.trinity.pas | 40 +- .../dev/usb/trinity/mr.trinity.types.pas | 6 +- src.devmgr/drv/mr.drv.pas | 13 +- src.devmgr/drv/usb/mr.drv.trinity.pas | 24 + src.devmgr/drv/usb/mr.drv.usb.notifier.pas | 188 ++++++ src.devmgr/drv/usb/mr.drv.usb.pas | 73 +- src.devmgr/drv/usb/mr.drv.usb.types.pas | 8 +- src.devmgr/drv/usb/mr.drv.usb.winusb.pas | 56 +- src.devmgr/mr.dev.manager.pas | 625 ++++++++++++------ 14 files changed, 723 insertions(+), 338 deletions(-) create mode 100644 src.devmgr/drv/usb/mr.drv.trinity.pas create mode 100644 src.devmgr/drv/usb/mr.drv.usb.notifier.pas 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.