Обработать момент вставки и вытаскивания CD |
Previous Top Next |
Code: |
{ Some applications need to know when the user inserts or removes a compact disc or DVD from a CD-ROM drive without polling for media changes. Windows provide a way to notify these applications through the WM_DEVICECHANGE message. }
type TForm1 = class(TForm) private procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE; public
end;
{...}
implementation
{$R *.DFM}
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; case Msg.wParam of DBT_DEVICEARRIVAL: myMsg := 'CD inserted!'; DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!'; end; ShowMessage(myMsg); end;
{*********************************************}
// Advanced Code: // When the device is of type volume, then we can get some device specific // information, namely specific information about a logical volume. // by Juergen Kantz
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Button1: TButton; label1: TLabel; private procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange; { Private declarations } public { Public declarations } end;
const DBT_DeviceArrival = $8000; DBT_DeviceRemoveComplete = $8004; DBTF_Media = $0001; DBT_DevTyp_Volume = $0002;
type PDevBroadcastHdr = ^TDevBroadcastHdr; TDevBroadcastHdr = packed record dbcd_size: DWORD; dbcd_devicetype: DWORD; dbcd_reserved: DWORD; end;
type PDevBroadcastVolume = ^TDevBroadcastVolume; TDevBroadcastVolume = packed record dbcv_size: DWORD; dbcv_devicetype: DWORD; dbcv_reserved: DWORD; dbcv_unitmask: DWORD; dbcv_flags: Word; end;
var Form1: TForm1;
implementation
{$R *.dfm}
function GetDrive(pDBVol: PDevBroadcastVolume): string; var i: Byte; Maske: DWORD; begin if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then begin Maske := pDBVol^.dbcv_unitmask; for i := 0 to 25 do begin if (Maske and 1) = 1 then Result := Char(i + Ord('A')) + ':'; Maske := Maske shr 1; end; end; end;
procedure TForm1.WMDeviceChange(var Msg: TMessage); var Drive: string; begin case Msg.wParam of DBT_DeviceArrival: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then begin Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)); label1.Caption := 'CD inserted in Drive ' + Drive; end; DBT_DeviceRemoveComplete: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then begin Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)); label1.Caption := 'CD removed from Drive ' + Drive; end; end; end;
end. |
©Drkb::01413
Взято с сайта: http://www.swissdelphicenter.ch