Initial check in

2026-01-03 18:53:14 +01:00
commit b9305ab8af
36 changed files with 6720 additions and 0 deletions
@@ -0,0 +1,264 @@
+unit mr.dev.usb;
+
+interface
+uses
+   mr.dev,
+   mr.dev.usb.configuration,
+   mr.dev.usb.pipe0,
+   mr.dev.usb.pipe,
+   mr.drv.usb,
+   mr.drv.usb.types;
+
+type
+
+   TUsbDevice = class abstract(TDevice)
+      protected
+         fPipe0Class       : TPipe0Class;
+         fPipe0            : TPipe0;
+
+      protected
+         fUsbDriver        : TUsbDriver;
+         fDeviceDescriptor : TUsbDeviceDescriptor;
+         fUsbConfiguration : TUsbConfiguration;
+
+      protected
+         function    GetVendorID    : word;
+         function    GetProductID   : word;
+         function    GetLocation    : string;
+         function    GetDescription : string;
+         function    GetDevicePath  : string;
+
+         function    GetPipe( id: byte): TPipe;
+
+      protected
+         procedure   ReadConfiguration;
+
+      public
+         procedure   Open;    override;
+         procedure   Close;   override;
+
+      public
+         procedure   AfterConstruction; override;
+         procedure   BeforeDestruction; override;
+
+      public
+         property    VendorID    : word      read  GetVendorID;
+         property    ProductID   : word      read  GetProductID;
+
+         property    Location    : string    read  GetLocation;
+         property    Description : string    read  GetDescription;
+         property    DevicePath  : string    read  GetDevicePath;
+
+      public
+         property    Pipe0          : TPipe0 read  fPipe0;
+         property    Pipes[id:byte] : TPipe  read  GetPipe;
+   end;
+
+   TUsbDeviceClass = class of TUsbDevice;
+
+implementation
+uses
+   SysUtils,
+   mr.dev.manager;
+
+{ TUsbDevice }
+
+// @@@: Construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                  Construction / destruction
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// After Construction
+// ================================================================================================
+procedure TUsbDevice.AfterConstruction;
+begin
+   inherited;
+
+   if fDriver is TUsbDriver
+      then fUsbDriver := fDriver as TUsbDriver
+      else fUsbDriver := nil
+end;
+
+// ================================================================================================
+// Before Destruction
+// ================================================================================================
+procedure TUsbDevice.BeforeDestruction;
+begin
+   Close;
+
+   FreeAndNil( fDriver);
+
+   fUsbDriver := nil;
+   inherited
+end;
+
+
+// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                           Interface
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+// ================================================================================================
+// Open
+// ================================================================================================
+procedure TUsbDevice.Open;
+var
+   len  : cardinal;
+   info : TUsbPipeInformation;
+
+begin
+   if Assigned(fUsbDriver) then
+   begin
+      fUsbDriver.Open;
+
+      // ------------------------------------------------------------
+      // Get device descriptor
+      // ------------------------------------------------------------
+      fUsbDriver.GetDescriptor(  DSCR_DEVICE,
+                                 0, 0,
+                                 @fDeviceDescriptor,
+                                 sizeof( TUsbDeviceDescriptor),
+                                 len);
+
+      // ------------------------------------------------------------
+      // Read device configuration
+      // ------------------------------------------------------------
+      fUsbConfiguration    := TUsbConfiguration.Create(fUsbDriver);
+
+      // ------------------------------------------------------------
+      // Create Control Pipe
+      // ------------------------------------------------------------
+      info.PipeType        := ptControl;
+      info.PipeId          := 0;
+      info.MaxPacketSize   := 0;
+      info.Interval        := 0;
+
+      if Assigned( fPipe0Class)
+         then fPipe0 := fPipe0Class.Create(fUsbDriver, info)
+         else fPipe0 := nil
+   end;
+end;
+
+// ================================================================================================
+// Close
+// ================================================================================================
+procedure TUsbDevice.Close;
+begin
+   FreeAndNil( fPipe0);
+   FreeAndNil( fUsbConfiguration);
+
+   if Assigned( fUsbDriver) then
+      fUsbDriver.Close;
+end;
+
+
+// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                           Internals
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// Read configuration
+// ================================================================================================
+procedure TUsbDevice.ReadConfiguration;
+var
+   cfg: TUsbConfigurationDescriptor;
+   len: cardinal;
+
+begin
+   if Assigned(fUsbDriver) then
+   begin
+      // ------------------------------------------------------------
+      // Get configuration
+      // ------------------------------------------------------------
+      len := 0;
+      fUsbDriver.GetDescriptor(  DSCR_CONFIGURATION,
+                                 0, 0,
+                                 @cfg,
+                                 sizeof( TUsbConfigurationDescriptor),
+                                 len);
+   end
+end;
+
+
+
+// @@@: Property handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                       Property handlers
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+// ================================================================================================
+// get device path
+// ================================================================================================
+function TUsbDevice.GetDevicePath: string;
+begin
+   assert(fUsbDriver <> nil);
+   result := fDriver.DevicePath
+end;
+
+// ================================================================================================
+// get vendor ID (VID)
+// ================================================================================================
+function TUsbDevice.GetVendorID: word;
+begin
+   assert(fUsbDriver <> nil);
+   result := fUsbDriver.VendorID
+end;
+
+
+// ================================================================================================
+// get product ID (PID)
+// ================================================================================================
+function TUsbDevice.GetProductID: word;
+begin
+   assert(fUsbDriver <> nil);
+   result := fUsbDriver.ProductID
+end;
+
+// ================================================================================================
+// get location
+// ================================================================================================
+function TUsbDevice.GetLocation: string;
+begin
+   assert(fUsbDriver <> nil);
+   result := fUsbDriver.Location
+end;
+
+// ================================================================================================
+// get description
+// ================================================================================================
+function TUsbDevice.GetDescription: string;
+begin
+   assert(fUsbDriver <> nil);
+   result := fUsbDriver.Description
+end;
+
+// ================================================================================================
+// get pipe by ID
+// ================================================================================================
+function TUsbDevice.GetPipe(id: byte): TPipe;
+begin
+   assert( fUsbDriver <> nil);
+   result := fUsbConfiguration.Pipes[id]
+end;
+
+end.