mdirectrw.bas

Visual Basic Low Level Disk Acces

    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

Public 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

Public 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

Public 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

Public 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

Public 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

Public 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

Public Function LockNTVolume(ByVal hDevice As Long) As Boolean
    Const LOCK_TIMEOUT = 5000   ' 5 Seconds
    Const LOCK_RETRIES = 20     ' try 20 times
    Const METHOD_BUFFERED = 0&
    Dim FSCTL_LOCK_VOLUME  As Long
    Dim lngSleepAmount As Long, ret As Long, lngTryCount As Long
    Dim bLocked As Boolean
    FSCTL_LOCK_VOLUME = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6, METHOD_BUFFERED, FILE_ANY_ACCESS)
    lngSleepAmount = LOCK_TIMEOUT / LOCK_RETRIES
    For lngTryCount = 0 To LOCK_RETRIES
        If DeviceIoControl(hDevice, FSCTL_LOCK_VOLUME, ByVal 0, 0, ByVal 0, 0, ret, ByVal 0) Then
            bLocked = True
            Exit For
        End If
        Call Sleep(lngSleepAmount)
    Next lngTryCount
    LockNTVolume = bLocked
End Function