Code aus Floppy.bas
Option Explicit
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal _
    hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As _
    Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, _
    lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias _
    "CreateFileA" (ByVal lpFileName As String, ByVal _
    dwDesiredAccess As Long, ByVal dwShareMode As Long, _
    lpSecurityAttributes As Any, ByVal dwCreationDisposition As _
    Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile _
    As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject _
    As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (lpAddress As _
    Any, ByVal dwSize As Long, ByVal flAllocationType As Long, _
    ByVal flProtect As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As _
    Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As _
    Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags _
    As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As _
    Long) As Long
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const Handle = 0
Private Const INVALID_HANDLE_VALUE = ((Handle) - 1)
Private Const FILE_DEVICE_FILE_SYSTEM As Long = &H9
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_ANY_ACCESS As Long = 0
Private Const CREATE_ALWAYS As Long = 2
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_READWRITE As Long = &H4
Private Const CREATE_NEW As Long = 1
Private Const LMEM_ZEROINIT As Long = &H40
Private Const FILE_READ_ACCESS As Long = (&H1)
Private Const FILE_WRITE_ACCESS As Long = (&H2)
Private Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type
Public Type DISK_GEOMETRY
  Cylinders As LARGE_INTEGER
  MediaType As MEDIA_TYPE
  TracksPerCylinder As Long
  SectorsPerTrack As Long
  BytesPerSector As Long
End Type
Public Enum MEDIA_TYPE
  Unknown
  F5_1Pt2_512
  F3_1Pt44_512
  F3_2Pt88_512
  F3_20Pt8_512
  F3_720_512
  F5_360_512
  F5_320_512
  F5_320_1024
  F5_180_512
  F5_160_512
  RemovableMedia
  FixedMedia
End Enum
Public Type FORMAT_PARAMETERS
  MediaType As MEDIA_TYPE
  StartCylinderNumber As Long
  EndCylinderNumber As Long
  StartHeadNumber As Long
  EndHeadNumber As Long
End Type
Public Sub ShowGeometry(d As String)
  Dim Drive As String, hDrive As Long, lpGeometry As DISK_GEOMETRY
    
    Drive = "\\.\" & d
    hDrive = CreateFile(Drive, GENERIC_READ Or GENERIC_WRITE, _
        FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, _
        OPEN_EXISTING, 0, ByVal 0)
    
    If hDrive = INVALID_HANDLE_VALUE Then
      Debug.Print "Fehler 1"
      CloseHandle hDrive
      End
    End If
    
    If Not LockVolume(hDrive) Then
      Debug.Print "Fehler 2"
      CloseHandle hDrive
      End
    End If
    
    If Not GetDiskGeometry(hDrive, lpGeometry) Then
      Debug.Print "Fehler 3"
      CloseHandle hDrive
      End
    End If
    
    PrintGeometry lpGeometry
    
    CloseHandle hDrive
End Sub
Public Function LockVolume(hDisk As Long) As Boolean
  Dim ReturnedByteCount As Long, FSCTL_LOCK_VOLUME As Long
    
    FSCTL_LOCK_VOLUME = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6, _
        METHOD_BUFFERED, FILE_ANY_ACCESS)
    
    LockVolume = DeviceIoControl(hDisk, FSCTL_LOCK_VOLUME, ByVal _
        0, 0, ByVal 0, 0, ReturnedByteCount, ByVal 0)
End Function
Public Function UnlockVolume(hDisk As Long) As Boolean
  Dim ReturnedByteCount As Long, FSCTL_UNLOCK_VOLUME As Long
    
    FSCTL_UNLOCK_VOLUME = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 7, _
        METHOD_BUFFERED, FILE_ANY_ACCESS)
    
    UnlockVolume = DeviceIoControl(hDisk, FSCTL_UNLOCK_VOLUME, 0, _
        0, 0, 0, ReturnedByteCount, 0)
End Function
Private Function CTL_CODE(lngDeviceType As Long, lngFunction As _
    Long, lngMethod As Long, lngAccess As Long) As Long
    CTL_CODE = ((lngDeviceType * (2 ^ 16)) Or (lngAccess * (2 ^ _
        14)) Or (lngFunction * (2 ^ 2)) Or lngMethod)
End Function
Public Function GetDiskGeometry(hDisk As Long, lpGeometry As _
    DISK_GEOMETRY) As Boolean
  Dim IOCTL_DISK_GET_DRIVE_GEOMETRY As Long, ReturnedByteCount As Long
    
    IOCTL_DISK_GET_DRIVE_GEOMETRY = CTL_CODE(7, 0, _
        METHOD_BUFFERED, FILE_ANY_ACCESS)
    
    GetDiskGeometry = DeviceIoControl(hDisk, _
        IOCTL_DISK_GET_DRIVE_GEOMETRY, ByVal 0, 0, lpGeometry, _
        Len(lpGeometry), ReturnedByteCount, ByVal 0)
