Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias _
     "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function SHFormatDrive Lib "shell32" _
     (ByVal hWnd As Long, ByVal Drive As Long, ByVal _
     fmtID As Long, ByVal Options As Long) As Long

Const SHFMT_ID_DEFAULT = &HFFFF&
Const SHFMT_ID_360 = 3
Const SHFMT_ID_720 = 5

Const SHFMT_OPT_QUICK = 0
Const SHFMT_OPT_FULL = 1
Const SHFMT_OPT_SYSONLY = 2

Const DRIVE_CDROM = 5
Const DRIVE_FIXED = 3
Const DRIVE_NO_ROOT_DIR = 1
Const DRIVE_RAMDISK = 6
Const DRIVE_REMOTE = 4
Const DRIVE_REMOVABLE = 2
Const DRIVE_UNKNOWN = 0

Const SHFMT_ERROR = -1
Const SHFMT_CANCEL = -2
Const SHFMT_NOFORMAT = -3
Const SHFMT_NODRIVE = -4

Dim Harddisk As Boolean
Dim DriveType As Long

Private Sub Command1_Click()
  Dim FormatOption As Long
  Dim DriveNumber As Integer

  FormatOption = IIf(Check1.Value = 1, 0, 1)
  DriveNumber = (Asc(UCase(Drive1.Drive)) - 65)

  If Harddisk = True Then
    If MsgBox("Soll das Festplattenlaufwerk wirklich formatiert" _
       & " werden ?", vbYesNo, "Hinweis") = vbNo Then Exit Sub
  End If

  FormatDrive DriveNumber, FormatOption
End Sub

Private Sub Drive1_Change()
  DriveType = GetDriveType(UCase(Drive1.Drive))
  Harddisk = False

  Select Case DriveType
    Case DRIVE_REMOVABLE, DRIVE_FIXED
      Command1.Enabled = True
      If DriveType = DRIVE_FIXED Then Harddisk = True
    Case Else
      Command1.Enabled = False
  End Select
End Sub

Private Sub FormatDrive(DriveNumber As Integer, _
    FormatOption As Long)
  Dim Msg As String
  Dim RetVal As Long

  RetVal = SHFormatDrive(Me.hWnd, DriveNumber, _
    SHFMT_ID_DEFAULT, FormatOption)

  Select Case RetVal
     Case SHFMT_NODRIVE
       Msg = "Laufwerk ist nicht vorhanden!"
     Case SHFMT_NOFORMAT
       Msg = "Laufwerk konnte nicht formatiert werden!"
     Case SHFMT_CANCEL
       Msg = "Formatiervorgang wurde vorzeitig abgebrochen!"
     Case SHFMT_ERROR
       Msg = "Formatiervorgang konnte nicht fehlerfrei beendet"_
           & " werden!"
     Case Else
       Msg = "" 'Funktion wurde erfolgreich ausgeführt
  End Select

  If Msg <> "" Then
     MsgBox Msg, vbCritical + vbOKOnly, "Hinweis"
  End If
End Sub