// Hiermit kann man erreichen, dass verschiedene Laufwerke nicht mehr
// im Windows-Explorer (Arbeitsplatz, SendTo) angezeigt werden.
// Eingelegte CDs z.B. werden aber vom Betriebssytem trotzdem erkannt.

// Getestet mit D4 unter XP

uses registry, math; 
 
const 
  RootKey = HKEY_LOCAL_MACHINE; 
  schluessel = 
    '\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer'; 
  Wert = 'NoDrives'; 
 
function auslesen: string; 
var 
  Reg: TRegistry; 
  dw: DWord; 
  x: integer; 
begin 
  dw := 0; 
  result := ''; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := RootKey; 
    if Reg.OpenKey(schluessel, false) then 
      dw := Reg.ReadInteger(Wert); 
    if dw > 0 then begin 
      for x := 0 to 25 do 
        if (dw and (1 shl x)) > 0 then 
          result := result + chr(x + 65) + ',' + #32; 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function alleEinblenden: boolean; 
var 
  Reg: TRegistry; 
begin 
  result := false; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := RootKey; 
    if Reg.OpenKey(schluessel, true) then begin 
      Reg.WriteInteger(Wert, 0); 
      result := true; 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function ausblenden(lw: string): boolean; 
var 
  Reg: TRegistry; 
  tsl: TStringlist; 
  x: integer; 
  dw: longint; 
  b: byte; 
begin 
  result := false; 
  tsl := TStringlist.create; 
  Reg := TRegistry.Create; 
  try 
    dw := 0; 
    tsl.commatext := ansiuppercase(stringreplace(lw, ';', ',', 
      [rfreplaceall])); 
    for x := 0 to tsl.count - 1 do begin 
      b := ord(trim(tsl[x])[1]) - 65; 
      if b in [0..25] then 
        dw := dw or trunc(power(2, b)); 
    end; 
    if dw > 0 then begin 
      Reg.RootKey := RootKey; 
      if Reg.OpenKey(schluessel, true) then begin 
        Reg.WriteInteger(Wert, dw); 
        result := true; 
      end; 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
    tsl.free; 
  end; 
end; 
 
// ------ Beispielaufrufe --------------------- 
 
// anzeigen, welche Laufwerke ausgeblendet sind 
procedure TForm1.Button7Click(Sender: TObject); 
var s: string; 
begin 
  s := auslesen; 
  if s = '' then s := 'keine Laufwerke ausgeblendet' 
  else s := 'ausgeblendet: ' + copy(s, 1, length(s) - 2); 
  showmessage(s); 
end; 
 
// Laufwerke A:, B: und D: ausblenden 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  if ausblenden('a:,B, D:\') then 
    showmessage('Sie sollten jetzt den Rechner neu starten') 
  else showmessage('Es ist ein Fehler aufgetreten'); 
end; 
 
// jetzt nur noch Laufwerk A: ausblenden 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  if ausblenden('A:') then 
    showmessage('Sie sollten jetzt den Rechner neu starten') 
  else showmessage('Es ist ein Fehler aufgetreten'); 
end; 
 
// Laufwerk E: zusätzlich ausblenden 
procedure TForm1.Button10Click(Sender: TObject); 
var s: string; 
begin 
  s := auslesen; 
  if ausblenden(s + 'E') then 
    showmessage('Sie sollten jetzt den Rechner neu starten') 
  else showmessage('Es ist ein Fehler aufgetreten'); 
end; 
 
// alle Laufwerke wieder einblenden 
procedure TForm1.Button11Click(Sender: TObject); 
begin 
  if alleEinblenden then 
    showmessage('Sie sollten jetzt den Rechner neu starten') 
  else showmessage('Es ist ein Fehler aufgetreten'); 
end;

 


Zugriffe seit 6.9.2001 auf Delphi-Ecke