以下是代码片段：
Unit Test_Unit;
Interface
Uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
MMSystem; // MCI API使用库，用于控制光驱进出
Const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
DBT_DEVNODES_CHANGED = $0007;
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEQUERYREMOVE = $8001; // wants to remove, may fail
DBT_DEVICEQUERYREMOVEFAILED = $8002; // removal aborted
DBT_DEVICEREMOVEPENDING = $8003; // about to remove, still avail.
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVICETYPESPECIFIC = $8005; // type specific event
DBTF_MEDIA = $0001; // media comings and goings
DBTF_NET = $0002; // network volume
DBT_DEVTYP_OEM = $00000000; // oem-defined device type
DBT_DEVTYP_DEVNODE = $00000001; // devnode number
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBT_DEVTYP_PORT = $00000003; // serial, parallel
DBT_DEVTYP_NET = $00000004; // network resource
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
Type
PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = Packed Record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
End;
PDEV_BROADCAST_DEVICEINTERFACE = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = Record
dbcc_size: DWORD;
dbcc_devicetype: DWORD;
dbcc_reserved: DWORD;
dbcc_classguid: TGUID;
dbcc_name: short;
End;
PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
DEV_BROADCAST_VOLUME = Record
dbcv_size: DWORD;
dbcv_devicetype: DWORD;
dbcv_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
End;
PDEV_BROADCAST_OEM = ^DEV_BROADCAST_OEM;
DEV_BROADCAST_OEM = Record
dbco_size: DWORD;
dbco_devicetype: DWORD;
dbco_reserved: DWORD;
dbco_identifier: DWORD;
dbco_suppfunc: WORD;
End;
PDEV_BROADCAST_PORT = ^DEV_BROADCAST_PORT;
DEV_BROADCAST_PORT = Record
dbcp_size: DWORD;
dbcp_devicetype: DWORD;
dbcp_reserved: DWORD;
dbcp_name: Array[0..255] Of char;
End;
Type
TFrmTest = Class(TForm)
mmo1: TMemo;
Procedure FormCreate(Sender: TObject);
Procedure FormDestroy(Sender: TObject);
Private
{ Private declarations }
FWindowHandle: HWND;
Function MessageRegister: Boolean;
Procedure WndProc2(Var Msg: TMessage);
Function FirstDriveFromMask(um: Integer): String; // 根据掩码查找盘符
Public
{ Public declarations }
Procedure WMDeviceChange(Var Msg: TMessage); // 接收设备改变的消息
End;
Var
Implementation
{$R *.dfm}
Procedure TFrmTest.FormCreate(Sender: TObject);
Begin
FWindowHandle := AllocateHWnd(WndProc2);
MessageRegister;
End;
Procedure TFrmTest.WndProc2(Var Msg: TMessage);
Begin
If (Msg.Msg = WM_DEVICECHANGE) Then
Begin
Try
WMDeviceChange(Msg);
Except
// Application.HandleException(Self);
End;
End
Else
Msg.result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.lParam);
End;
Function TFrmTest.MessageRegister: Boolean;
Var
dbi : DEV_BROADCAST_DEVICEINTERFACE;
Size : Integer;
r : Pointer;
Begin
result := false;
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@dbi, Size);
dbi.dbcc_size := Size;
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
dbi.dbcc_reserved := 0;
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
dbi.dbcc_name := 0;
r := RegisterDeviceNotification(FWindowHandle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
If Assigned(r) Then
result := True;
End;
Procedure TFrmTest.WMDeviceChange(Var Msg: TMessage);
Var
lpdb : PDEV_BROADCAST_HDR;
lpdbv : PDEV_BROADCAST_VOLUME;
lpdbo : PDEV_BROADCAST_OEM;
lpdbp : PDEV_BROADCAST_PORT;
DeviceType : String; //设备类型，媒体设备，网络驱动器
DeviceAction : String; //设备动作
DeviceName : String; //设备磁盘名
MCIO : TMCI_Open_Parms;
Begin
Try
lpdb := PDEV_BROADCAST_HDR(Msg.lParam);
If Not Assigned(lpdb) Then Exit;
Case lpdb^.dbch_devicetype Of
DBT_DEVTYP_VOLUME:
Begin
lpdbv := PDEV_BROADCAST_VOLUME(lpdb);
DeviceName := IntToHex(lpdbv^.dbcv_unitmask, 8);
If Boolean(lpdbv^.dbcv_flags And DBTF_MEDIA) Then
Begin
DeviceType := '媒体设备 ';
End
Else
Begin
If Boolean(lpdbv^.dbcv_flags And DBTF_NET) Then
Begin
DeviceType := '网络驱动器 ';
End
Else
DeviceType := '未知设备类型 0x' + IntToHex(lpdbv^.dbcv_flags, 8) + ' ';
End;
DeviceName := FirstDriveFromMask(lpdbv^.dbcv_unitmask) + ':';
Case GetDriveType(PChar(DeviceName)) Of
DRIVE_UNKNOWN: DeviceType := DeviceType + '未知类型';
DRIVE_NO_ROOT_DIR: DeviceType := DeviceType + '根目录不存在';
DRIVE_REMOVABLE: DeviceType := DeviceType + '可移除';
DRIVE_FIXED: DeviceType := DeviceType + '不可移除';
DRIVE_REMOTE: DeviceType := DeviceType + '网络';
DRIVE_CDROM: DeviceType := DeviceType + 'CDROM';
DRIVE_RAMDISK: DeviceType := DeviceType + 'RAM';
End; // Case GetDriveType(PChar(DeviceName)) Of
End; // DBT_DEVTYP_VOLUME
DBT_DEVTYP_OEM:
Begin
DeviceType := 'OEM- or IHV-defined device type. ';
lpdbo := PDEV_BROADCAST_OEM(lpdb);
DeviceName := IntToHex(lpdbo^.dbco_identifier, 8);
End;
DBT_DEVTYP_PORT:
Begin
DeviceType := '端口设备（串并口） ';
lpdbp := PDEV_BROADCAST_PORT(lpdb);
DeviceName := lpdbp^.dbcp_name;
End;
End; // Case lpdb^.dbch_devicetype Of
Case Msg.WParam Of
DBT_DEVICEARRIVAL:
Begin
DeviceAction := '添加设备';
If policyIsControl = 1 Then // 不允许使用光驱则弹出
Begin
Try
MCIO.lpstrDeviceType := 'cdaudio';
MCIO.lpstrElementName := PChar(DeviceName);
MCIO.dwCallback := 0;
If mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT, LongInt(@MCIO)) = 0
Then
Begin
mciSendCommand(MCIO.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
End;
Finally
mciSendCommand(MCIO.wDeviceID, mci_Close, MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT,
LongInt(@MCIO));
End;
End;
End;
DBT_DEVICEREMOVECOMPLETE: DeviceAction := DeviceAction + '移除设备';
DBT_DEVNODES_CHANGED: DeviceAction := DeviceAction + '改变节点';
DBT_DEVICEQUERYREMOVE: DeviceAction := DeviceAction + '准备移除设备'; // wants to remove, may fail
DBT_DEVICEQUERYREMOVEFAILED: DeviceAction := DeviceAction + '取消移除设备'; // removal aborted
DBT_DEVICEREMOVEPENDING: DeviceAction := DeviceAction + '取消移除设备，设备正常';
// about to remove, still avail.
DBT_DEVICETYPESPECIFIC: DeviceAction := DeviceAction + '特殊事件'; // type specific event
End; // Case Msg.WParam Of
FrmTest.mmo1.Lines.Add('动作：' + DeviceAction + ' 类型:' + DeviceType + ' 盘符：' +
DeviceName);
If policyIsWatch = 1 Then
Begin
SendLog('$' + DeviceName + '$' + '动作：' + DeviceAction + ' 类型:' + DeviceType);
End;
Inherited;
Except
End;
End;
Function TFrmTest.FirstDriveFromMask(um: Integer): String;
Var
i : Integer;
Begin
result := '';
For i := 0 To 25 Do
Begin
If Boolean(um And 1) Then
result := result + char(Integer('A') + i);
um := um Shr 1;
End;
End;
Procedure TFrmTest.FormDestroy(Sender: TObject);
Begin
Try
DeallocateHWnd(FWindowHandle);
Inherited;
Except
End;
End;
End.
| 
