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:
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.