unit Unit1;
interface
uses
Windows, Messages, Classes, Controls, Forms, StdCtrls, SysUtils, ExtCtrls;
type
PWmDeviceChange = ^TWmDeviceChange;
TWmDeviceChange =
packed record
Msg : UINT;
Event : WPARAM;
Data : LPARAM;
Result: LRESULT;
end;
type
PVolumeInfo = ^TVolumeInfo;
TVolumeInfo =
packed record
Type_ : UINT;
Name :
array [0..4095]
of Char;
Serial: DWORD;
end;
PVolumeInfoArray = ^TVolumeInfoArray;
TVolumeInfoArray =
array ['
C'..'
Z']
of TVolumeInfo;
type
TMainForm =
class(TForm)
Memo1: TMemo;
Button1: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure DefaultHandler(
var Message);
override;
procedure WmDeviceChange(
var Message: TWmDeviceChange);
message WM_DEVICECHANGE;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
WM_QUERY_CANCEL_AUTOPLAY: UINT;
VolumeInfos: TVolumeInfoArray;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
begin
WM_QUERY_CANCEL_AUTOPLAY := 0;
ZeroMemory(@VolumeInfos, SizeOf(VolumeInfos));
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
Memo1.Clear();
end;
////////////////////////////////////////////////////////////////////////////////
// AutoPlay
procedure TMainForm.DefaultHandler(
var Message);
begin
// Shell version >= 4.70, AutoPlay enabled, and Form1 is the foreground window
if (WM_QUERY_CANCEL_AUTOPLAY = 0)
then
WM_QUERY_CANCEL_AUTOPLAY := RegisterWindowMessage('
QueryCancelAutoPlay');
if (WM_QUERY_CANCEL_AUTOPLAY = TMessage(
Message).Msg)
then
begin
TMessage(
Message).Result := S_FALSE;
// S_OK = cancel AutoPlay
Memo1.Lines.Add('
[AutoPlay]');
end;
inherited;
end;
////////////////////////////////////////////////////////////////////////////////
// DeviceChange
procedure TMainForm.WmDeviceChange(
var Message: TWmDeviceChange);
const
DBT_DEVICEARRIVAL = $8000;
// system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004;
// device is gone
begin
case Message.Event
of
DBT_DEVICEARRIVAL:
Memo1.Lines.Add('
[DeviceChange] DBT_DEVICEARRIVAL');
DBT_DEVICEREMOVECOMPLETE:
Memo1.Lines.Add('
[DeviceChange] DBT_DEVICEARRIVAL');
else
Memo1.Lines.Add('
[DeviceChange] ' + IntToHex(
Message.Event, 8));
end;
Message.Result := LRESULT(TRUE);
// BROADCAST_QUERY_DENY = deny the request
inherited;
end;
////////////////////////////////////////////////////////////////////////////////
// Timer
procedure TMainForm.Timer1Timer(Sender: TObject);
var
PrevErrorMode: UINT;
RootPathName:
array [0..4]
of Char;
CurrentDrive: Char;
VolumeInfo: TVolumeInfo;
MaxCompLen: DWORD;
FSystFlags: DWORD;
begin
Timer1.Enabled := False;
PrevErrorMode := UINT(-1);
try
PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
SetErrorMode(PrevErrorMode
or SEM_FAILCRITICALERRORS);
RootPathName := '
_:\'#0;
for CurrentDrive := '
C'
to '
Z'
do // Char(Low|High(TVolumeInfo.Name))
begin
RootPathName[0] := CurrentDrive;
ZeroMemory(@VolumeInfo, SizeOf(VolumeInfo));
VolumeInfo.Type_ := GetDriveType(RootPathName);
GetVolumeInformation(RootPathName, VolumeInfo.
Name,
SizeOf(VolumeInfo.
Name)
div SizeOf(VolumeInfo.
Name[0]),
@VolumeInfo.Serial, MaxCompLen, FSystFlags,
nil, 0);
if (VolumeInfo.Type_ <> VolumeInfos[CurrentDrive].Type_)
or
(StrComp(VolumeInfo.
Name, VolumeInfos[CurrentDrive].
Name) <> 0)
or
(VolumeInfo.Serial <> VolumeInfos[CurrentDrive].Serial)
then
begin
Memo1.Lines.Add('
[Timer] ' + RootPathName + '
, ' + VolumeInfo.
Name +
'
, ' + IntToHex(VolumeInfo.Serial, 8));
end;
VolumeInfos[CurrentDrive] := VolumeInfo;
end;
finally
if (PrevErrorMode <> UINT(-1))
then
SetErrorMode(PrevErrorMode);
if (Timer1.Tag = 0)
then
Timer1.Enabled := True;
end;
end;