Date de création : 19/04/2007 à 18:37:00 0 Commentaire(s)

violent_ken

Tout le nécessaire pour lire dans des fichiers, des disques logiques et des disques physiques.
Tout le nécessaire pour écrire dans des fichiers et des disques.


Les fonctions sont répétées (pas toutes utiles) car certaines prennent en entrée un handle et d'autres une string.
De même, certaines prennent en entrée un pointeur et d'autre une string.

Le nombre de bytes lus dans un disque (logique ou physique) DOIT ETRE PROPORTIONEL AU NOMBRE DE BYTES PAR SECTEUR DU DISQUE (512 en général).

Le tout, bien sur, par API.

@+

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

Vous devez être connecté pour pouvoir poster un commentaire.