End Function
Public Function DismountVolume(hDisk As Long) As Boolean
  Dim ReturnedByteCount As Long, FSCTL_DISMOUNT_VOLUME As Long
    
    FSCTL_DISMOUNT_VOLUME = CTL_CODE(8, 0, METHOD_BUFFERED, _
        FILE_ANY_ACCESS)
    
    DismountVolume = DeviceIoControl(hDisk, FSCTL_DISMOUNT_VOLUME, _
        ByVal 0, 0, ByVal 0, 0, ReturnedByteCount, ByVal 0)
End Function
Public Sub PrintGeometry(lpGeometry As DISK_GEOMETRY)
  Dim MediaType As String
    
    Select Case lpGeometry.MediaType
      Case F5_1Pt2_512
        MediaType = "5.25, 1.2MB,  512 bytes/sector"
      Case F3_1Pt44_512
        MediaType = "3.5,  1.44MB, 512 bytes/sector"
      Case F3_2Pt88_512
        MediaType = "3.5,  2.88MB, 512 bytes/sector"
      Case F3_20Pt8_512
        MediaType = "3.5,  20.8MB, 512 bytes/sector"
      Case F3_720_512
        MediaType = "3.5,  720KB,  512 bytes/sector"
      Case F5_360_512
        MediaType = "5.25, 360KB,  512 bytes/sector"
      Case F5_320_512
        MediaType = "5.25, 320KB,  512 bytes/sector"
      Case F5_320_1024
        MediaType = "5.25, 320KB,  1024 bytes/sector"
      Case F5_180_512
        MediaType = "5.25, 180KB,  512 bytes/sector"
      Case F5_160_512
        MediaType = "5.25, 160KB,  512 bytes/sector"
      Case RemovableMedia
        MediaType = "Removable media other than floppy"
      Case FixedMedia
        MediaType = "Fixed hard disk media"
      Case Else
        MediaType = "Unknown"
    End Select
    
    Debug.Print "Mediatype: " & MediaType
    Debug.Print "Cylinders " & lpGeometry.Cylinders.lowpart & " " & _
        "Tracks/Cylinder " & lpGeometry.TracksPerCylinder & " " & _
        "Sectors/Track " & lpGeometry.SectorsPerTrack
End Sub
Public Sub DiskImage(Source As String, Destination As String)
  Dim SourceIsDrive As Boolean, Drive As String, DriveName As _
      String, DiskImage As String
  Dim hDrive As Long, Geometry As DISK_GEOMETRY, hDiskImage As _
      Long, b As Boolean
  Dim BytesRead As Long, BytesWritten As Long, FileSize As Long, _
      VirtBufSize As Long
  Dim NumBufs As Long, IoBuffer As Long, t1 As Single, t2 As Single
    
    SourceIsDrive = False
    If Right$(Source, 1) = ":" Then
      SourceIsDrive = True
      Drive = "\\.\" & Source
      DriveName = Source
      DiskImage = Destination
    End If
    
    If Right$(Destination, 1) = ":" Then
      If SourceIsDrive Then
        Debug.Print "Fehler 1"
        Exit Sub
      End If
      
      SourceIsDrive = False
      Drive = "\\.\" & Destination
      DriveName = Destination
      DiskImage = Source
    Else
      If Not SourceIsDrive Then
        Debug.Print "Fehler 2"
        Exit Sub
      End If
    End If
    
    hDrive = CreateFile(Drive, GENERIC_READ Or GENERIC_WRITE, _
        FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, _
        OPEN_EXISTING, 0, ByVal 0)
    
    If hDrive = INVALID_HANDLE_VALUE Then
      Debug.Print "Fehler 3"
      CloseHandle hDrive
      Exit Sub
    End If
    
    If Not LockVolume(hDrive) Then
      Debug.Print "Fehler 4"
      CloseHandle hDrive
      Exit Sub
    End If
    
    If Not GetDiskGeometry(hDrive, Geometry) Then
      Debug.Print "Fehler 5"
      CloseHandle hDrive
      Exit Sub
    End If
    
    hDiskImage = CreateFile(DiskImage, GENERIC_READ Or _
        GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal _
        0, IIf(SourceIsDrive, CREATE_ALWAYS, OPEN_EXISTING), 0, ByVal 0)
    
    If hDiskImage = INVALID_HANDLE_VALUE Then
      Debug.Print "Fehler 6"
      CloseHandle hDrive
      Exit Sub
    End If
    
    If SourceIsDrive Then
      NumBufs = Geometry.Cylinders.lowpart
      VirtBufSize = Geometry.TracksPerCylinder * _
          Geometry.SectorsPerTrack * Geometry.BytesPerSector
      
      IoBuffer = VirtualAlloc(ByVal 0, VirtBufSize, MEM_COMMIT, _
          PAGE_READWRITE)
      
      If IoBuffer = 0 Then
        Debug.Print "Fehler 7"
        CloseHandle hDrive
        CloseHandle hDiskImage
        Exit Sub
      End If
      
      If NumBufs > 10 Then
        NumBufs = 10
      End If
      For NumBufs = NumBufs To 1 Step -1
        t1 = Timer
        b = ReadFile(hDrive, ByVal IoBuffer, VirtBufSize, _
            BytesRead, ByVal 0)
        t2 = Timer
        
        Debug.Print BytesRead / (t2 - t1) / 1000 & " Kilobytes/s lesen"
        
        If b And BytesRead <> 0 Then
          t1 = Timer
          b = WriteFile(hDiskImage, ByVal IoBuffer, BytesRead, _
              BytesWritten, ByVal 0)
          t2 = Timer
          
          If t2 - t1 <> 0 Then
            Debug.Print BytesRead / (t2 - t1) / 1000 & " " & _
                "Kilobytes/s schreiben"
          End If
          
          If Not b And (BytesRead <> BytesWritten) Then
            Debug.Print "Fehler 8"
            CloseHandle hDrive
            CloseHandle hDiskImage
            Exit Sub
          End If
        Else
          Debug.Print "Fehler 9"
          CloseHandle hDrive
          CloseHandle hDiskImage
          Exit Sub
        End If
      Next NumBufs
    Else
      Debug.Print "Formatieren und kopieren"
    End If
    
    DismountVolume hDrive
    UnlockVolume hDrive
    
    CloseHandle hDrive
    CloseHandle hDiskImage
    
    Debug.Print "Fertig"
