unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    LogMemo: TMemo;
    Button3: TButton;
    Label1: TLabel;
    DrivesListBox: TListBox;
    Button7: TButton;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public   
    procedure OnDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}  



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;

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);
var
  MSGSTR:String;
begin
  if Msg.WParam=DBT_DEVICEARRIVAL then
   begin
    case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
     DBT_DEVTYP_DEVICEINTERFACE:
      LogMemo.Lines.Add('вставлен новый интерфейс: '+pchar(@PDEV_BROADCAST_DEVICEINTERFACE(Msg.LParam)^.dbcc_name[0])); 
    DBT_DEVTYP_VOLUME:
     begin
      MSGSTR:='новый диск'+MSGSTR;
      LogMemo.Lines.Add(MSGSTR+' '+DWORDtoDiskNames(PDEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask)+':');
     end;
    end;
   end;
  if Msg.WParam=DBT_DEVICEREMOVECOMPLETE then
   begin
    case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
     DBT_DEVTYP_DEVICEINTERFACE:
      LogMemo.Lines.Add('извлечён интерфейс: '+pchar(@PDEV_BROADCAST_DEVICEINTERFACE(Msg.LParam)^.dbcc_name[0]));
     DBT_DEVTYP_VOLUME:
      begin
       MSGSTR:='извлечён диск'+MSGSTR;
       LogMemo.Lines.Add(MSGSTR+' '+DWORDtoDiskNames(PDEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask)+':');
      end;
    end;
   end;
 if Msg.WParam=DBT_DEVNODES_CHANGED then
  begin
   LogMemo.Lines.Add('конфигурация изменена');
  end;
  Button6Click(nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  NF:TDEV_BROADCAST_DEVICEINTERFACE;
begin
  LogMemo.Clear;
  NF.dbcc_size:=sizeof(TDEV_BROADCAST_DEVICEINTERFACE);
  NF.dbcc_devicetype:=DBT_DEVTYP_DEVICEINTERFACE;
  RegisterDeviceNotification(Handle,@NF,DEVICE_NOTIFY_ALL_INTERFACE_CLASSES);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 LogMemo.Clear;
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;
  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;

procedure TForm1.FormShow(Sender: TObject);
begin
  Button6Click(nil);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  DrivePnPHandle: HDEVINFO;
  DeviceNumber:DWORD;
  DevData: TSPDevInfoData;
  DeviceInterfaceData: TSPDeviceInterfaceData;
  RES:BOOL;
begin
  DrivesListBox.Clear;
  DrivePnPHandle := SetupDiGetClassDevs(@GUID_DEVCLASS_DISKDRIVE, nil, 0, DIGCF_PRESENT);
  if DrivePnPHandle = INVALID_HANDLE_VALUE then  Exit;
  DeviceNumber := 0;
  repeat
   DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
   DevData.cbSize := SizeOf(TSPDevInfoData);
   RES := SetupDiEnumDeviceInfo(DrivePnPHandle, DeviceNumber, DevData);
   if (RES) then
    begin
     DrivesListBox.Items.Add(GetDeviceName(DrivePnPHandle, DevData));
     Inc(DeviceNumber);
    end;
  until not RES;
  SetupDiDestroyDeviceInfoList(DrivePnPHandle);
  DrivesListBox.Enabled:=true;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if DrivesListBox.ItemIndex<0 then exit;
  RemoveDrive(DrivesListBox.ItemIndex);
  DrivesListBox.Clear;
  DrivesListBox.Enabled:=false;
  Button6Click(nil);
end;

end.