Attribute VB_Name = "Module2"
'*****************************************************************
' Module for performing Direct Read/Write access to disk sectors
'
' Written by Arkadiy Olovyannikov (ark@fesma.ru)
'*****************************************************************
Option Explicit

Dim lDistanceToMove As Double
Dim lpDistanceToMoveHigh As Double

Public abResult() As Byte

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

Public Type DISK_IO
  dwStartSector As Long
  wSectors As Integer
  dwBuffer As Long
End Type
    
Public 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

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Rem Erdogan Tan 13-12-2008 (Word,Dword,FileTime, SystemTime)

Type WORD
     LowByte As Byte
     HighByte As Byte
End Type

Type DWORD
     LowWord As WORD
     HighWord As WORD
End Type

Public Type FILETIME
     dwLowDateTime As DWORD
     dwHighDateTime As DWORD
End Type

Public Type SYSTEMTIME
     wYear As WORD
     wMonth As WORD
     wDayOfWeek As WORD
     wDay As WORD
     wHour As WORD
     wMinute As WORD
     wSecond As WORD
     wMilliSeconds As WORD
End Type

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

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

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = -1&

Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Public 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
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public 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**************************************************
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Rem Public Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, ByVal liDistanceToMove As Large_Integer, ByRef lpNewFilePointer As Any, ByVal dwMoveMethod As Long) As Long
Public 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
Public 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
Public Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Public 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
Public 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
Rem Erdogan Tan 13-12-2008
Public Declare Function FileTimeToSystemTime Lib "kernel32" (ByRef lpFileTime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Boolean

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)

'*************Erdogan Tan**********
Public Const BytesPerSector = 512

Public Function IsWindowsNT() As Boolean
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Function
   If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function

Public Function LoWord(ByVal DW As Long) As Integer
    If DW And &H8000& Then
        LoWord = DW Or &HFFFF0000
    Else
        LoWord = DW And &HFFFF&
    End If
End Function

Public Function HiWord(ByVal DW As Long) As Integer
    HiWord = (DW And &HFFFF0000) \ 65536
End Function

Public 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

Public Function MakeDWord(ByVal wLo As Integer, ByVal wHi As Integer) As Long
    MakeDWord = (wHi * 65536) + (wLo And &HFFFF&)
End Function

Public Function Fix64BitNumber(ByVal iNumber1 As Long, ByVal iNumber2 As Long, ByRef oNumberL As Double, ByRef oNumberH As Double) As Boolean
Rem Erdogan Tan 10-11-2008
Dim Sonuc As Double
Dim S As Long
Dim T As Integer
Dim B1(3) As Integer
Dim B2(3) As Integer
Dim B3(19) As Integer
Dim B(8) As Integer
Dim S1 As Double
Dim S2 As Long
Dim S3 As Long
Dim S4 As Integer
Sonuc = iNumber1
Sonuc = Sonuc * iNumber2
If Sonuc < 1 Then GoTo BunuGec3
S = iNumber1
B1(0) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec1
B1(1) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec1
B1(2) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec1
B1(3) = S Mod 256
S = S \ 256
BunuGec1:
S = iNumber2
B2(0) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec2
B2(1) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec2
B2(2) = S Mod 256
S = S \ 256
If S = 0 Then GoTo BunuGec2
B2(3) = S Mod 256
S = S \ 256
BunuGec2:
S = B1(0) * B2(0)
B3(0) = S Mod 256
T = S \ 256
S = B1(1) * B2(0)
B3(1) = (S Mod 256) + T
T = S \ 256
S = B1(2) * B2(0)
B3(2) = (S Mod 256) + T
T = S \ 256
S = B1(3) * B2(0)
B3(3) = (S Mod 256) + T
T = S \ 256
B3(4) = T
Rem *
S = B1(0) * B2(1)
B3(5) = S Mod 256
T = S \ 256
S = B1(1) * B2(1)
B3(6) = (S Mod 256) + T
T = S \ 256
S = B1(2) * B2(1)
B3(7) = (S Mod 256) + T
T = S \ 256
S = B1(3) * B2(1)
B3(8) = (S Mod 256) + T
T = S \ 256
B3(9) = T
Rem *
S = B1(0) * B2(2)
B3(10) = S Mod 256
T = S \ 256
S = B1(1) * B2(2)
B3(11) = (S Mod 256) + T
T = S \ 256
S = B1(2) * B2(2)
B3(12) = (S Mod 256) + T
T = S \ 256
S = B1(3) * B2(2)
B3(13) = (S Mod 256) + T
T = S \ 256
B3(14) = T
Rem *
S = B1(0) * B2(3)
B3(15) = S Mod 256
T = S \ 256
S = B1(1) * B2(3)
B3(16) = (S Mod 256) + T
T = S \ 256
S = B1(2) * B2(3)
B3(17) = (S Mod 256) + T
T = S \ 256
S = B1(3) * B2(3)
B3(18) = (S Mod 256) + T
T = S \ 256
B3(19) = T
Rem *
B(0) = B3(0)
S = B3(1) + B3(5)
B(1) = S Mod 256
T = S \ 256
S = B3(2) + B3(6) + B3(10) + T
B(2) = S Mod 256
T = S \ 256
S = B3(3) + B3(7) + B3(11) + B3(15) + T
B(3) = S Mod 256
T = S \ 256
S = B3(4) + B3(8) + B3(12) + B3(16) + T
B(4) = S Mod 256
T = S \ 256
S = B3(9) + B3(13) + B3(17) + T
B(5) = S Mod 256
T = S \ 256
S = B3(14) + B3(18) + T
B(6) = S Mod 256
T = S \ 256
S = B3(19) + T
B(7) = S Mod 256
T = S \ 256
B(8) = T
BunuGec3:
S4 = B(0)
S3 = B(1)
S3 = S3 * 256
S2 = B(2)
S2 = S2 * 65536
S1 = B(3)
S1 = S1 * 16777216
oNumberL = S1 + S2 + S3 + S4
S4 = B(4)
S3 = B(5)
S3 = S3 * 256
S2 = B(6)
S2 = S2 * 65536
S1 = B(7)
S1 = S1 * 16777216
oNumberH = S1 + S2 + S3 + S4
Fix64BitNumber = True
End Function

