// 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;
|