End Sub
Public Function LowLevelFormat(hDisk As Long, lpGeometry As _
    DISK_GEOMETRY) As Boolean
  Dim FormatParameters As FORMAT_PARAMETERS, lpBadTrack As Long
  Dim i As Long, b As Boolean, ReturnedByteCount As Long, _
      IOCTL_DISK_FORMAT_TRACKS As Long
    
    IOCTL_DISK_FORMAT_TRACKS = CTL_CODE(7, &H6, METHOD_BUFFERED, _
        FILE_READ_ACCESS Or FILE_WRITE_ACCESS)
    
    FormatParameters.MediaType = lpGeometry.MediaType
    FormatParameters.StartHeadNumber = 0
    FormatParameters.EndHeadNumber = lpGeometry.TracksPerCylinder - 1
    lpBadTrack = LocalAlloc(LMEM_ZEROINIT, _
        lpGeometry.TracksPerCylinder * 2)
    
    For i = 0 To lpGeometry.Cylinders.lowpart - 1
      FormatParameters.StartCylinderNumber = i
      FormatParameters.EndCylinderNumber = i
      
      b = DeviceIoControl(hDisk, IOCTL_DISK_FORMAT_TRACKS, _
          FormatParameters, Len(FormatParameters), lpBadTrack, _
          lpGeometry.TracksPerCylinder * LenB(lpBadTrack), _
          ReturnedByteCount, ByVal 0)
      
      If Not b Then
        LocalFree lpBadTrack
        LowLevelFormat = b
        Exit Function
      End If
    Next i
    
    LocalFree lpBadTrack
    LowLevelFormat = True
End Function
Public Sub Format(Drive As String)
  Dim SourceIsDrive As Boolean, DriveName As String
  Dim hDrive As Long, Geometry As DISK_GEOMETRY
    
    DriveName = Drive
    Drive = "\\.\" & Drive
    
    hDrive = CreateFile(Drive, GENERIC_READ Or GENERIC_WRITE, _
        FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, _
        OPEN_EXISTING, 0, ByVal 0)
    
    If hDrive = INVALID_HANDLE_VALUE Then
      Debug.Print "Fehler 3"
      CloseHandle hDrive
      Exit Sub
    End If
    
    If Not LockVolume(hDrive) Then
      Debug.Print "Fehler 4"
      CloseHandle hDrive
      Exit Sub
    End If
    
    If Not GetDiskGeometry(hDrive, Geometry) Then
      Debug.Print "Fehler 5"
      CloseHandle hDrive
      Exit Sub
    End If
    
    
    If LowLevelFormat(hDrive, Geometry) Then
      Debug.Print "Formatiert"
    Else
      Debug.Print "Fehler"
    End If
    
    
    DismountVolume hDrive
    UnlockVolume hDrive
    
    CloseHandle hDrive
    
    Debug.Print "Fertig"
End Sub