// Laufwerk A wird formatiert.
// Querverweis:
den Dialog zum Formatieren aufrufen


// Getestet mit D4 unter XP

function FormatiereA: Integer; 
var 
  Datei: string; 
  sl: TStringlist; 
  StartupInfo: TStartupInfo; 
  ProcessInfo: TProcessInformation; 
  SektorenProCluster, BytesProSektor, FreieCluster, ClusterInsgesamt: DWord; 
begin 
  screen.cursor := crHourGlass; 
  try 
    Datei := '~.tmp'; 
    sl := TStringlist.create; 
    sl.add(''); 
    sl.add(''); 
    sl.add('n'); 
    sl.savetofile(Datei); 
    sl.free; 
    StartupInfo.cb := SizeOf(TStartupInfo); 
    zeromemory(@StartupInfo, SizeOf(TStartupInfo)); 
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW; 
    StartupInfo.wShowWindow := SW_HIDE; 
    if CreateProcess(nil, PChar('cmd.exe /c format A: < ' + Datei), nil, nil, 
      false, 0, nil, nil, StartupInfo, ProcessInfo) 
      then begin 
      repeat 
        application.processmessages; 
      until 
        WaitForSingleObject(ProcessInfo.hProcess, Infinite) <> WAIT_TIMEOUT; 
    end else begin 
      DeleteFile(Datei); 
      screen.cursor := crDefault; 
      Result := -1; 
      exit; 
    end; 
    CloseHandle(ProcessInfo.hThread); 
    CloseHandle(ProcessInfo.hProcess); 
    if GetDiskFreeSpace('A:', SektorenProCluster, BytesProSektor, 
      FreieCluster, ClusterInsgesamt) then 
      Result := (1457664 - FreieCluster * SektorenProCluster * BytesProSektor) 
        div BytesProSektor else Result := -1; 
  except 
    Result := -1; 
  end; 
  DeleteFile(Datei); 
  screen.cursor := crDefault; 
end; 
 
procedure TForm1.Button8Click(Sender: TObject); 
var 
  i: integer; 
  s: string; 
begin 
  i := formatiereA; 
  case i of 
   -1: s := 'Formatieren fehlgeschlagen'; 
    0: s := 'OK'; 
  else s := inttostr(i) + ' schadhafte Sektoren'; 
  end; 
  showmessage(s); 
end;




 

Zugriffe seit 6.9.2001 auf Delphi-Ecke