Binaryworld - How to perform Direct Read/Write to disk (low level I/O) ... [ VB -> Hardware ]

'*****************************************************************
' Module for performing Direct Read/Write access to disk sectors
'*****************************************************************
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)

'*************Win9x direct Read/Write Staff**********
Public Enum FAT_WRITE_AREA_CODE
  FAT_AREA = &H2001
  ROOT_DIR_AREA = &H4001
  DATA_AREA = &H6001
End Enum

Private Type DISK_IO
  dwStartSector As Long
  wSectors As Integer
  dwBuffer As Long
End Type

Private Type DIOC_REGISTER
  reg_EBX As Long
  reg_EDX As Long
  reg_ECX As Long
  reg_EAX As Long
  reg_EDI As Long
  reg_ESI As Long
  reg_Flags As Long
End Type

Private Const VWIN32_DIOC_DOS_IOCTL = 1&          'Int13 - 440X functions
Private Const VWIN32_DIOC_DOS_INT25 = 2&          'Int25 - Direct Read Command
Private Const VWIN32_DIOC_DOS_INT26 = 3&          'Int26 - Direct Write Command
Private Const VWIN32_DIOC_DOS_DRIVEINFO = 6&        'Extended Int 21h function 7305h

Private Const FILE_DEVICE_FILE_SYSTEM = &H9&
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_READ_ACCESS = &H1
Private Const FILE_WRITE_ACCESS = &H2

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 INVALID_HANDLE_VALUE = -1&

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    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 DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As Long, _
    ByVal dwIoControlCode As Long, _
    ByRef lpInBuffer As Any, _
    ByVal nInBufferSize As Long, _
    ByRef lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, _
    ByRef lpBytesReturned As Long, _
    ByVal lpOverlapped As Long) As Long

'****************** NT direct Read/Write staff**************************************************
Private Declare Function SetFilePointer Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal lDistanceToMove As Long, _
    lpDistanceToMoveHigh As Long, _
    ByVal dwMoveMethod As Long) As Long

Private Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long) As Long

Private Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Long

Private Declare Function FlushFileBuffers Lib "kernel32" _
    (ByVal hFile As Long) As Long

Private Declare Function LockFile Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal dwFileOffsetLow As Long, _
    ByVal dwFileOffsetHigh As Long, _
    ByVal nNumberOfBytesToLockLow As Long, _
    ByVal nNumberOfBytesToLockHigh As Long) As Long

Private Declare Function UnlockFile Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal dwFileOffsetLow As Long, _
    ByVal dwFileOffsetHigh As Long, _
    ByVal nNumberOfBytesToUnlockLow As Long, _
    ByVal nNumberOfBytesToUnlockHigh As Long) As Long

Private Const FILE_BEGIN = 0

Public Function DirectReadDrive(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal cBytes As Long) As Variant
  If IsWindowsNT Then
    DirectReadDrive = DirectReadDriveNT(sDrive, iStartSec, iOffset, cBytes)
  Else
    If FSName = "FAT12" Or FSName = "FAT16" Then
      DirectReadDrive = DirectReadFloppy9x(sDrive, iStartSec, iOffset, cBytes)
    Else
      DirectReadDrive = DirectReadDrive9x(sDrive, iStartSec, iOffset, cBytes)
    End If
  End If
End Function

Public Function DirectWriteDrive(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal sWrite As String, Optional AreaCode As FAT_WRITE_AREA_CODE = DATA_AREA) As Boolean
  If IsWindowsNT Then
    DirectWriteDrive = DirectWriteDriveNT(sDrive, iStartSec, iOffset, sWrite)
  Else
    If FSName = "FAT12" Or FSName = "FAT16" Then
      DirectWriteDrive = DirectWriteFloppy9x(sDrive, iStartSec, iOffset, sWrite)
    Else
      DirectWriteDrive = DirectWriteDrive9x(sDrive, iStartSec, iOffset, sWrite, AreaCode)
    End If
  End If
End Function

'===Direct Read/Write floppy using Int25/26===
'Works only for FAT12/16 systems, but much more quicker
'Then Int21 7305 function

