unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    DeviceTreeView: TTreeView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    DeviceClassesList:TStringList;
    procedure AddAllDevices;
    procedure AddDevices(aNode:TTreeNode;aGUID:TGUID);
    procedure OnDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}  


procedure TForm1.AddAllDevices;
var
  _i:DWORD;
  Res:CONFIGRET;
  GUID: PGUID;
  Buffer: array [0..1023] of CHAR;
  BufSize: DWORD;
  Node:TTreeNode;
begin
  DeviceClassesList:=TStringList.Create;
  _i:=0;
  repeat
    GetMem(GUID, SizeOf(TGUID));
    Res := CM_Enumerate_Classes(_i, GUID^, 0);
    if Res <> CR_NO_SUCH_VALUE then
    begin
      SetupDiGetClassDescription(GUID^, @Buffer[0], Length(Buffer), BufSize);
      DeviceClassesList.AddObject(Pchar(@Buffer[0]), TObject(GUID));
    end;
    Inc(_i);
  until Res = CR_NO_SUCH_VALUE;

  for _i:=0 to DeviceClassesList.Count-1 do
   begin
    Node:=DeviceTreeView.Items.AddChild(nil,DeviceClassesList.Strings[_i]);
    GUID := PGUID(DeviceClassesList.Objects[_i]);
    AddDevices(Node,GUID^);
   end;
end;

function GetDeviceName(PnPHandle: HDEVINFO; const DevData: TSPDevInfoData): string;
var
  BytesReturned: DWORD;
  RegDataType: DWORD;
  Buffer: array [0..256] of CHAR;
begin
  BytesReturned := 0;
  RegDataType := 0;
  Buffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_FRIENDLYNAME,
    RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
  Result := Buffer;
  if Result<>'' then exit;
  BytesReturned := 0;
  RegDataType := 0;
  Buffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_DEVICEDESC,
    RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
  Result:=Buffer;
end;

procedure TForm1.AddDevices(aNode: TTreeNode; aGUID: TGUID);
var
  PnPHandle: HDEVINFO;
  DevData: TSPDevInfoData;
  RES: LongBool;
  Devn: Integer;
  _DN,_PN:ULONG;
begin
  PnPHandle := SetupDiGetClassDevs(@aGUID, nil, 0, DIGCF_PRESENT);
  if PnPHandle = INVALID_HANDLE_VALUE then  Exit;

  Devn := 0;
  repeat
   DevData.cbSize := SizeOf(DevData);
   RES := SetupDiEnumDeviceInfo(PnPHandle, Devn, DevData);     
   if (RES) and (_DN<>DN_ROOT_ENUMERATED) then
    begin
     DeviceTreeView.Items.AddChild(aNode, GetDeviceName(PnPHandle, DevData));
     Inc(Devn);
    end;
   if Devn=0 then
    begin
     DeviceTreeView.Items.Delete(aNode);
     break;
    end;
  until not RES;
  SetupDiDestroyDeviceInfoList(PnPHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AddAllDevices;
end;




function DWORDtoDiskNames(val:DWORD):string;
var
  _i: integer;
begin
  Result:='';
  for _i := 0 to 25 do
   begin
    if ((val mod 2)=1) then Result:=result+ chr(_i + 65);
    val:=val shr 1;
   end;
end;


procedure TForm1.OnDeviceChange(var Msg: TMessage);
begin

end;



procedure TForm1.FormCreate(Sender: TObject);
var
  NF:TDEV_BROADCAST_DEVICEINTERFACE;
begin
  NF.dbcc_size:=sizeof(TDEV_BROADCAST_DEVICEINTERFACE);
  NF.dbcc_devicetype:=DBT_DEVTYP_DEVICEINTERFACE;

  RegisterDeviceNotification(Handle,@NF,DEVICE_NOTIFY_ALL_INTERFACE_CLASSES);
end;

procedure EnableNetDevice(aState:boolean;index:integer);
var
  NetPnPHandle:HDEVINFO;
  PCHP:TSPPropChangeParams;
  DeviceData:TSPDevInfoData;
begin
  NetPnPHandle:=SetupDiGetClassDevs(@GUID_DEVCLASS_NET, 0, 0, DIGCF_PRESENT);
  if NetPnPHandle=INVALID_HANDLE_VALUE then exit;

  DeviceData.cbSize:=sizeof(TSPDevInfoData);
  SetupDiEnumDeviceInfo(NetPnPHandle, index, DeviceData);

  PCHP.ClassInstallHeader.cbSize:=sizeof(TSPClassInstallHeader);

  if SetupDiSetClassInstallParams(NetPnPHandle,@DeviceData,@PCHP,sizeof(TSPPropChangeParams)) then
   begin
    PCHP.ClassInstallHeader.cbSize := sizeof(TSPClassInstallHeader);
    PCHP.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
    PCHP.Scope := DICS_FLAG_CONFIGSPECIFIC;
    if aState then
     PCHP.StateChange := DICS_ENABLE
              else
     PCHP.StateChange := DICS_DISABLE;
    SetupDiSetClassInstallParams(NetPnPHandle,@DeviceData,@PCHP,sizeof(TSPPropChangeParams));
    SetupDiCallClassInstaller(DIF_PROPERTYCHANGE,NetPnPHandle,@DeviceData);
   end;
  DeviceData.cbSize := sizeof(TSPDevInfoData);
  SetupDiDestroyDeviceInfoList(NetPnPHandle);
end;

function CompareMem(p1, p2: Pointer; len: DWORD): boolean;
var
  i: DWORD;
begin
  result := false;
  if len = 0 then exit;
  for i := 0 to len-1 do
   if PByte(DWORD(p1) + i)^ <> PByte(DWORD(p2) + i)^ then exit;
  result := true;
end;

function IsUSBDevice(DevInst: DWORD): boolean;  
var
  IDLen: DWORD;
  ID: PChar;
begin
  result := false;
  if (CM_Get_Device_ID_Size(IDLen, DevInst, 0) <> 0) or (IDLen = 0) then exit;
  inc(IDLen);
  ID := GetMemory(IDLen);
  if ID = nil then exit;
  if (CM_Get_Device_ID(DevInst, ID, IDLen, 0) <> 0) or (not CompareMem(ID, PChar('USBSTOR'), 7)) then
   begin
    FreeMemory(ID);
    exit;
   end;
  FreeMemory(ID);
  result := true;
end;

procedure RemoveDrive(index:integer);
var
  DrivesPnPHandle: HDEVINFO;
  DevInfo: SP_DEVINFO_DATA;
  i: Integer;
  Parent: DWORD;
  VetoName:array[0..MAX_PATH] of char;
begin
  DevInfo.cbSize := sizeof(SP_DEVINFO_DATA);
  DrivesPnPHandle := SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2);
  if DrivesPnPHandle = INVALID_HANDLE_VALUE then exit;

  if SetupDiEnumDeviceInfo(DrivesPnPHandle, index, DevInfo) then
   begin
    if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(Parent, DevInfo.DevInst, 0) = CR_SUCCESS)
     then
      begin
       CM_Request_Device_Eject(Parent, nil, @VetoName, MAX_PATH, 0);
       if VetoName='' then
        ShowMessage('Устройство может быть извлечено')
                      else
        ShowMessage('Устройство не может быть извлечено');
      end
     else
      ShowMessage('Это не USB устройство');
   end;
  SetupDiDestroyDeviceInfoList(DrivesPnPHandle);
end;

end.

