DiskNotifier.pas
上传用户:wanyu_2000
上传日期:2021-02-21
资源大小:527k
文件大小:4k
源码类别:

DVD

开发平台:

Delphi

  1. {-----------------------------------------------------------------------------
  2.  Unit Name: DiskNotifier
  3.  Author:    Paul Fisher / Andrew Semack
  4.  Purpose:   Class for New Disk Insert notify
  5.  History:
  6. -----------------------------------------------------------------------------}
  7. {$WARN SYMBOL_DEPRECATED OFF}
  8. unit DiskNotifier;
  9. interface
  10. uses
  11.   Windows, Messages, SysUtils, Classes, Forms;
  12. type
  13.   PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
  14.   DEV_BROADCAST_HDR = packed record
  15.     dbch_size: DWORD;
  16.     dbch_devicetype: DWORD;
  17.     dbch_reserved: DWORD;
  18.   end;
  19.   PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
  20.   DEV_BROADCAST_DEVICEINTERFACE = record
  21.     dbcc_size: DWORD;
  22.     dbcc_devicetype: DWORD;
  23.     dbcc_reserved: DWORD;
  24.     dbcc_classguid: TGUID;
  25.     dbcc_name: short;
  26.   end;
  27.   PDevBroadcastVolume = ^TDevBroadcastVolume;
  28.   TDevBroadcastVolume = packed record
  29.     dbcv_size: DWORD;
  30.     dbcv_devicetype: DWORD;
  31.     dbcv_reserved: DWORD;
  32.     dbcv_unitmask: DWORD;
  33.     dbcv_flags: Word;
  34.   end;
  35.   TCDInsertDiskStatusEvent = procedure(DriveLetter : String) of object;
  36.   TCDRemoveDiskStatusEvent = procedure(DriveLetter : String) of object;
  37. const
  38.   DBT_DEVICEARRIVAL = $8000; // system detected a new device
  39.   DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
  40.   DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
  41.   DBTF_MEDIA = $0001;
  42.   DBT_DEVTYP_VOLUME = $0002;
  43. type
  44.   TDiskNotifier = class(TComponent)
  45.   private
  46.     FWindowHandle: HWND;
  47.     FOnNewDiskInserted: TCDInsertDiskStatusEvent;
  48.     FOnDiskRemoved : TCDRemoveDiskStatusEvent;
  49.     FHandle: pointer;
  50.     procedure WndProc(var Msg: TMessage);
  51.   protected
  52.     procedure WMDeviceChange(var Msg: TMessage); dynamic;
  53.   public
  54.     constructor Create(AOwner: TComponent); override;
  55.     destructor Destroy; override;
  56.   published
  57.     property OnDiskInserted : TCDInsertDiskStatusEvent read FOnNewDiskInserted write FOnNewDiskInserted;
  58.     property OnDiskRemoved : TCDRemoveDiskStatusEvent read FOnDiskRemoved write FOnDiskRemoved;
  59.   end;
  60. implementation
  61. constructor TDiskNotifier.Create(AOwner: TComponent);
  62. begin
  63.   inherited Create(AOwner);
  64.   FHandle := nil;
  65.   FWindowHandle := AllocateHWnd(WndProc);
  66. end;
  67. destructor TDiskNotifier.Destroy;
  68. begin
  69.   DeallocateHWnd(FWindowHandle);
  70.   inherited Destroy;
  71. end;
  72. procedure TDiskNotifier.WndProc(var Msg: TMessage);
  73. begin
  74.   if (Msg.Msg = WM_DEVICECHANGE) then
  75.   begin
  76.     try
  77.       WMDeviceChange(Msg);
  78.     except
  79.       Application.HandleException(Self);
  80.     end;
  81.   end
  82.   else
  83.     Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  84. end;
  85. function GetDrive(pDBVol: PDevBroadcastVolume): string;
  86. var
  87.   i: Byte;
  88.   Maske: DWORD;
  89. begin
  90.   if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  91.   begin
  92.     Maske := pDBVol^.dbcv_unitmask;
  93.     for i := 0 to 25 do
  94.     begin
  95.       if (Maske and 1) = 1 then
  96.         Result := Char(i + Ord('A'));
  97.       Maske := Maske shr 1;
  98.     end;
  99.   end;
  100. end;
  101. procedure TDiskNotifier.WMDeviceChange(var Msg: TMessage);
  102. var
  103.   devType: Integer;
  104.   Datos: PDevBroadcastHdr;
  105.   Drive: string;
  106. begin
  107.   if (Msg.wParam = DBT_DEVICEARRIVAL) then
  108.   begin
  109.     Datos := PDevBroadcastHdr(Msg.lParam);
  110.     devType := Datos^.dbch_devicetype;
  111.     if devType = DBT_DEVTYP_VOLUME then
  112.     begin
  113.         Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
  114.         if Assigned(FOnNewDiskInserted) then FOnNewDiskInserted(Drive);
  115.     end;
  116.   end;
  117.   if (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
  118.   begin
  119.     Datos := PDevBroadcastHdr(Msg.lParam);
  120.     devType := Datos^.dbch_devicetype;
  121.     if devType = DBT_DEVTYP_VOLUME then
  122.     begin
  123.         Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
  124.         if Assigned(FOnDiskRemoved) then FOnDiskRemoved(Drive);
  125.     end;
  126.   end;
  127. end;
  128. end.