Private Function DirectReadFloppy9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal cBytes As Long) As Variant
  Dim hDevice As Long
  Dim reg As DIOC_REGISTER
  Dim nSectors As Long
  Dim aOutBuff() As Byte
  Dim abResult() As Byte
  Dim nRead As Long
  nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
  ReDim aOutBuff(nSectors * BytesPerSector)
  ReDim abResult(cBytes - 1) As Byte
  With reg
    .reg_EAX = Asc(UCase(sDrive)) - Asc("A")
    .reg_ESI = &H6000
    .reg_ECX = nSectors
    .reg_EBX = VarPtr(aOutBuff(0))
    .reg_EDX = iStartSec
  End With
  hDevice = CreateFile("\\.\VWIN32", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  Call DeviceIoControl(hDevice, VWIN32_DIOC_DOS_INT25, reg, Len(reg), reg, Len(reg), nRead, 0&)
  CloseHandle hDevice
  CopyMemory abResult(0), aOutBuff(iOffset), cBytes
  DirectReadFloppy9x = abResult
End Function

Private Function DirectWriteFloppy9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal sWrite As String) As Boolean
  Dim hDevice As Long
  Dim reg As DIOC_REGISTER
  Dim nSectors As Long
  Dim abBuff() As Byte
  Dim ab() As Byte
  Dim nRead As Long
  nSectors = Int((iOffset + Len(sWrite) - 1) / BytesPerSector) + 1
  abBuff = DirectReadFloppy9x(sDrive, iStartSec, 0, nSectors * BytesPerSector)
  ab = StrConv(sWrite, vbFromUnicode)
  CopyMemory abBuff(iOffset), ab(0), Len(sWrite)
  With reg
    .reg_EAX = Asc(UCase(sDrive)) - Asc("A")
    .reg_ESI = &H6000
    .reg_ECX = nSectors
    .reg_EBX = VarPtr(abBuff(0))
    .reg_EDX = iStartSec
  End With
  hDevice = CreateFile("\\.\VWIN32", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  DirectWriteFloppy9x = DeviceIoControl(hDevice, VWIN32_DIOC_DOS_INT26, reg, Len(reg), reg, Len(reg), nRead, 0&) And Not (reg.reg_Flags And 1)
  CloseHandle hDevice
End Function

'====Direct Read/Write drive using Int21 function 7305h====
'works with FAT12/16/32

Private Function DirectReadDrive9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal cBytes As Long) As Variant
  Dim hDevice As Long
  Dim reg As DIOC_REGISTER
  Dim dio As DISK_IO
  Dim abDioBuff() As Byte
  Dim nSectors As Long
  Dim aOutBuff() As Byte
  Dim abResult() As Byte
  Dim nRead As Long
  nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
  ReDim abResult(cBytes - 1) As Byte
  ReDim aOutBuff(nSectors * BytesPerSector - 1)
  With dio
    .dwStartSector = iStartSec
    .wSectors = CInt(nSectors)
    .dwBuffer = VarPtr(aOutBuff(0))
  End With
  ReDim abDioBuff(LenB(dio) - 1)
  CopyMemory abDioBuff(0), dio, LenB(dio)
  CopyMemory abDioBuff(6), abDioBuff(8), 4&
  With reg
    .reg_EAX = &H7305                 'function number
    .reg_ECX = -1&
    .reg_EBX = VarPtr(abDioBuff(0))
    .reg_EDX = Asc(UCase(sDrive)) - Asc("A") + 1
  End With
  hDevice = CreateFile("\\.\VWIN32", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  Call DeviceIoControl(hDevice, VWIN32_DIOC_DOS_DRIVEINFO, reg, Len(reg), reg, Len(reg), nRead, 0&)
  CloseHandle hDevice
  CopyMemory abResult(0), aOutBuff(iOffset), cBytes
  DirectReadDrive9x = abResult
End Function

Private Function DirectWriteDrive9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal sWrite As String, ByVal AreaCode As FAT_WRITE_AREA_CODE) As Boolean
  Dim hDevice As Long, nSectors As Long
  Dim nRead As Long
  Dim reg As DIOC_REGISTER
  Dim dio As DISK_IO
  Dim abDioBuff() As Byte
  Dim abBuff() As Byte
  Dim ab() As Byte
  Dim bLocked As Boolean
  nSectors = Int((iOffset + Len(sWrite) - 1) / BytesPerSector) + 1
  abBuff = DirectReadDrive9x(sDrive, iStartSec, 0, nSectors * BytesPerSector)
  ab = StrConv(sWrite, vbFromUnicode)
  CopyMemory abBuff(iOffset), ab(0), Len(sWrite)
  With dio
    .dwStartSector = iStartSec
    .wSectors = CInt(nSectors)
    .dwBuffer = VarPtr(abBuff(0))
  End With
  ReDim abDioBuff(LenB(dio) - 1)
  CopyMemory abDioBuff(0), dio, LenB(dio)
  CopyMemory abDioBuff(6), abDioBuff(8), 4&
  With reg
    .reg_EAX = &H7305                 'function number
    .reg_ECX = -1&
    .reg_EBX = VarPtr(abDioBuff(0))
    .reg_EDX = Asc(UCase(sDrive)) - Asc("A") + 1
    .reg_ESI = AreaCode
  End With
  hDevice = CreateFile("\\.\VWIN32", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  Dim i As Integer
  For i = 0 To 3
    If LockLogicalVolume(hDevice, Asc(UCase(sDrive)) - Asc("A") + 1, CByte(i), 0) Then
      bLocked = True
      Exit For
    End If
  Next i
  If Not bLocked Then GoTo WriteError
  DirectWriteDrive9x = DeviceIoControl(hDevice, VWIN32_DIOC_DOS_DRIVEINFO, reg, Len(reg), reg, Len(reg), nRead, 0&) And Not (reg.reg_Flags And 1)
  Call UnlockLogicalVolume(hDevice, Asc(UCase(sDrive)) - Asc("A") + 1)
WriteError:
  CloseHandle hDevice
End Function

Private Function LockLogicalVolume(hVWin32 As Long, bDriveNum As Byte, bLockLevel As Byte, wPermissions As Integer) As Boolean
  Dim fResult As Boolean
  Dim reg As DIOC_REGISTER
  Dim bDeviceCat As Byte                 ' can be either 0x48 or 0x08
  Dim cb As Long
  ' Try first with device category 0x48 for FAT32 volumes. If it
  ' doesn 't work, try again with device category 0x08. If that
  ' doesn 't work, then the lock failed.
  bDeviceCat = CByte(&H48)
ATTEMPT_AGAIN:
  reg.reg_EAX = &H440D&
  reg.reg_EBX = MAKEWORD(bDriveNum, bLockLevel)
  reg.reg_ECX = MAKEWORD(CByte(&H4A), bDeviceCat)
  reg.reg_EDX = wPermissions
  fResult = DeviceIoControl(hVWin32, VWIN32_DIOC_DOS_IOCTL, reg, LenB(reg), reg, LenB(reg), cb, ByVal 0&) And Not (reg.reg_Flags And 1)
  If (fResult = False) And (bDeviceCat <> CByte(&H8)) Then
    bDeviceCat = CByte(&H8)
    GoTo ATTEMPT_AGAIN
  End If
  LockLogicalVolume = fResult
End Function

Private Function UnlockLogicalVolume(hVWin32 As Long, bDriveNum As Byte) As Boolean
  Dim fResult As Boolean
  Dim reg As DIOC_REGISTER
  Dim bDeviceCat As Byte                 ' // can be either 0x48 or 0x08
  Dim cb As Long
  ' Try first with device category 0x48 for FAT32 volumes. If it
  ' doesn 't work, try again with device category 0x08. If that
  ' doesn 't work, then the unlock failed.
  bDeviceCat = CByte(&H48)
ATTEMPT_AGAIN:
  reg.reg_EAX = &H440D&
  reg.reg_EBX = bDriveNum
  reg.reg_ECX = MAKEWORD(CByte(&H6A), bDeviceCat)
  fResult = DeviceIoControl(hVWin32, VWIN32_DIOC_DOS_IOCTL, reg, LenB(reg), reg, LenB(reg), cb, ByVal 0&) And Not (reg.reg_Flags And 1)
  If (fResult = False) And (bDeviceCat <> CByte(&H8)) Then
    bDeviceCat = CByte(&H8)
    GoTo ATTEMPT_AGAIN
  End If
  UnlockLogicalVolume = fResult
End Function

'=============NT staff=============
'Read/Wrire drive with any file system

Private Function DirectReadDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal cBytes As Long) As Variant
  Dim hDevice As Long
  Dim abBuff() As Byte
  Dim abResult() As Byte
  Dim nSectors As Long
  Dim nRead As Long
  nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
  hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  Call SetFilePointer(hDevice, iStartSec * BytesPerSector, 0, FILE_BEGIN)
  ReDim abResult(cBytes - 1)
  ReDim abBuff(nSectors * BytesPerSector - 1)
  Call ReadFile(hDevice, abBuff(0), UBound(abBuff) + 1, nRead, 0&)
  CloseHandle hDevice
  CopyMemory abResult(0), abBuff(iOffset), cBytes
  DirectReadDriveNT = abResult