Private Function CTL_CODE(lngDeviceType, lngFunction, lngMethod, lngAccess) As Long
    CTL_CODE = ((lngDeviceType * (2 ^ 16)) Or (lngAccess * (2 ^ 14)) Or (lngFunction * (2 ^ 2)) Or lngMethod)
End Function

Rem Erdogan Tan 16-11-2008
Public Function GetDriveGeometry(ByVal sDrive As String, ByRef lBuffer() As Byte) As Boolean
    Dim hDevice As Long
    hDevice = CreateFile("\\.\" & sDrive, 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
    Const IOCTL_TIMEOUT = 5000   ' 5 Seconds
    Const IOCTL_RETRIES = 20     ' try 20 times
    Const METHOD_BUFFERED = 0&
    Rem Const IOCTL_DISK_BASE = FILE_DEVICE_DISK
    Const FILE_DEVICE_DISK = &H7&
    Dim lngSleepAmount As Long, Ret As Long, lngTryCount As Long
    Dim IOCTL_DISK_GET_DRIVE_GEOMETRY As Long
    Rem IOCTL_DISK_GET_DRIVE_GEOMETRY = CTL_CODE(IOCTL_DISK_BASE, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
    IOCTL_DISK_GET_DRIVE_GEOMETRY = CTL_CODE(FILE_DEVICE_DISK, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
    lngSleepAmount = IOCTL_TIMEOUT / IOCTL_RETRIES
    For lngTryCount = 0 To IOCTL_RETRIES
        If DeviceIoControl(hDevice, IOCTL_DISK_GET_DRIVE_GEOMETRY, 0, 0, lBuffer(0), UBound(lBuffer) + 1, Ret, 0) Then
           Exit For
        End If
        Call Sleep(lngSleepAmount)
    Next lngTryCount
    If Ret = 24 Then
       GetDriveGeometry = True
    End If
    CloseHandle hDevice
End Function


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

Rem 9-11-2008 'LoWord' and 'HiWord' for long distance(!) disk reading
Rem Before HiWord and LoWord modification, it was not possible to read far sectors
Rem ***
Rem 8-11-2008 'ByRef lpBuffer' and 'cBytes' long return modification
Rem by Erdogan Tan
Rem ***
Rem "DirectReadDriveNT" function was originally written
Rem by Arkadiy Olovyannikov
Rem with a variant return
Rem ... for reading logical (dos/windows) drive/disk sectors...
Rem ***
Rem Physical disk read/write features/procedures is written by Erdogan Tan
Rem by using information at Microsoft Developers Network (MSDN) web site
Rem http://msdn.microsoft.com/tr-tr/library/aa363858(en-us,VS.85).aspx
Rem Adapted to Visual Basic (5.0) code by Erdogan Tan on 27-10-2008
Rem ... and successfully realized on Windows XP SP3 (8-11-2008)
Rem This code is successfully running on Windows XP Home & Professional.

Public Function DirectReadDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
    Dim hDevice As Long
    Dim nSectors As Integer
    Rem Dim abBuff() As Byte
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    Rem hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
    Rem 4-11-2008 Physical disk read/write modification
    hDevice = CreateFile("\\.\" & sDrive, 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
    Rem 11-11-2008 Fixing 2 GB (32 bit - 64 bit) problem (to pass beyond 2 GB)
    Rem If Fix64BitNumber(iStartSec, CLng(BytesPerSector), lDistanceToMove, lpDistanceToMoveHigh) <> True Then Exit Function
    Call Fix64BitNumber(iStartSec, BytesPerSector, lDistanceToMove, lpDistanceToMoveHigh)
    If lDistanceToMove <= &H7FFFFFFF Then
       Call SetFilePointer(hDevice, CLng(lDistanceToMove), CLng(lpDistanceToMoveHigh), FILE_BEGIN)
    Else
       Call SetFilePointer(hDevice, &H7FFFFFFF, CLng(lpDistanceToMoveHigh), FILE_BEGIN)
       lDistanceToMove = lDistanceToMove - &H7FFFFFFF
       Call SetFilePointer(hDevice, CLng(lDistanceToMove), 0, FILE_CURRENT)
    End If
    Rem Call SetFilePointer(hDevice, iStartSec * BytesPerSector, 0, FILE_BEGIN)
    ReDim abBuff(nSectors * BytesPerSector - 1) As Byte
    Call ReadFile(hDevice, abBuff(0), UBound(abBuff) + 1, cBytes, 0&)
    CloseHandle hDevice
    Rem 20/09/2009 BugFix for error which occurs when floppy disk is not inserted
    If cBytes > 0 Then
        ReDim lpBuffer(cBytes - 1)
        CopyMemory lpBuffer(0), abBuff(iOffset), cBytes
    End If
    DirectReadDriveNT = cBytes
End Function

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

Rem 8-11-2008 'cBytes' long return modification
Rem by Erdogan Tan
Rem ***
Rem "DirectWriteNT" function was originally written
Rem by Arkadiy Olovyannikov
Rem with a boolean return
Rem ... for reading logical (dos/windows) drive/disk sectors...
Rem ***
Rem Physical disk read/write features/procedures is written by Erdogan Tan
Rem by using information at Microsoft Developers Network (MSDN) web site
Rem http://msdn.microsoft.com/tr-tr/library/aa363858(en-us,VS.85).aspx
Rem Adapted to Visual Basic (5.0) code by Erdogan Tan on 27-10-2008
Rem ... and successfully realized on Windows XP SP3 (8-11-2008)
Rem This code is successfully running on Windows XP Home & Professional.

Public Function DirectWriteDriveNT(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
    Dim hDevice As Long
    Dim nSectors As Long
    Dim nRead As Long
    Rem Dim abBuff() As Byte
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    Rem hDevice = CreateFile("\\.\" & UCase(Left(sDrive, 1)) & ":", GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
    Rem 4-11-2008 Physical disk read/write modification
    hDevice = CreateFile("\\.\" & sDrive, 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
    ReDim abBuff(nSectors * BytesPerSector - 1) As Byte
    Call DirectReadDriveNT(sDrive, iStartSec, 0, abBuff(), nSectors * BytesPerSector)
    CopyMemory abBuff(iOffset), lpBuffer(0), cBytes
    Rem 11-11-2008 Fixing 2 GB (32 bit - 64 bit) problem (to pass beyond 2 GB)
    Rem If Fix64BitNumber(iStartSec, CLng(BytesPerSector), lDistanceToMove, lpDistanceToMoveHigh) <> True Then Exit Function
    Call Fix64BitNumber(iStartSec, BytesPerSector, lDistanceToMove, lpDistanceToMoveHigh)
    If lDistanceToMove <= &H7FFFFFFF Then
       Call SetFilePointer(hDevice, CLng(lDistanceToMove), CLng(lpDistanceToMoveHigh), FILE_BEGIN)
    Else
       Call SetFilePointer(hDevice, &H7FFFFFFF, CLng(lpDistanceToMoveHigh), FILE_BEGIN)
       lDistanceToMove = lDistanceToMove - &H7FFFFFFF
       Call SetFilePointer(hDevice, CLng(lDistanceToMove), 0, FILE_CURRENT)
    End If
    Call LockFile(hDevice, CLng(lDistanceToMove), CLng(lpDistanceToMoveHigh), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
    Call WriteFile(hDevice, abBuff(0), UBound(abBuff) + 1, nRead, 0&)
    Call FlushFileBuffers(hDevice)
    Call UnlockFile(hDevice, CLng(lDistanceToMove), CLng(lpDistanceToMoveHigh), LoWord(nSectors * BytesPerSector), HiWord(nSectors * BytesPerSector))
    CloseHandle hDevice
    Rem 8-11-2008 Count of written bytes is equal to the required byte count?
    If nRead = UBound(abBuff) + 1 Then
       Rem All of the requested bytes are written...
       DirectWriteDriveNT = cBytes
    Rem Else
       Rem DirectWriteDriveNT = 0
    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, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
    Dim hDevice As Long
    Dim nSectors As Long
    Dim reg As DIOC_REGISTER
    Rem Dim aOutBuff() As Byte
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    ReDim aOutBuff(nSectors * BytesPerSector - 1) As Byte
    With reg
        Rem .reg_EAX = Asc(UCase(sDrive)) - Asc("A")
       .reg_EAX = Asc(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), cBytes, 0&)
    CloseHandle hDevice
    ReDim lpBuffer(cBytes - 1)
    CopyMemory lpBuffer(0), aOutBuff(iOffset), cBytes
    DirectReadFloppy9x = cBytes
End Function

Private Function DirectWriteFloppy9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
    Dim hDevice As Long
    Dim nSectors As Long
    Dim reg As DIOC_REGISTER
    Dim nRead As Long
    Rem Dim abBuff() As Byte
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    ReDim abBuff(nSectors * BytesPerSector - 1) As Byte
    Call DirectReadFloppy9x(sDrive, iStartSec, 0, abBuff(), nSectors * BytesPerSector)
    CopyMemory abBuff(iOffset), lpBuffer(0), cBytes
    With reg
       Rem .reg_EAX = Asc(UCase(sDrive)) - Asc("A")
       .reg_EAX = Asc(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
    Rem DirectWriteFloppy9x = DeviceIoControl(hDevice, VWIN32_DIOC_DOS_INT26, reg, Len(reg), reg, Len(reg), nRead, 0&) And Not (reg.reg_Flags And 1)
    Call DeviceIoControl(hDevice, VWIN32_DIOC_DOS_INT26, reg, Len(reg), reg, Len(reg), nRead, 0&)
    CloseHandle hDevice
    Rem 8-11-2008 Count of written bytes is equal to the required byte count?
    If nRead = UBound(abBuff) + 1 Then
       Rem All of the requested bytes are written...
       DirectWriteFloppy9x = cBytes
    Rem Else
       Rem DirectWriteFloppy9x = 0
    End If
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, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
    Dim hDevice As Long
    Dim nSectors As Long
    Dim reg As DIOC_REGISTER
    Dim dio As DISK_IO
    Rem Dim abDioBuff() As Byte
    Rem Dim aOutBuff() As Byte
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    ReDim aOutBuff(nSectors * BytesPerSector - 1) As Byte
    With dio
        .dwStartSector = iStartSec
        .wSectors = CInt(nSectors)
        .dwBuffer = VarPtr(aOutBuff(0))
    End With
    ReDim abDioBuff(LenB(dio) - 1) As Byte
    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))
       Rem .reg_EDX = Asc(UCase(sDrive)) - Asc("A") + 1
       .reg_EDX = Asc(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), cBytes, 0&)
    CloseHandle hDevice
    ReDim lpBuffer(cBytes - 1)
    CopyMemory lpBuffer(0), aOutBuff(iOffset), cBytes
    DirectReadDrive9x = cBytes
End Function

Private Function DirectWriteDrive9x(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long, ByVal AreaCode As FAT_WRITE_AREA_CODE) As Boolean
    Dim hDevice As Long
    Dim nSectors As Long
    Dim reg As DIOC_REGISTER
    Dim dio As DISK_IO
    Dim nRead As Long
    Rem Dim abDioBuff() As Byte
    Rem Dim abBuff() As Byte
    Dim bLocked As Boolean
    nSectors = Int((iOffset + cBytes - 1) / BytesPerSector) + 1
    ReDim abBuff(nSectors * BytesPerSector - 1) As Byte
    Call DirectReadDrive9x(sDrive, iStartSec, 0, abBuff(), nSectors * BytesPerSector)
    CopyMemory abBuff(iOffset), lpBuffer(0), cBytes
    With dio
        .dwStartSector = iStartSec
        .wSectors = CInt(nSectors)
        .dwBuffer = VarPtr(abBuff(0))
    End With
    ReDim abDioBuff(LenB(dio) - 1) As Byte
    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
        Rem If LockLogicalVolume(hDevice, Asc(UCase(sDrive)) - Asc("A") + 1, CByte(i), 0) Then
        If LockLogicalVolume(hDevice, Asc(sDrive) - Asc("A") + 1, CByte(i), 0) Then
           bLocked = True
           Exit For
        End If
    Next i
    If Not bLocked Then
       CloseHandle hDevice
       Exit Function
    End If
    Rem DirectWriteDrive9x = DeviceIoControl(hDevice, VWIN32_DIOC_DOS_DRIVEINFO, reg, Len(reg), reg, Len(reg), nRead, 0&) And Not (reg.reg_Flags And 1)
    DirectWriteDrive9x = DeviceIoControl(hDevice, VWIN32_DIOC_DOS_DRIVEINFO, reg, Len(reg), reg, Len(reg), nRead, 0&)
    Rem Call UnlockLogicalVolume(hDevice, Asc(UCase(sDrive)) - Asc("A") + 1)
    Call UnlockLogicalVolume(hDevice, Asc(sDrive) - Asc("A") + 1)
    CloseHandle hDevice
    Rem 8-11-2008 Count of written bytes is equal to the required byte count?
    If nRead = UBound(abBuff) + 1 Then
       Rem All of the requested bytes are written...
       DirectWriteDrive9x = cBytes
    Rem Else
       Rem DirectWriteDrive9x = 0
    End If
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

Public Function DirectReadDrive(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long) As Long
   If IsWindowsNT Then
      DirectReadDrive = DirectReadDriveNT(sDrive, iStartSec, iOffset, lpBuffer(), cBytes)
   Else
      Rem 5-11-2008 Erdogan Tan ("A" or "B" check)
      Rem If Asc(Ucase(sDrive)) < Asc("C") Then
      If Asc(sDrive) < Asc("C") Then
         DirectReadDrive = DirectReadFloppy9x(sDrive, iStartSec, iOffset, lpBuffer(), cBytes)
      Else
         DirectReadDrive = DirectReadDrive9x(sDrive, iStartSec, iOffset, lpBuffer(), cBytes)
      End If
   End If
End Function

Public Function DirectWriteDrive(ByVal sDrive As String, ByVal iStartSec As Long, ByVal iOffset As Long, ByRef lpBuffer() As Byte, ByVal cBytes As Long, Optional AreaCode As FAT_WRITE_AREA_CODE = DATA_AREA) As Long
   If IsWindowsNT Then
      DirectWriteDrive = DirectWriteDriveNT(sDrive, iStartSec, iOffset, lpBuffer(), cBytes)
   Else
      Rem 5-11-2008 Erdogan Tan ("A" or "B" check)
      Rem If Asc(Ucase(sDrive)) < Asc("C") Then
      If Asc(sDrive) < Asc("C") Then
         DirectWriteDrive = DirectWriteFloppy9x(sDrive, iStartSec, iOffset, lpBuffer(), cBytes)
      Else
         DirectWriteDrive = DirectWriteDrive9x(sDrive, iStartSec, iOffset, lpBuffer(), cBytes, AreaCode)
      End If
   End If
End Function