Option Explicit
'=======================================================
'CONSTANTES
'=======================================================
Public Const FILE_BEGIN As Long = 0&
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const CREATE_NEW As Long = 1&
Public Const OPEN_EXISTING As Long = 3&
Public Const GENERIC_WRITE As Long = &H40000000
Public Const GENERIC_READ As Long = &H80000000
Public Const FILE_END As Long = 2&
Public Const INVALID_HANDLE_VALUE As Long = -1&
Public Const DEUX_EXP_31 As Double = 2147483648#
Public Const DEUX_EXP_32 As Double = 4294967296#
'=======================================================
'APIS
'=======================================================
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 WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) 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 Any) As Long
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, ByVal liDistanceToMove As Currency, ByRef lpNewFilePointer As Currency, ByVal dwMoveMethod As Long) As Long
Public Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Public Declare Function LockFile Lib "kernel32.dll" (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.dll" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
Public Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function GetLogicalDriveStrings Lib "kernel32.dll" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'=======================================================
'TYPES
'=======================================================
Public Type OVERLAPPED
ternal As Long
ternalHigh As Long
Offset As Long
OffsetHigh As Long
hEvent As Long
End Type
'=======================================================
'permet de d'écrire de manière directe dans le disque
'avec en entrée un pointeur et un handle de disque
'=======================================================
Public Sub DirectWritePtHandle(ByVal hDevice As Long, ByVal iStartSec As Currency, _
ByVal nBytes As Long, ByVal lBytesPerSector As Long, _
ByRef pt As Long)
'/!\ iStartsec et nbytes doivent être des multiples de la taille d'un secteur (généralement 512 octets)
Dim BytesRead As Long
Dim Pointeur As Currency
Dim Ret As Long
Dim lLowPart As Long
Dim lHighPart As Long
'détermine le byte de départ du secteur
Pointeur = CCur(iStartSec) * CCur(lBytesPerSector)
'transforme un currency en 2 long pour une structure LARGE_INTEGER
GetLargeInteger Pointeur, lLowPart, lHighPart
'déplace, dans le fichier (ici un disque) pointé par hDevice, le "curseur" au premier
'byte que l'on veut lire (donné par deux long)
Ret = SetFilePointer(hDevice, lLowPart, lHighPart, FILE_BEGIN) 'FILE_BEGIN ==> part du début du fichier pour décompter la DistanceToMove
'verrouilage de la zone du disque à écrire
Call LockFile(hDevice, lLowPart, lHighPart, nBytes, 0)
'écriture disque
Ret = WriteFile(hDevice, ByVal pt, nBytes, Ret, ByVal 0&)
'on vide les buffers internes et on dévérouille la zone
Call FlushFileBuffers(hDevice)
Call UnlockFile(hDevice, lLowPart, lHighPart, nBytes, 0)
End Sub
'=======================================================
'divise une currency en 2 long ==> créé une LARGE_INTEGER
'=======================================================
Public Sub GetLargeInteger(ByVal curVar As Currency, ByRef lngLowPart As Long, ByRef lngHighPart As Long)
lngLowPart = 0: lngHighPart = 0
Do
If curVar < DEUX_EXP_32 Then Exit Do
curVar = curVar - DEUX_EXP_32: lngHighPart = lngHighPart + 1
'If lngHighPart >= (2 ^ 31) Then lngHighPart = lngHighPart - (2 ^ 32)
Loop
If curVar >= DEUX_EXP_31 Then curVar = curVar - DEUX_EXP_32
lngLowPart = CLng(curVar)
End Sub
'=======================================================
'permet de lire des bytes directement dans le disque
'sortie en String
'=======================================================
Public Sub DirectReadS(ByVal sDrive As String, ByVal iStartSec As Currency, ByVal nBytes As Long, ByVal lBytesPerSector As Long, ByRef sBufferOut As String)
'/!\ iStartsec et nbytes doivent être des multiples de la taille d'un secteur (généralement 512 octets)
Dim BytesRead As Long
Dim Pointeur As Currency
Dim Ret As Long
Dim hDevice As Long
Dim lLowPart As Long, lHighPart As Long
'obtient un path valide pour l'API CreateFIle si nécessaire
If Len(sDrive) <> 6 Then sDrive = BuildDrive(sDrive)
'ouvre le drive
hDevice = CreateFile(sDrive, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
'quitte si le handle n'est pas valide
If hDevice = INVALID_HANDLE_VALUE Then Exit Sub
'détermine le byte de départ du secteur
Pointeur = CCur(iStartSec) * CCur(lBytesPerSector)
'transforme un currency en 2 long pour une structure LARGE_INTEGER
GetLargeInteger Pointeur, lLowPart, lHighPart
'déplace, dans le fichier (ici un disque) pointé par hDevice, le "curseur" au premier
'byte que l'on veut lire (donné par deux long)
Ret = SetFilePointer(hDevice, lLowPart, lHighPart, FILE_BEGIN) 'FILE_BEGIN ==> part du début du fichier pour décompter la DistanceToMove
If Ret = -1 Then GoTo dskerror
'création d'un buffer
sBufferOut = Space$(nBytes)
'obtention de la string
Ret = ReadFile(hDevice, ByVal sBufferOut, nBytes, BytesRead, 0&)
dskerror:
'ferme le handle
CloseHandle hDevice
End Sub
'=======================================================
'récupère un handle de disque valide pour la lecture
'=======================================================
Public Function GetDiskHandleRead(ByVal sDrive As String) As Long
'obtient un path valide pour l'API CreateFIle si nécessaire
If Len(sDrive) <> 6 Then sDrive = BuildDrive(sDrive)
'ouvre le drive
GetDiskHandleRead = CreateFile(sDrive, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
End Function
'=======================================================
'récupère un handle de disque valide pour l'écriture
'=======================================================
Public Function GetDiskHandleWrite(ByVal sDrive As String) As Long
'obtient un path valide pour l'API CreateFIle si nécessaire
If Len(sDrive) <> 6 Then sDrive = BuildDrive(sDrive)
'ouvre le drive
GetDiskHandleWrite = CreateFile(sDrive, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
End Function
'=======================================================
'permet de lire des bytes directement dans le disque
'sortie en String
'demande un handle
'=======================================================
Public Sub DirectReadSHandle(ByVal hDevice As Long, ByVal iStartSec As Currency, ByVal nBytes As Long, ByVal lBytesPerSector As Long, ByRef sBufferOut As String)
'/!\ iStartsec et nbytes doivent être des multiples de la taille d'un secteur (généralement 512 octets)
Dim BytesRead As Long
Dim Pointeur As Currency
Dim Ret As Long
Dim lLowPart As Long, lHighPart As Long
'détermine le byte de départ du secteur
Pointeur = CCur(iStartSec) * CCur(lBytesPerSector)
'transforme un currency en 2 long pour une structure LARGE_INTEGER
GetLargeInteger Pointeur, lLowPart, lHighPart
'déplace, dans le fichier (ici un disque) pointé par hDevice, le "curseur" au premier
'byte que l'on veut lire (donné par deux long)
Ret = SetFilePointer(hDevice, lLowPart, lHighPart, FILE_BEGIN) 'FILE_BEGIN ==> part du début du fichier pour décompter la DistanceToMove
'création d'un buffer
sBufferOut = Space$(nBytes)
'obtention de la string
Ret = ReadFile(hDevice, ByVal sBufferOut, nBytes, BytesRead, 0&)
End Sub
'=======================================================
'permet de lire des bytes directement dans le disque PHYSIQUE
'sortie en String
'=======================================================
Public Sub DirectReadSPhys(ByVal bytDrive As Byte, ByVal iStartSec As Currency, ByVal nBytes As Long, ByVal lBytesPerSector As Long, ByRef sBufferOut As String)
'/!\ iStartsec et nbytes doivent être des multiples de la taille d'un secteur (généralement 512 octets)
Dim BytesRead As Long
Dim Pointeur As Currency
Dim Ret As Long
Dim hDevice As Long
Dim lLowPart As Long, lHighPart As Long
'ouvre le drive
hDevice = CreateFile("\\.\PHYSICALDRIVE" & CStr(bytDrive), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
'quitte si le handle n'est pas valide
If hDevice = INVALID_HANDLE_VALUE Then Exit Sub
'détermine le byte de départ du secteur
Pointeur = CCur(iStartSec) * CCur(lBytesPerSector)
'transforme un currency en 2 long pour une structure LARGE_INTEGER
GetLargeInteger Pointeur, lLowPart, lHighPart
'déplace, dans le fichier (ici un disque) pointé par hDevice, le "curseur" au premier
'byte que l'on veut lire (donné par deux long)
Ret = SetFilePointer(hDevice, lLowPart, lHighPart, FILE_BEGIN) 'FILE_BEGIN ==> part du début du fichier pour décompter la DistanceToMove
If Ret = -1 Then GoTo dskerror
'création d'un buffer
sBufferOut = Space$(nBytes)
'obtention de la string
Ret = ReadFile(hDevice, ByVal sBufferOut, nBytes, BytesRead, 0&)
dskerror:
'ferme le handle
CloseHandle hDevice
End Sub
'=======================================================
'renvoie un drive compatible avec l'api CreateFile
'=======================================================
Public Function BuildDrive(ByVal sDrive As String) As String
BuildDrive = "\\.\" & UCase$(Left$(sDrive, 2))
End Function
'=======================================================
'écrire des bytes dans un fichier
'=======================================================
Public Function WriteBytesToFile(ByVal sFile As String, ByVal sString As String, ByVal curOffset As Currency) As String
Dim tmpText As String
Dim Ret As Long
Dim lFile As Long
'obtient un handle vers le fichier à écrire
'ouverture en ECRITURE, avec overwrite si déjà existant (car déjà demandé confirmation avant)
lFile = CreateFile(sFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lFile = -1 Then Exit Function 'fichier indisponible
'bouge le pointeur sur le fichier au bon emplacement
Ret = SetFilePointerEx(lFile, curOffset / 10000, 0&, FILE_BEGIN)
'a divisé par 10^4 pour obtenir un nombre décimal de Currency
'écriture dans le fichier
WriteFile lFile, ByVal sString, Len(sString), Ret, ByVal 0&
'ferme le handle du fichier écrit
CloseHandle lFile
End Function
'=======================================================
'récupère un handle d'écriture vers un fichier
'=======================================================
Public Function GetFileHandleWrite(ByVal sFile As String) As Long
GetFileHandleWrite = CreateFile(sFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
End Function
'=======================================================
'écrire des bytes dans un fichier
'=======================================================
Public Sub WriteBytesToFileHandle(ByVal hFile As Long, ByVal pt As Long, _
ByVal curOffset As Currency, ByVal lLen As Long)
Dim tmpText As String
Dim Ret As Long
'bouge le pointeur sur le fichier au bon emplacement
Ret = SetFilePointerEx(hFile, curOffset / 10000, 0&, FILE_BEGIN)
'écriture dans le fichier
WriteFile hFile, ByVal pt, lLen, Ret, ByVal 0&
End Sub
'=======================================================
'écrire des bytes dans un fichier (à la fin du fichier)
'=======================================================
Public Function WriteBytesToFileEnd(ByVal sFile As String, ByVal sString As String) As String
Dim tmpText As String
Dim Ret As Long
Dim lFile As Long
'obtient un handle vers le fichier à écrire
'ouverture en ECRITURE, avec overwrite si déjà existant (car déjà demandé confirmation avant)
lFile = CreateFile(sFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lFile = -1 Then Exit Function 'fichier non dispo
'bouge le pointeur sur le fichier à la fin du fichier
Ret = SetFilePointerEx(lFile, 0&, 0&, FILE_END) '
'écriture dans le fichier
WriteFile lFile, ByVal sString, Len(sString), Ret, ByVal 0&
'ferme le handle du fichier écrit
CloseHandle lFile
End Function
'=======================================================
'écrire des bytes dans un fichier (à la fin du fichier) avec en entrée un handle
'=======================================================
Public Function WriteBytesToFileEndHandle(ByVal lngFile As Long, ByVal sString As String) As String
Dim tmpText As String
Dim Ret As Long
'bouge le pointeur sur le fichier à la fin du fichier
Ret = SetFilePointerEx(lngFile, 0&, 0&, FILE_END) '
'écriture dans le fichier
WriteFile lngFile, ByVal sString, Len(sString), Ret, ByVal 0&
End Function
'=======================================================
'récupérer des bytes dans un fichier
'=======================================================
Public Function GetBytesFromFile(ByVal sFile As String, ByVal curSize As Currency, ByVal curOffset As Currency) As String
Dim tmpText As String
Dim Ret As Long
Dim lFile As Long
'obtient un handle vers le fichier à ouvrir
lFile = CreateFile(sFile, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lFile = -1 Then
'fichier inexistant, ou en tout cas inaccessible
Exit Function
End If
'créé un buffer qui contiendra les valeurs
tmpText = String$(curSize, 0)
'bouge le pointeur sur lr fichier au bon emplacement
Ret = SetFilePointerEx(lFile, curOffset / 10000, 0&, FILE_BEGIN) 'divise par 10000 pour
'pouvoir renvoyer une currency DECIMALE (cad du genre 1.4567 pour l'offset 14567)
'prend un morceau du fichier
Ret = ReadFile(lFile, ByVal tmpText, Len(tmpText), Ret, ByVal 0&)
'affecte à la fonction
GetBytesFromFile = tmpText
'referme le handle
CloseHandle lFile
End Function
Seul les admins et l'auteur du code lui même peuvent modifier ce code.