Einzelnen Beitrag anzeigen

HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
961 Beiträge
 
Delphi 6 Professional
 
#27

AW: Windows-Bug mit bestimmter Netzlaufwerkskonstellation (*Herausforderung gesucht?*

  Alt 19. Aug 2015, 18:15
Hmm..

Mit meiner Test-Version kann ich dem Explorer mitteilen, das er ein angegebenes Laufwerk aus der Ansicht entfernt.
Das klappt sogar mit meinem Festplatten-Laufwerk D:.

Wieso Du Pointer auf eine Const machst und diese dann verändern willst ist mir schleierhaft ?!?!

Der folgende Code ist mit D6 erstellt und läuft unter Win 8.1.
Wenn der Explorer offen ist, kannste ihn dazu bringen, sogar das LW C: auszublenden. Mit einem F5 im Explorer ist es dann wieder da....

Edit:
Korrektur, das Ausblenden von C: mag der Explorer nicht und führt anschließend direkt ein F5 aus

Meine Funktionen GetDrive und GetDriveMask berücksichtigen hier nur jeweils ein Laufwerk.
In der Message kannst Du aber direkt auch alle Laufwerke ausblenden lassen, da die dbcv_unitmask alle von Laufwerke von A-Z auf einmal enthalten kann.

Delphi-Quellcode:
const
  DBT_DEVICEREMOVECOMPLETE = $8004;

  DBT_DEVTYP_VOLUME = $00000002;

  DBTF_MEDIA = $0001;
  DBTF_NET = $0002;

type
  PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
  DEV_BROADCAST_HDR = packed record
    dbch_size : DWORD;
    dbch_devicetype : DWORD;
    dbch_reserved : DWORD;
  end;

  PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
  DEV_BROADCAST_VOLUME = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: WORD;
  end;

function GetDrive(unitmask: DWORD): Char;
var
  i: Byte;
begin
  result := ' ';
  for i := 0 to 25 do begin
    if (unitmask and 1) = 1 then begin
      Result := Char(i + Ord('A'));
      break;
    end;
    unitmask := unitmask shr 1;
  end;
end;

function GetDriveMask(Drive: Char): DWORD;
begin
  result := 1 shl (ord(Drive) - ord('A'));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  DevVol: DEV_BROADCAST_VOLUME;
  sDrive: Char;
begin
  sDrive := Edit1.text[1];
  FillChar(DevVol,SizeOf(DEV_BROADCAST_VOLUME),0);
  DevVol.dbcv_size := SizeOf(DEV_BROADCAST_VOLUME);
  DevVol.dbcv_devicetype := DBT_DEVTYP_VOLUME;
  DevVol.dbcv_unitmask := GetDriveMask(sDrive);
  DevVol.dbcv_flags := DBTF_NET;
  SendMessage(HWND_BROADCAST, WM_DEVICECHANGE, DBT_DEVICEREMOVECOMPLETE, INTEGER(@DevVol));
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
begin
  if Msg.WParam = DBT_DEVICEREMOVECOMPLETE then begin
    if PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      ShowMessage(GetDrive(PDEV_BROADCAST_VOLUME(msg.LParam)^.dbcv_unitmask));
  end;
end;

Geändert von HolgerX (19. Aug 2015 um 18:19 Uhr)
  Mit Zitat antworten Zitat