Bloqueando puerto USB con Lista Blanca y Negra

[hectorlg2023]

Buenas tardes.
Tengo que realizar un programa para bloquear mis puertos USB de dispositivos de almacenamientos, ya he leído varios webs y otras en búsqueda de información, pero todo es muy absoluto, encontré una aplicación que se llama USB Lock RP, y me gustaría saber como poder hacer algo así, y si existe algún componente que me permita en delphi hacer lo que quiero. Quiero tratar de hacerlo en delphi.
Algún consejo o código que me ayude. Gracias de antemano.

[Casimiro Notevi]

No lo he probado, pero prueba esto a ver:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  GUID_DEVINTERFACE_USB: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  DIF_PROPERTYCHANGE = $12;

function SetupDiSetClassInstallParams(DeviceInfoSet: HDEVINFO;
  DeviceInfoData: PSP_DEVINFO_DATA; ClassInstallParams: PSP_CLASSINSTALL_HEADER;
  ClassInstallParamsSize: DWORD): BOOL; stdcall; external 'Setupapi.dll' name 'SetupDiSetClassInstallParamsW';

function SetupDiCallClassInstaller(InstallFunction: DI_FUNCTION;
  DeviceInfoSet: HDEVINFO; DeviceInfoData: PSP_DEVINFO_DATA): BOOL; stdcall;
  external 'Setupapi.dll' name 'SetupDiCallClassInstaller';

procedure DisableUSB;
var
  DeviceInfoSet: HDEVINFO;
  DeviceInfoData: SP_DEVINFO_DATA;
  ClassInstallParams: TSPPropChangeParams;
begin
  DeviceInfoSet := SetupDiGetClassDevs(@GUID_DEVINTERFACE_USB, nil, 0, DIGCF_PRESENT);
  if DeviceInfoSet <> INVALID_HANDLE_VALUE then
  begin
    try
      ZeroMemory(@DeviceInfoData, SizeOf(SP_DEVINFO_DATA));
      DeviceInfoData.cbSize := SizeOf(SP_DEVINFO_DATA);

      if SetupDiEnumDeviceInfo(DeviceInfoSet, 0, DeviceInfoData) then
      begin
        ZeroMemory(@ClassInstallParams, SizeOf(TSPPropChangeParams));
        ClassInstallParams.ClassInstallHeader.cbSize := SizeOf(TSPPropChangeParams);
        ClassInstallParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
        ClassInstallParams.Scope := DICS_FLAG_GLOBAL;
        ClassInstallParams.StateChange := DICS_DISABLE;

        if not SetupDiSetClassInstallParams(DeviceInfoSet, @DeviceInfoData,
          @ClassInstallParams.ClassInstallHeader, SizeOf(TSPPropChangeParams)) then
        begin
          ShowMessage('Error calling SetupDiSetClassInstallParams');
        end
        else
        begin
          if not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, DeviceInfoSet, @DeviceInfoData) then
          begin
            ShowMessage('Error calling SetupDiCallClassInstaller');
          end;
        end;
      end
      else
      begin
        ShowMessage('Error enumerating device information');
      end;
    finally
      SetupDiDestroyDeviceInfoList(DeviceInfoSet);
    end;
  end
  else
  begin
    ShowMessage('Error getting device information set');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DisableUSB;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Puedes realizar tareas de limpieza aquí si es necesario
end;

end.