Sector lesen und screiben LBA ( RAW )

[PIC18F2550]

Hallo,
ich möchte von einener CF-Karte über USB-Adapter die Sectoren im LBA Modus auslesen und schreiben.

Hatt jemand einen Tipp mit welcher dll das unter Win10 geht?
Unter Ubuntu dürfte ich dann die selben Fragen haben.

Danke.
;*** EDIT *******************************************

Auf der Karte ist kein Dateisystem sie dient nur als Datenpuffer.
Unter Linux habe ich sie immer über DD in eine Datei kopiert um sie hinterher auslesen zu können.

[DePe]

Hier ist ein schönes hardcore Beispiel für Windows:
https://www.purebasic.fr/english/viewtopic.php?t=83334

Peter

[PIC18F2550]

Schönes Beispiel nur leider zu groß für meine Demo Version.

Es ereicht mir wenn ich:
* das Lauferk auswählen kann ( nicht nur die Partitionen auf der Karte )
* die LBA-Nummer übergeben kann
* und den zugehörigen Sector lesen und schreiben kann.
Danke.

[PIC18F2550]

Habe es endlich geschafft den Masterbootrecord von einer Festplatte auszulesen.

https://ibb.co/VYdhWhXz

EDIT<Eine frage wie bekomme ich aus dem wert "Disk" den von Windows zu geordneten Laufwerksbuchstabe heraus.>
Hat sich erledigt.

Danke

[PIC18F2550]

EDIT<Als Mediatype bekomme ich volgende Werte zurück: >
< 11 - müsste für USB-Stick <--RemovableMedia
< 12 - müsste für SSD <--FixedMedia
<
Stimmt das so?
Und was gibt es noch für Werte?>

USB-CD-Rom und USB-Floppy wird nicht angezeigt.
Gibt es eine Möglichkeit auf diese genauso zuzugreifen?

[PIC18F2550]

Berechnungsfehler in :

Code: Alles auswählen

