1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:

unit blablabla;

interface

(*
 * The SHFormatDrive API provides access to the Shell
 *   format dialog. This allows apps which want to format disks
 *   to bring up the same dialog that the Shell does to do it.
 *
 *   This dialog is not sub-classable. You cannot put custom
 *   controls in it. If you want this ability, you will have
 *   to write your own front end for the DMaint_FormatDrive
 *   engine.
 *
 *   NOTE that the user can format as many diskettes in the specified
 *   drive, or as many times, as he/she wishes to. There is no way to
 *   force any specififc number of disks to format. If you want this
 *   ability, you will have to write your own front end for the
 *   DMaint_FormatDrive engine.
 *
 *   NOTE also that the format will not start till the user pushes the
 *   start button in the dialog. There is no way to do auto start. If
 *   you want this ability, you will have to write your own front end
 *   for the DMaint_FormatDrive engine.
 *
 *   PARAMETERS
 *
 *     hwnd    = The window handle of the window which will own the dialog
 *               NOTE that unlike SHCheckDrive, hwnd == NULL does not cause
 *               this dialog to come up as a "top level application" window.
 *               This parameter should always be non-null, this dialog is
 *               only designed to be the child of another window, not a
 *               stand-alone application.
 *     drive   = The 0 based (A: == 0) drive number of the drive to format
 *     fmtID   = The ID of the physical format to format the disk with
 *               NOTE: The special value SHFMT_ID_DEFAULT means "use the
 *                     default format specified by the DMaint_FormatDrive
 *                     engine". If you want to FORCE a particular format
 *                     ID "up front" you will have to call
 *                     DMaint_GetFormatOptions yourself before calling
 *                     this to obtain the valid list of phys format IDs
 *                     (contents of the PhysFmtIDList array in the
 *                     FMTINFOSTRUCT).
 *     options = There is currently only two option bits defined
 *
 *                SHFMT_OPT_FULL
 *                SHFMT_OPT_SYSONLY
 *
 *               The normal defualt in the Shell format dialog is
 *               "Quick Format", setting this option bit indicates that
 *               the caller wants to start with FULL format selected
 *               (this is useful for folks detecting "unformatted" disks
 *               and wanting to bring up the format dialog).
 *
 *               The SHFMT_OPT_SYSONLY initializes the dialog to
 *               default to just sys the disk.
 *
 *               All other bits are reserved for future expansion and
 *               must be 0.
 *
 *               Please note that this is a bit field and not a value
 *               and treat it accordingly.
 *
 *   RETURN
 *      The return is either one of the SHFMT_* values, or if the
 *      returned DWORD value is not == to one of these values, then
 *      the return is the physical format ID of the last succesful
 *      format. The LOWORD of this value can be passed on subsequent
 *      calls as the fmtID parameter to "format the same type you did

 *      last time".
 *
 *)

function SHFormatDrive(wnd: HWND; drive: UINT; fmtId: UINT;
  options: UINT): dword; stdcall;

//
// Special value of fmtID which means "use the default format"
//
const
  SHFMT_ID_DEFAULT    = $FFFF;

//
// Option bits for options parameter
//
  SHFMT_OPT_FULL      = $0001;
  SHFMT_OPT_SYSONLY   = $0002;

//
// Special return values. PLEASE NOTE that these are DWORD values.
//
  SHFMT_ERROR         = $FFFFFFFF;     // Error on last format, drive may be formatable
  SHFMT_CANCEL        = $FFFFFFFE;     // Last format was canceled
  SHFMT_NOFORMAT      = $FFFFFFFD;     // Drive is not formatable

implementation

const
  shell32 = 'shell32.dll';

function SHFormatDrive; external shell32 name 'SHFormatDrive';

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

uses
  blablabla;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SHFormatDrive(self.Handle,
    0 { für Laufwerk A, B = 1, C = 2, ... usw. },
    SHFMT_ID_DEFAULT,
    0 { oder SHFMT_OPT_FULL, s. Beschreibung }
  );
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:

function Diskette_formatieren(Laufwerk: String): Integer; 
var Befehl : String; 
    Datei : TextFile; 
    TempDateiName : Array [0..255] of Char; 
    TempVerzeichnis : Array [0..255] of Char; 
    StartupInfo : TStartupInfo; 
    ProcessInfo : TProcessInformation; 
    SektorenProCluster : Integer; 
    BytesProSektor : Integer; 
    FreieCluster : Integer; 
    ClusterInsgesamt : Integer; 
    Temp : Integer; 
begin 
  // Datei zum Beantworten der Abfragen von FORMAT.EXE im Temp-Verzeichnis anlegen. 
  GetTempPath(255, TempVerzeichnis); 
  GetTempFileName(TempVerzeichnis, 'TMP', 0, TempDateiName); 

  // Antwort-Datei erzeugen 
  AssignFile(Datei, TempDateiName); 
  Rewrite(Datei);             // Antwort-Datei erzeugen und öffnen 
  Writeln(Datei, #13#10);     // 1. Return ("Diskette einlegen ...") 
  Writeln(Datei, #13#10);     // 2. Return (Diskettenbezeichnung) 
  Writeln(Datei, 'n'#13#10);  // keine weitere Diskette 
  CloseFile(Datei);           // Datei schließen 

  // Befehlszeile zum Aufrufen von FORMAT.COM 
  // command.com /c  = automatisch nach Beendigung schließen 
  // format ...  /u  = unbedingt formatieren 
  // format ...  /c  = defekte Sektoren prüfen 
  Befehl := 'command.com /c format '+Laufwerk+' /u /c < '+TempDateiName; 

  // StartupInfo initialisieren. 
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0); 
  StartupInfo.cb := SizeOf(TStartupInfo); 

  // DOS-Fenster soll nicht angezeigt werden. 
  StartupInfo.dwFlags := StartF_UseShowWindow; 
  StartupInfo.wShowWindow := SW_Hide; 

  // Formatieren 
  if CreateProcess(nil, PChar(Befehl), nil, nil, 
                   False, 0, nil, 'c:\', 
                   StartupInfo, 
                   ProcessInfo) then begin 
    // Warten bis Format beendet ist. 
    WaitForSingleObject(ProcessInfo.hProcess, Infinite); 
    CloseHandle(ProcessInfo.hProcess); 
  end; 

  // Antwort-Datei wieder löschen 
  DeleteFile(TempDateiName); 

  // War das Formatieren erfolgreich? 
  if GetDiskFreeSpace(PChar(Laufwerk), SektorenProCluster, 
                      BytesProSektor, FreieCluster,  
                      ClusterInsgesamt) then begin            
    // Anzahl defekter Sektoren berechnen 
    Temp := FreieCluster * SektorenProCluster * BytesProSektor; 
    Result := (1457664 - Temp) div BytesProSektor; 
  end 
  else               
    // Diskette nicht eingelegt oder unformatiert 
    Result := - 1; 
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Diskette_formatieren('a');
end;					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Diskette_formatieren('a'); 
end;					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Diskette_formatieren('a:'); 
end;