End Function

Private Function DirectWriteDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByVal sWrite As String) As Boolean
  Dim hDevice As Long
  Dim abBuff() As Byte
  Dim ab() As Byte
  Dim nRead As Long
  Dim nSectors As Long
  nSectors = Int((iOffset + Len(sWrite) - 1) / BytesPerSector) + 1
  hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  If hDevice = INVALID_HANDLE_VALUE Then Exit Function
  abBuff = DirectReadDriveNT(sDrive, iStartSec, 0, nSectors * BytesPerSector)
  ab = StrConv(sWrite, vbFromUnicode)
  CopyMemory abBuff(iOffset), ab(0), Len(sWrite)
  Call SetFilePointer(hDevice, iStartSec * BytesPerSector, 0, FILE_BEGIN)
  Call LockFile(hDevice, LoWord(iStartSec * BytesPerSector), HiWord(iStartSec * BytesPerSector), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
  DirectWriteDriveNT = WriteFile(hDevice, abBuff(0), UBound(abBuff) + 1, nRead, 0&)
  Call FlushFileBuffers(hDevice)
  Call UnlockFile(hDevice, LoWord(iStartSec * BytesPerSector), HiWord(iStartSec * BytesPerSector), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
  CloseHandle hDevice
End Function

Function MAKEWORD(ByVal bLo As Byte, ByVal bHi As Byte) As Integer
  If bHi And &H80 Then
    MAKEWORD = (((bHi And &H7F) * 256) + bLo) Or &H8000
  Else
    MAKEWORD = (bHi * 256) + bLo
  End If
End Function