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