1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93:
| unit Main;
interface
uses Windows, Messages, SysUtils, Classes, Forms, Controls, StdCtrls;
const DBT_DeviceArrival = $8000; const DBT_DeviceRemoveComplete = $8004; const DBTF_Media = $0001; const DBT_DevTyp_Volume = $0002; const DBTF_Net = $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;
type TForm1 = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); private public procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange; function LaufwerkErmitteln(pDBVol: PDevBroadcastVolume): string; end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMDeviceChange(var Msg: TMessage); var Laufwerk : String; begin case Msg.wParam of DBT_DeviceArrival: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then begin Laufwerk := LaufwerkErmitteln(PDevBroadcastVolume(Msg.lParam)); Label1.Caption := 'Verbindung zu Netzlaufwerk ' + Laufwerk + ' ist neu.'; end; DBT_DeviceRemoveComplete: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then begin Laufwerk := LaufwerkErmitteln(PDevBroadcastVolume(Msg.lParam)); Label1.Caption := 'Verbindung zu Netzlaufwerk ' + Laufwerk + ' wurde getrennt.'; end; end; end;
function TForm1.LaufwerkErmitteln(pDBVol: PDevBroadcastVolume): string; var Schleife : Byte; Maske : DWord; begin if (pDBVol^.dbcv_flags and DBTF_Net) = DBTF_Net then begin Maske := pDBVol^.dbcv_unitmask; for Schleife := 0 to 25 do begin if (Maske and 1) = 1 then Result := Char(Schleife + Ord('A')) + ':'; Maske := Maske Shr 1; end; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown := true; end;
end. |