This commit is contained in:
2026-01-08 19:04:51 +01:00
parent b9305ab8af
commit cb039a3035
14 changed files with 723 additions and 338 deletions
+24
View File
@@ -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.
+188
View File
@@ -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.
+5 -68
View File
@@ -16,7 +16,6 @@ type
TScanCallback = reference to procedure( DevicePath: string);
TUsbDeviceInfo = class
private
fDriverClass : TUsbDriverClass;
@@ -41,27 +40,14 @@ type
IUsbDriverMap = IDictionary<string, TUsbDeviceInfo>;
TAnsiStringList = TList<AnsiString>;
TList = spring.Collections.IList<string>;
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;
// ================================================================================================
+5 -3
View File
@@ -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}']
+24 -32
View File
@@ -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;