controls/drivebox/DBTUtils.inc

   1 // DBTUtils.inc - small version DBT.pas, only DEVICE CHANGE & Utils.\r
   2 // Used units: ShellApi, MMSystem;\r
   3 \r
   4 const\r
   5   WM_DEVICECHANGE = $0219;\r
   6 \r
   7 type\r
   8   _DEV_BROADCAST_HDR = record // Device broadcast header\r
   9     dbch_size: DWORD;\r
  10     dbch_devicetype: DWORD;\r
  11     dbch_reserved: DWORD;\r
  12   end;\r
  13   DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;\r
  14   PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;\r
  15 \r
  16 // The following messages are for WM_DEVICECHANGE. The immediate list\r
  17 // is for the wParam. ALL THESE MESSAGES PASS A POINTER TO A STRUCT\r
  18 // STARTING WITH A DWORD SIZE AND HAVING NO POINTER IN THE STRUCT.\r
  19 \r
  20 const\r
  21   DBT_DEVICEARRIVAL        = $8000; // system detected a new device\r
  22   DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone\r
  23 \r
  24   DBT_DEVTYP_VOLUME = $00000002; // logical volume\r
  25 \r
  26   DBTF_MEDIA = $0001; // media comings and goings\r
  27   DBTF_NET   = $0002; // network volume\r
  28 \r
  29 type\r
  30   _DEV_BROADCAST_VOLUME = record\r
  31     dbcv_size: DWORD;\r
  32     dbcv_devicetype: DWORD;\r
  33     dbcv_reserved: DWORD;\r
  34     dbcv_unitmask: DWORD;\r
  35     dbcv_flags: WORD;\r
  36   end;\r
  37   DEV_BROADCAST_VOLUME  = _DEV_BROADCAST_VOLUME;\r
  38   PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;\r
  39 \r
  40 (* Finds the first valid drive letter from a mask of drive letters *)\r
  41 \r
  42 function FirstDriveFromMask(unitmask: Longint): Char;\r
  43 var\r
  44   DriveLetter: Shortint;\r
  45 begin\r
  46   DriveLetter := Byte('a');\r
  47   while (unitmask and 1) = 0 do\r
  48   begin\r
  49     unitmask := unitmask shr 1;\r
  50     Inc(DriveLetter);\r
  51   end;\r
  52   Result := Char(DriveLetter);\r
  53 end;\r
  54 \r
  55 (* Ãîòîâíîñòü äðàéâà *)\r
  56 \r
  57 function DriveReady(const Drv: Char): Boolean;\r
  58 var\r
  59   NotUsed: DWORD;\r
  60 begin\r
  61   Result := GetVolumeInformation(PChar(Drv + ':\'), nil, 0, nil,\r
  62     NotUsed, NotUsed, nil, 0);\r
  63 end;\r
  64 \r
  65 (* Ìåòêà äèñêà *)\r
  66 \r
  67 function GetLabelDisk(const Drv: Char; const VolReal: Boolean): string;\r
  68 \r
  69   function DisplayName(const Drv: Char): string;\r
  70   var\r
  71     SFI: TSHFileInfo;\r
  72   begin\r
  73     FillChar(SFI, SizeOf(SFI), 0);\r
  74     SHGetFileInfo(PChar(Drv + ':\'), 0, SFI, SizeOf(SFI), SHGFI_DISPLAYNAME);\r
  75     Result := SFI.szDisplayName;\r
  76 \r
  77     // Â Win9x, Me - íåò ìåòêè äèñêà -> #32 + (x:)\r
  78     // Â WinNT 5.x - íåò ìåòêè äèñêà -> Íàçâàíèå óñòðîéñòâà + #32 + (x:)\r
  79     if Pos('(', Result) <> 0 then\r
  80       SetLength(Result, Pos('(', Result) - 2);\r
  81   end;\r
  82 \r
  83 var\r
  84   WinVer: Byte;\r
  85   DriveType, NotUsed: DWORD;\r
  86   Buf: array [0..MAX_PATH - 1] of Char;\r
  87 begin\r
  88   Result := '';\r
  89   WinVer := LOBYTE(LOWORD(GetVersion));\r
  90   DriveType := GetDriveType(PChar(Drv + ':\'));\r
  91 \r
  92   if (WinVer <= 4) and (DriveType <> DRIVE_REMOVABLE) or VolReal then\r
  93   begin // Win9x, Me, NT <= 4.0\r
  94     Buf[0] := #0;\r
  95     GetVolumeInformation(PChar(Drv + ':\'), Buf, DWORD(SizeOf(Buf)), nil,\r
  96       NotUsed, NotUsed, nil, 0);\r
  97     Result := Buf;\r
  98 \r
  99     if VolReal and (WinVer >= 5) and (Result <> '') and\r
 100        (DriveType <> DRIVE_REMOVABLE) then // Win2k, XP è âûøå\r
 101       Result := DisplayName(Drv)\r
 102     else if (Result = '') and (not VolReal) then\r
 103       Result := '<none>';\r
 104   end else\r
 105     Result := DisplayName(Drv);\r
 106 end;\r
 107 \r
 108 (* Îæèäàíèå èçìåíåíèÿ ìåòêè äèñêà *)\r
 109 \r
 110 procedure WaitLabelChange(const Drv: Char; const Str: string);\r
 111 var\r
 112   st1, st2: string;\r
 113 begin\r
 114   if GetLabelDisk(Drv, True) = '' then\r
 115     Exit;\r
 116   st1 := TrimLeft(Str);\r
 117   st2 := st1;\r
 118   while st1 = st2 do\r
 119     st2 := GetLabelDisk(Drv, FALSE);\r
 120 end;\r
 121 \r
 122 (* Çàêðûòü øòîðêó CD/DVD *)\r
 123 \r
 124 procedure CloseCD(const Drive: string);\r
 125 var\r
 126   OpenParms: MCI_OPEN_PARMS;\r
 127 begin\r
 128   FillChar(OpenParms, SizeOf(OpenParms), 0);\r
 129   OpenParms.lpstrDeviceType := 'CDAudio';\r
 130   OpenParms.lpstrElementName := PChar(Drive + ':');\r
 131   mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));\r
 132   mciSendCommand(OpenParms.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);\r
 133   mciSendCommand(OpenParms.wDeviceID, MCI_CLOSE, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));\r
 134 end;\r
 135 \r
 136 (* Èêîíêà äðàéâà *)\r
 137 \r
 138 function DriveIconSysIdx(const Path: string): Integer;\r
 139 var\r
 140   SFI: TSHFileInfo;\r
 141 begin\r
 142   SFI.iIcon := 0;\r
 143   SHGetFileInfo(PChar(Path), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);\r
 144   Result := SFI.iIcon;\r
 145 end;