Procedure.q GetPhysicalDiskBlockCount(hDisk.l)
 ;Get number of LBA LogicalBlockAddress on physical disk via an open handle
 Protected DiskGeometry.DISK_GEOMETRY
 Protected OldErrMode.l
 Protected ReturnedSize.l

 OldErrMode = SetErrorMode_(#SEM_FAILCRITICALERRORS) ;Prevent pop-up dialogs if device is not present or loaded
 If DeviceIoControl_(hDisk, #IOCTL_DISK_GET_DRIVE_GEOMETRY, 0, 0, @DiskGeometry, SizeOf(DISK_GEOMETRY), @ReturnedSize, 0 )
   ;Cyl  = DISK_GEOMETRY\Cylinders
   ;Head = DISK_GEOMETRY\TracksPerCylinder
   ;Sect = DISK_GEOMETRY\SectorsPerTrack
   ;LB   = DISK_GEOMETRY\Cyl * DiskGeometry\Head * DiskGeometry\Sect
;   ProcedureReturn(DiskGeometry\Cylinders * DiskGeometry\TracksPerCylinder * DiskGeometry\SectorsPerTrack)
   ProcedureReturn((DiskGeometry\Cylinders+1) * (DiskGeometry\TracksPerCylinder+1) * (DiskGeometry\SectorsPerTrack+1))

 EndIf
 SetErrorMode_(OldErrMode)

EndProcedure

DiskGeometry fängt immer mit 0 an zu Zählen
- Cylinder
- TracksPerCylinder
- SectorsPerTrack
Dadurch kommt eine zu kleine größe bei der Berechnung der gesamt Sectoren und der Mediengröße herraus.

[PIC18F2550]

Leseerfolge.

SSD
https://ibb.co/vxf03qjB

USB-Stick
https://ibb.co/vvMrS2pV

USB-IOMEGA ZIP100
https://ibb.co/CTnW8qz

Warum USB-Floppy und USB-CDROM und USB-DVDROM nicht gehen weis ich nicht.

Hatt jemand einen Tipp?

Danke.

[PIC18F2550]

Leider komme ich beim beschreiben vom US-STICK bzw. ZIP100 kein Stück weiter.

Code: Alles auswählen

Procedure.q DiskWrite(hDisk.i, BlockIndex.q, psBuffer.i, BufferLen.l)
;Disk write procedure
;Achten Sie darauf, dass Ihre Festplatte nicht beschädigt wird, wenn Sie dieses Verfahren anwenden.
  Protected FilePointer.q
  Protected NewFilePointer.q
  Protected BytesWritten.l
  FilePointer = BlockIndex * #BlockSize
  SetFilePointerEx_(hDisk, FilePointer, NewFilePointer, #FILE_BEGIN)
  If WriteFile_(hDisk, psBuffer, BufferLen, @BytesWritten, 0)
    ProcedureReturn(BytesWritten)
  EndIf
EndProcedure

DiskWrite sagt zwar das es 512 byte geschrieben hat aber beim Probelesen ist immer noch die alten Daten drauf.

Muss ich nach dem Befehl erst noch etwas machen befor ich Probelesen darf?

Bitdefender gemeckert auch nicht mehr nachdem ich die Projektpfade ausgeschlossen habe.

Mir gehen leider jetzt die Ideen aus was es noch sein kann.

[SMaag]

Ich kann in PB nicht viel beitragen, hab aber einen VB6 code, den ich 2006 mal erstellt habe um MMC Karten als RAW-Image zu erstellen und zurück zu schreiben. Grundsätzlich ist das auch nicht alles von mir. Ich hab das auch aus Foren zusammengetragen, zusammengestellt und ergänzt.

Das in PB übersetzen müsstest du selbst erledigen. Bzw. das raussuchen, was du brauchst.

Module LoLevelDiskAccess VB6

Code: Alles auswählen

Attribute VB_Name = "mdLoLevelDiskAccess"
' Online Information
' http://windowssdk.msdn.microsoft.com/en-us/library/default.aspx

' ***************************************************************************
'  NAME: mdLoLevelDiskAccess
'  DESC:
'  DESC:

' ***************************************************************************
'
'     Author : Stefan Maag
'     Create : 28.08.2006
'     Change :
'     Change : 09.11.2006, 64Bit Adressberechnung
'              Anpassung DISK_EXTENT Struktur
'              Funktion GetPhysicalDriveInfo

'     Version: 0.2

' ===========================================================================
'  rem: Quellenangaben:
' ===========================================================================
'  rem: MSDN Library 10/2001 - Microsoft
'  rem: - Microsoft System Journal, March 1998
'  rem:      Pop Open a Privileged Set of APIs with Windows NT Kernel
'  rem:      Mode Drivers; by James Finnegan

' ===========================================================================
'  rem: Weitere benötigte Dateien:
' ===========================================================================
'  rem:   keine

' MSDN: Übersicht unter File I/O Functions

Option Explicit

' The GetDriveType function determines whether a disk drive is a removable, fixed, CD-ROM, RAM disk, or network drive.
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

' Konstanten für GetDriveType
Public Const DRIVE_UNKNOWN = 0         'Unknown, or unable to be determined.
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6

' lt. MSDN Declared in Winioctl.h, aber leider dort nicht zu finden
' typedef struct _DISK_EXTENT {
'     DWORD           DiskNumber;         // Achtung 8 Bytes: 4 verwendet + 4 Füllbytes; wegen 8 Byte Mapping
'     LARGE_INTEGER   StartingOffset;
'     LARGE_INTEGER   ExtentLength;
' } DISK_EXTENT, *PDISK_EXTENT;

' LEN(DISK_EXTENT) = 24 Bytes
Type DISK_EXTENT
     DiskNumber As Long         ' Physical Disk Number
     NotUsed2 As Long           ' Füllbytes, wegen 8Byte Mapping; taucht in C Deklaration nicht auf
     StartOffset_Lo As Long     ' Startoffset from Beginning of the Medium
     StartOffset_Hi As Long
     Length_Lo As Long          ' Laenge der Disk in Byte
     Length_Hi As Long
End Type

' Rückgabe bei Aufruf von DeviceIOControl mit Parameter IOCTL_STORAGE_GET_DEVICE_NUMBER
Type STORAGE_DEVICE_NUMBER
   DeviceType As Long
   DeviceNumber As Long
   PartitionNumber As Long
End Type

' OverLapped Struktur für DeviceIocontrol
' Funktion ???
Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

' 64-Bit Large Integer Definition
Private Type LargeInt
   lo As Long
   hi As Long
End Type

' Funktionen zum lesen von bis zu 8 Byte
' Declare Sub GetMem1 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Byte)
' Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Integer)
' Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
' Declare Sub GetMem8 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Currency)

' Funktionen zum schreiben von bis zu 8 Byte
' Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
' Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
' Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
' Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)

Private Declare Sub CopyLarge Lib "msvbvm60" Alias "GetMem8" (Src As Any, Dest As Any)

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

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
                        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
                        


' The DeviceIoControl function sends a control code directly to a specified device driver, causing the corresponding device to perform the corresponding operation
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

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

' File Functions for NT Systems
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

' The FlushFileBuffers function flushes the buffers of the specified file and
' causes all buffered data to be written to the file.
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long

' The LockFile function locks a region in an open file.
' Locking a region prevents other processes from accessing the region.
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

' letzte Fehlermeldung des aufrufenden Threads
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const FILE_BEGIN = 0

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 IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS As Long = &H560000
Private Const IOCTL_STORAGE_GET_DEVICE_NUMBER As Long = &H420

' MSDN: You should specify the FILE_SHARE_READ and FILE_SHARE_WRITE access flags when calling
' CreateFile to open a handle to a device driver. However, when you open a communications resource,
' such as a serial port, you must specify exclusive access
Private Const GENERIC_READ& = &H80000000
Private Const GENERIC_WRITE& = &H40000000
Private Const GENERIC_READ_WRITE& = (GENERIC_READ Or GENERIC_WRITE)

Private Const FILE_SHARE_READ& = &H1
Private Const FILE_SHARE_WRITE& = &H2
Private Const FILE_SHARE_READ_WRITE& = (FILE_SHARE_READ Or FILE_SHARE_WRITE)
Private Const OPEN_EXISTING& = 3
Private Const INVALID_HANDLE_VALUE& = -1&

Public Function FileExist(FileName As String) As Boolean
' ===========================================================================
'        prüft ob eine Datei existiert
' ===========================================================================
  Dim a As String
  On Error Resume Next
  
  a = Dir(FileName)
  If Err <> 0 Then a = ""
  FileExist = (a <> "")
End Function

Public Function GetDriveList() As String()
' ===========================================================================
'  NAME: GetDriveList
'  DESC: Ermittelt Liste der verfügbaren Laufwerke als String-Array
'  DESC:
'  PARA():
'  RETURN:  String-Array mit Laufwerksbezeichnungen, je Drive ein Eintrag
' ===========================================================================
   
   Dim sDriveList() As String
   Dim sBuffer As String
   Dim ret As Long
   
   sBuffer = Space(255)
   Dim lenBuffer As Long
   
   lenBuffer = Len(sBuffer)
   
   ret = GetLogicalDriveStrings(lenBuffer, sBuffer)
   
   If ret <> 0 Then
      ' ret enthält die Länge des benötigten Buffers, davon noch 1 abziehen, wegen NULL am Ende
      sBuffer = Left(sBuffer, ret - 1)
      Debug.Print Len(sBuffer)
      ' Buffer in String-Array mit den Laufwerksbuchstaben splitten
      sDriveList = Split(sBuffer, vbNullChar)
   End If
   GetDriveList = sDriveList
End Function

Public Function GetStorageDeviceNumber(ByVal DriveLetter As String) As Long
' ===========================================================================
'  NAME: GetPhysicalDriveNumber
'  DESC: Ermittelt anhand des logischen Laufwerksbuchstabens die
'  DESC: physikalische Laufwerksnummer. Diese ist für lo level
'  DESC: Diskzugriffe nötig
'  PARA(DriveLetter): Laufwerksbuchstabe z.B. "C", "D", usw.
'  RETURN: Physikalische Laufwerksnummger
' ===========================================================================
   
   Dim hDevice As Long           ' File Handle
   Dim sDrive As String
   Dim DiskExtBuf(16) As Long
   Dim LenDiskExtBuf As Long
   Dim ReturnedBytes As Long
   Dim PhysicalDriveNumber As Long
   Dim ret As Long
   Dim SDN As STORAGE_DEVICE_NUMBER
   
   ' CreateFile erwartet Laufwerksbuchstaben nur gefolgt von einem ':'
   sDrive = UCase(Left(DriveLetter, 1)) & ":"
   
   hDevice = CreateFile("\\.\sDrive", _
                           GENERIC_READ_WRITE&, FILE_SHARE_READ_WRITE&, _
                           ByVal 0&, OPEN_EXISTING, 0, 0&)

   If hDevice = INVALID_HANDLE_VALUE Then
      ' -1 zurückgeben, falls CreateFile fehlschlägt
      GetStorageDeviceNumber = -1
      Exit Function
   End If
   
   LenDiskExtBuf = (UBound(DiskExtBuf()) + 1) * 4
   
   ' evtl. IOCTL_STORAGE_GET_DEVICE_NUMBER = 0x0420 verwenden
   
   ret = DeviceIoControl(hDevice, _
                           IOCTL_STORAGE_GET_DEVICE_NUMBER, ByVal 0&, _
                           0&, DiskExtBuf(0), LenDiskExtBuf, _
                           ReturnedBytes, ByVal 0&)
   Debug.Print "Last Error = "; GetLastError
   CopyMemory SDN, DiskExtBuf(0), 12
   CloseHandle hDevice

'   Debug.Print "PhysicalDriveNumber = "; PhysicalDriveNumber

   Dim I&
   Debug.Print ""
   Debug.Print "Inhalt des 'returned Buffers'"
   For I = 0 To 2
      Debug.Print I; " = ", DiskExtBuf(I)
   Next
   Debug.Print "LastError : "; GetLastError()
   Debug.Print
   Debug.Print "DeviceNumber =    "; SDN.DeviceNumber
   Debug.Print "DeviceTyp =       "; SDN.DeviceType
   Debug.Print "PartitionNumber = "; SDN.PartitionNumber
   GetStorageDeviceNumber = 0
End Function

Public Function GetPhysicalDriveNumber(ByVal DriveLetter As String) As Long
' ===========================================================================
'  NAME: GetPhysicalDriveNumber
'  DESC: Ermittelt anhand des logischen Laufwerksbuchstabens die
'  DESC: physikalische Laufwerksnummer. Diese ist für lo level
'  DESC: Diskzugriffe nötig
'  PARA(DriveLetter): Laufwerksbuchstabe z.B. "C", "D", usw.
'  RETURN: Physikalische Laufwerksnummger
' ===========================================================================
   
   Dim hDevice As Long           ' File Handle
   Dim sDrive As String
   Dim DiskExtBuf(16) As Long
   Dim LenDiskExtBuf As Long
   Dim ReturnedBytes As Long
   Dim PhysicalDriveNumber As Long
   Dim ret As Long
   
   ' CreateFile erwartet Laufwerksbuchstaben nur gefolgt von einem ':'
   sDrive = UCase(Left(DriveLetter, 1)) & ":"
   
   hDevice = CreateFile("\\.\" & sDrive, _
                           GENERIC_READ_WRITE, FILE_SHARE_READ_WRITE&, _
                           ByVal 0&, OPEN_EXISTING, 0, 0&)

   If hDevice = INVALID_HANDLE_VALUE Then
      ' -1 zurückgeben, falls CreateFile fehlschlägt
      GetPhysicalDriveNumber = -1
      Exit Function
   End If
' DeviceIOContorl mit IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS gibt folgende
' Struktur im Buffer zurück

' DeviceIOContorl mit IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS gibt folgende
' Struktur im Buffer zurück

'   typedef struct _VOLUME_DISK_EXTENTS {
'    DWORD       NumberOfDiskExtents;           // Achtung 8 Bytes, 4 Füllbytes wegen 8 Byte Mapping
'    DISK_EXTENT Extents[1];
'  } VOLUME_DISK_EXTENTS, *PVOLUME_DISK_EXTENTS
   
   ' LEN(DISK_EXTENT) = 24 Bytes
   'Private Type DISK_EXTENT
   '     DiskNumber As Long         ' Physical Disk Number
   '     NotUsed2 As Long           ' Füllbytes, wegen 8Byte Mapping; taucht in C Deklaration nicht auf
   '     StartOffset_Lo As Long     ' Startoffset from Beginning of the Medium
   '     StartOffset_Hi As Long
   '     Length_Lo As Long          ' Laenge der Disk in Byte
   '     Length_Hi As Long
   'End Type

   LenDiskExtBuf = (UBound(DiskExtBuf()) + 1) * 4
   
   ' evtl. IOCTL_STORAGE_GET_DEVICE_NUMBER = 0x0420 verwenden
   
   ' ret=0 Fehler
   ret = DeviceIoControl(hDevice, _
                           IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, ByVal 0&, _
                           0&, DiskExtBuf(0), LenDiskExtBuf, _
                           ReturnedBytes, ByVal 0&)
     
   If ret = 0 Or ReturnedBytes = 0 Then
      ' -1 zurückgeben, falls CreateFile fehlschlägt
      GetPhysicalDriveNumber = -1
      Exit Function
   End If

   PhysicalDriveNumber = DiskExtBuf(2)
   CloseHandle hDevice

'   Debug.Print "PhysicalDriveNumber = "; PhysicalDriveNumber

   Dim I&
   Debug.Print ""
   Debug.Print "Inhalt des 'returned Buffers'"
   For I = 0 To 10
      Debug.Print I; " = ", DiskExtBuf(I)
   Next
   Debug.Print "LastError : "; GetLastError()
   GetPhysicalDriveNumber = PhysicalDriveNumber
End Function

Public Function GetPhysicalDriveInfo(ByVal DriveLetter As String, D_E As DISK_EXTENT) As Boolean
' ===========================================================================
'  NAME: GetPhysicalDriveInfo
'  DESC: Ermittelt anhand des logischen Laufwerksbuchstabens die
'  DESC: physikalische Laufwerksnummer. Diese ist für lo level
'  DESC: Diskzugriffe nötig
'  PARA(DriveLetter): Laufwerksbuchstabe z.B. "C", "D", usw.
'  RETURN: Physikalische Laufwerksinfos
' ===========================================================================
   
   Dim hDevice As Long           ' File Handle
   Dim sDrive As String
   Dim DiskExtBuf(16) As Long
   Dim LenDiskExtBuf As Long
   Dim ReturnedBytes As Long
   Dim PhysicalDriveNumber As Long
   Dim ret As Long
   
   ' CreateFile erwartet Laufwerksbuchstaben nur gefolgt von einem ':'
   sDrive = UCase(Left(DriveLetter, 1)) & ":"
   
   hDevice = CreateFile("\\.\" & sDrive, _
                           GENERIC_READ_WRITE, FILE_SHARE_READ_WRITE&, _
                           ByVal 0&, OPEN_EXISTING, 0, 0&)

    Debug.Print "LastError : "; GetLastError(), sDrive, hDevice

   If hDevice = INVALID_HANDLE_VALUE Then
      GetPhysicalDriveInfo = False
      Exit Function
   End If

' DeviceIOControl mit IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS gibt folgende
' Struktur im Buffer zurück

'   typedef struct _VOLUME_DISK_EXTENTS {
'    DWORD       NumberOfDiskExtents;           // Achtung 8 Bytes, 4 Füllbytes wegen 8 Byte Mapping
'    DISK_EXTENT Extents[1];
'  } VOLUME_DISK_EXTENTS, *PVOLUME_DISK_EXTENTS
   
   ' LEN(DISK_EXTENT) = 24 Bytes
   'Private Type DISK_EXTENT
   '     DiskNumber As Long         ' Physical Disk Number
   '     NotUsed2 As Long           ' Füllbytes, wegen 8Byte Mapping; taucht in C Deklaration nicht auf
   '     StartOffset_Lo As Long     ' Startoffset from Beginning of the Medium
   '     StartOffset_Hi As Long
   '     Length_Lo As Long          ' Laenge der Disk in Byte
   '     Length_Hi As Long
   'End Type

   LenDiskExtBuf = (UBound(DiskExtBuf()) + 1) * 4
   
   ' evtl. IOCTL_STORAGE_GET_DEVICE_NUMBER = 0x0420 verwenden
   
   ret = DeviceIoControl(hDevice, _
                           IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, ByVal 0&, _
                           0&, DiskExtBuf(0), LenDiskExtBuf, _
                           ReturnedBytes, ByVal 0&)
    
   ' ret=0 Fehler
   If ret = 0 Or ReturnedBytes = 0 Then
      GetPhysicalDriveInfo = False
      Exit Function
   End If
    
   ' Disk_Extend Struktur aus Buffer kopieren
   CopyMemory D_E, DiskExtBuf(2), 24
   
   Dim I&
   Debug.Print ""
   Debug.Print "Inhalt des 'returned Buffers'"
   For I = 0 To 10
      Debug.Print I; " = ", DiskExtBuf(I)
   Next
 
   CloseHandle hDevice
   
   GetPhysicalDriveInfo = True
End Function

Public Function RawReadDriveNT(ByVal sDrive As String, _
                                ByVal StartSector As Long, _
                                ByVal nSectors As Long, _
                                Optional ByVal PhysicalAccess As Boolean = False, _
                                Optional ByVal BytesPerSector As Long = 512) As Variant
' ===========================================================================
'  NAME: RawReadDriveNT
'  DESC: liest Sektoren direkt vom Laufwerk
'  DESC: funktioniert nur unter NT-Systemen
'  PARA(sDrive):        String mit dem Laufwerksbuchstaben
'  PARA(StartSector):   Nr. des Startsektors beginnend bei 0
'  PARA(nSectors):      Anzahl der zu lesenden Sektoren
'  PARA(PhysicalAccess): Optionaler Parameter: PhysicalAccess verwendet
'                       statt des Laufwerksbuchstabens die physikalische
'                       Laufwerksnummer. Dies erlaubt auch Zugriff auf
'                       Fremdformate bzw. unformatierte Laufwerke
'                       ACHTUNG, dabei werden keine partitionierten Laufwerksgrenzen
'                                beachtet: Sektor 1 ist immer der physikalisch 1. Sektor
'                                der Festplatte!
'  RETURN: Physikalische Laufwerksnummer
' ===========================================================================
   
   Dim sPhysicalDriveName As String
   Dim DiskInfo As DISK_EXTENT
   
   Dim hDevice As Long
   Dim ByteBuffer() As Byte
   Dim nRead As Long ' Rückgabewert für Anzahl gelesener Bytes
   Dim BytesToRead As Long
   Dim StartOffset As LargeInt
   Dim res As Boolean
   Dim ret As Long
   
   ' Wenn PhysicalAccess gewählt ist, dann über die Physikalische Laufwerksnummer zugreifen,
   ' nur so erreicht man Zugriff auf fremdformatierte bzw. unformatierte Laufwerke
   If PhysicalAccess Then
      res = GetPhysicalDriveInfo(sDrive, DiskInfo)
      
      If res = False Then ' Fehler
         sPhysicalDriveName = UCase(Left(sDrive, 1)) & ":"
      Else
         ' DriveName für Zugriff über Physical DriveNumber, dies ist bei Wechselmedien wie MMC-Karten bzw. USB-Stick
         ' erforderlich
         sPhysicalDriveName = "PhysicalDrive" & DiskInfo.DiskNumber
      End If
   Else
      sPhysicalDriveName = UCase(Left(sDrive, 1)) & ":"
   End If
   
   hDevice = CreateFile("\\.\" & sPhysicalDriveName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
   
   If hDevice = INVALID_HANDLE_VALUE Then Exit Function
    
   ' Startoffset und BytesToRead als 64 Bit Large Integer berechnen
   StartOffset = MulLongToLarge(StartSector, BytesPerSector)
   BytesToRead = nSectors * BytesPerSector
   
   ret = SetFilePointer(hDevice, StartOffset.lo, StartOffset.hi, FILE_BEGIN)
   
   ReDim ByteBuffer(BytesToRead - 1)
   
   ret = ReadFile(hDevice, ByteBuffer(0), BytesToRead, nRead, 0&)
   CloseHandle hDevice
   
   RawReadDriveNT = ByteBuffer

End Function

Public Function RawWriteDriveNT(ByVal sDrive As String, _
                                 ByVal StartSector As Long, _
                                 ByRef ByteBuffer() As Byte, _
                                 Optional ByVal PhysicalAccess As Boolean = False, _
                                 Optional ByVal BytesPerSector As Long = 512) As Boolean
    
' ===========================================================================
'  NAME: RawWriteDriveNT
'  DESC: schreibt Sektoren direkt auf Laufwerk
'  DESC: funktioniert nur unter NT-Systemen
'  PARA(sDrive):        String mit dem Laufwerksbuchstaben
'  PARA(ByteBuffer):    ByteArray welches die Daten beinhaltet
'  PARA(PhysicalAccess): Optionaler Parameter: PhysicalAccess verwendet
'                       statt des Laufwerksbuchstabens die physikalische
'                       Laufwerksnummer. Dies erlaubt auch Zugriff auf
'                       Fremdformate bzw. unformatierte Laufwerke
'                       ACHTUNG, dabei werden keine partitionierten Laufwerksgrenzen
'                                beachtet: Sektor 1 ist immer der physikalisch 1. Sektor
'                                der Festplatte!
'  RETURN: True, wenn Funktion fehlerfrei ausgeführt
' ===========================================================================
    
    Dim sPhysicalDriveName As String
  
    Dim hDevice As Long
    Dim abBuff() As Byte
    Dim nWritten As Long      ' Rückgabewert für WriteFile, Anzahl geschriebener Bytes
    Dim nSectors As Long
    Dim lenBuffer As Long
    Dim BytesToWrite As LargeInt
    Dim StartOffset As LargeInt
    Dim DiskInfo As DISK_EXTENT
    Dim res As Boolean
    
   If PhysicalAccess Then
      res = GetPhysicalDriveInfo(sDrive, DiskInfo)
      
      If res = False Then ' Fehler
         sPhysicalDriveName = UCase(Left(sDrive, 1)) & ":"
      Else
         ' DriveName für Zugriff über Physical DriveNumber, dies ist bei Wechselmedien wie MMC-Karten bzw. USB-Stick
         ' erforderlich
         sPhysicalDriveName = "PhysicalDrive" & DiskInfo.DiskNumber
      End If
   Else
      sPhysicalDriveName = UCase(Left(sDrive, 1)) & ":"
   End If
   
   lenBuffer = UBound(ByteBuffer()) - LBound(ByteBuffer) + 1
   
   nSectors = Int((lenBuffer - 1) / BytesPerSector) + 1
   hDevice = CreateFile("\\.\" & sPhysicalDriveName, 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
   
   StartOffset = MulLongToLarge(StartSector, BytesPerSector) ' Startoffset als 64Bit Wert berechnen
   ' BytesToWrite würde eigentlich als 32Bit Wert genügen, dies entspräche 2GB
   ' da VB keine Unsinged Datentypen unterstützt, käme bei mehr als 1GB ein Überlauf auf negativ zustande,
   ' was zum Programmabsturzt führen würde
   BytesToWrite = MulLongToLarge(nSectors, BytesPerSector)
   
   Call SetFilePointer(hDevice, StartOffset.lo, StartOffset.hi, FILE_BEGIN)
   Call LockFile(hDevice, StartOffset.lo, StartOffset.hi, BytesToWrite.lo, BytesToWrite.hi)
   
   RawWriteDriveNT = WriteFile(hDevice, ByteBuffer(0), lenBuffer, nWritten, 0&)
   
   Debug.Print "geschriebene Bytesw = " & nWritten
   
   Call FlushFileBuffers(hDevice)
   Call UnlockFile(hDevice, StartOffset.lo, StartOffset.hi, BytesToWrite.lo, BytesToWrite.hi)
   CloseHandle hDevice

End Function

Private Function MulLongToLarge(ByVal Mul1 As Long, ByVal Mul2 As Long) As LargeInt
' ===========================================================================
'  NAME: MulLongToLarge
'  DESC: Multipliziert zwei 32 Bit Long Integer
'  DESC: und gibt das Ergebnis als 64 Bit Large Integer zurück
'  PARA(Mul1):    Erster Multiplikant
'  PARA(Mul2):    Zweiter Multiplikant
'  RETURN:        Multiplikationsergebnis als 64 Bit Large Integer
' ===========================================================================
   Dim dec1 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim dec2 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim dec3 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim ptr As Long            ' Pointer auf dec3, Multiplikationsergebnis
   
   dec1 = CDec(Mul1)          ' Multiplikant 1 nach Decimal wandeln
   dec2 = CDec(Mul2)          ' Multiplikant 2 nach Decimal wandeln
   dec3 = dec1 * dec2         ' Decimal-Werte multiplizieren
   
   ptr = VarPtr(dec3)         ' Pointer auf den Ergebnis-Variant
   ' Ein Decimal hat 96Bits, die niederwertingen 64Bits stehen
   ' in ptr+8, die höherwertigen 32Bits in Pointer +4
   ' Angaben lt. Klaus Langbein
   CopyLarge ByVal (ptr + 8), MulLongToLarge     ' 64 Bits der Ergbnis nach LargeInteger kopieren
   
End Function

Private Function AddLarge(ByRef Large1 As LargeInt, ByRef large2 As LargeInt) As LargeInt
' ===========================================================================
'  NAME: AddLarge
'  DESC: Addiert 2 64 Bit Large Integer
'  DESC: und gibt das Ergebnis als 64 Bit Large Integer zurück
'  PARA(Large1):  Erster Operand
'  PARA(large2):  Zweiter Operand
'  RETURN:        Additionsergebnis als 64 Bit Large Integer
' ===========================================================================
   
   Dim dec1 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim dec2 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim dec3 As Variant        ' Variant zur Verwendung als VB Decimal
   Dim ptr As Long            ' Pointer auf dec3, Multiplikationsergebnis
  
   ' Initialisierung der Variants als Decimal
   dec1 = CDec(0)
   dec2 = dec1
   dec3 = dec1
   
   ptr = VarPtr(dec1) + 8
   CopyLarge Large1, ByVal ptr
   ptr = VarPtr(dec2) + 8
   CopyLarge large2, ByVal ptr
   
   dec3 = dec1 + dec2
   
   ptr = VarPtr(dec3) + 8
   CopyLarge ByVal ptr, AddLarge
   
End Function

Direct DiskReadWrite VB6

Code: Alles auswählen

Attribute VB_Name = "mdDirectDiskRW"
' ich habe mal meine lokale MSDN befragt:
' http://support.microsoft.com/default.aspx?scid=kb;en-us;138434
' http://support.microsoft.com/default.aspx?scid=kb;en-us;137813
' http://support.microsoft.com/default.aspx?scid=kb;en-us;150101
' Die nötige API heißt wohl DeviceIoControl().


' ACHTUNG!!!  ACHTUNG!!!  ACHTUNG!!!  ACHTUNG!!!  ACHTUNG!!!
'
' die Benutzung dieses Codes kann irreparable Schäden am MBR bzw.
' der Partitionstabelle verursachen !!! Benutzung auf eigene Gefahr!!!

'*****************************************************************
' Module for performing Direct Read/Write access to disk sectors
'
' Written by Arkadiy Olovyannikov (ark@fesma.ru)
'*****************************************************************
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/Write drive with any file system

Private Function RawReadDriveNT(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
    
    RawReadDriveNT = abResult

End Function

Private Function RawWriteDriveNT(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 = RawReadDriveNT(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))
    
    RawWriteDriveNT = 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