// Hiermit kann man prüfen, ob man auf ein Laufwerk zugreifen kann
// (z.B. ob sich eine Diskette in A: oder eine CD im Brenner befindet),
// ohne dass die Fehlermeldung des Systems erscheint.

// Getestet mit D4 unter Win98

// Variante 1 --------------------

function DiskInLw(LW: Char): boolean; 
var 
  ErrorMode: word; 
begin 
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors); 
  try 
    result := Diskfree(Ord(upcase(LW)) - $40) > -1; 
  finally 
    SetErrorMode(ErrorMode); 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if not DiskInLw('A') then showmessage('Laufwerk nicht bereit'); 
end;
 
// Variante 2 -----------------------
function LWStatus(lw: string): Integer; 
var 
  sr: TSearchRec; 
begin 
  try 
    result := FindFirst(lw[1] + ':\*', faAnyfile, sr); 
    FindClose(sr); 
  except; 
    result := -1; 
  end; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
var s: string; 
begin 
  screen.cursor := crHourGlass; 
  case LWStatus('A:') of 
    0: s := 'Laufwerk enhält Daten'; 
    2, 18: s := 'Laufwerk ist leer'; 
    3, 15, 20: s := 'Laufwerk nicht gefunden'; 
    21, 26, 31, 1112: s := 'Laufwerk nicht bereit'; 
    -1: s := 'unerwarteter Fehler'; 
  else s := 'Laufwerk nicht formatiert'; 
  end; 
  screen.cursor := crDefault; 
  showmessage(s); 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke