Событие подключения флешки

[MaTBeu]

Хм, а вы не подумали, что нужно аттачится к драйверу, чтобы получить это сообщение?

[Showy]

Сообщение от MaTBeu

Хм, а вы не подумали, что нужно аттачится к драйверу, чтобы получить это сообщение?

А зачем? если и так словить можно

[kiloz]

Держите вкусности... не самое элегантное решение, но времени для красивостей в свое время не было

...

const
   setupapi = 'SetupApi.dll';

...

TForm1 = class(TForm)
   ....
   procedure WMDeviceChange(var Msg: TMessage); message 
   ...

...

function SetupDiGetClassDevsA(ClassGuid: PGUID; Enumerator: PChar; hwndParent: 
  HWND; Flags: DWORD): HDEVINFO; stdcall; external setupapi;
function SetupDiEnumDeviceInfo(DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; 
  DeviceInfoData: PSP_DEVINFO_DATA): boolean; stdcall; external setupapi;
function SetupDiDestroyDeviceInfoList(DeviceInfoSet: HDEVINFO): boolean; 
  stdcall; external setupapi;
function CM_Get_Parent(pdnDevInst: PDWORD; dnDevInst: DWORD; 
  ulFlags: DWORD): DWORD; stdcall; external setupapi;
function CM_Get_Device_ID_Size(pulLen: PDWORD; dnDevInst: DWORD; 
  ulFlags: DWORD): DWORD; stdcall; external setupapi;
function CM_Get_Device_IDA(dnDevInst: DWORD; Buffer: PChar; 
  BufferLen: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi;
function CM_Locate_DevNodeA(pdnDevInst: PDWORD; pDeviceID: PChar; 
  ulFlags: DWORD): DWORD; stdcall; external setupapi;
function CM_Request_Device_EjectA(dnDevInst: DWORD; pVetoType: Pointer; 
  pszVetoName: PChar; ulNameLength: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi;

...

function IsUSBDevice(DevInst: DWORD): boolean;
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;
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_IDA(DevInst, ID, IDLen, 0) <> 0) or (not CompareMem(ID, PChar('USBSTOR'), 7)) then
begin
 FreeMemory(ID);
 exit;
end;
FreeMemory(ID);
result := true;
end;

procedure EjectUSB();
const
GUID_DEVCLASS_DISKDRIVE: TGUID = (D1: $4D36E967; D2: $E325; D3: $11CE; D4: ($BF, $C1, $08, $00, $2B, $E1, $03, $18));
var
hDevInfoSet: HDEVINFO;
DevInfo: SP_DEVINFO_DATA;
i: Integer;
Parent: DWORD;
VetoName: PChar;
begin
DevInfo.cbSize := sizeof(SP_DEVINFO_DATA);
hDevInfoSet := SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2);
if hDevInfoSet = INVALID_HANDLE_VALUE then exit;
i := 0;
while (SetupDiEnumDeviceInfo(hDevInfoSet, i, @DevInfo)) do
begin
 if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(@Parent, DevInfo.DevInst, 0) = 0) then
  begin
   VetoName := GetMemory(260);
   if (CM_Request_Device_EjectA(Parent, nil, VetoName, 260, 0) <> 0) then
    begin
     if (CM_Locate_DevNodeA(@Parent, VetoName, 0) <> 0) then
      begin
       FreeMemory(VetoName);
       continue;
      end;
     FreeMemory(VetoName);
     if (CM_Request_Device_EjectA(Parent, nil, nil, 0, 0) <> 0) then continue;
    end;
   FreeMemory(VetoName);
   break;
  end;
 inc(i);
end;
SetupDiDestroyDeviceInfoList(hDevInfoSet);
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004;  // device is gone
var
  myMsg: string;
begin
  inherited;
  if PermDisable then exit;
  if (tmpDisable) and (Msg.wParam=DBT_DEVICEARRIVAL) then tmpDisable:=false
    else
  case Msg.wParam of
    DBT_DEVICEARRIVAL: Begin 
                                     myMsg  := 'CD inserted!';
                                    Inc(Count);
                                    {EjectUSB()}
                                    ShowAlert(True); 
                                 End;
    DBT_DEVICEREMOVECOMPLETE: Begin 
                                                    myMsg := 'CD removed!';
                                                    if Count<>0 then Dec(Count); 
                                                    ShowAlert(False); 
                                                  End;
  end;
end;

...

(вроди еще модуль нужно подключить mmsystem)


Кто решит задачку элегантнее - прошу поделиться, интересно уже для себя

[raxp]

делюсь... эти темы уже были
1
2

и на основе SetupApi...