VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Win32File"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Esta clase permite realizar operaciones con ficheros binarios
'
' METODOS:
'
'   OpenFile        abre un fichero, el parámetro 'ReadOnly' indica si
'                   se abre como sólo lectura
'   NewFile         crea un fichero
'   CloseFile       cierra el fichero abierto
'   ReadBytes       lee 'ByteCount' bytes, los devuelve en un array Variant y
'                   mueve el puntero
'   WriteBytes      escribe el contenido de un array Variante de Bytes en la
'                   posición actual del fichero y mueve el puntero
'   ReadString      lee el contenido de un fichero y lo coloca en una cadena (String)
'                   la cadena debe estar dimensionada con el nº de caracteres a leer
'   WriteString     escribe una cadena de texto (String) en un fichero
'   Flush           fuerza el volcado de los buffer del fichero
'   SeekAbsolute    mueve el puntero a la posición especificada desde el inicio
'                   del fichero (limitado a 2Gb)
'   SeekRelative    mueve el puntero +/- 2Gb desde la posición actual
'
' PROPIEDADES:
'
'   FileHandle      puntero del fichero
'   FileName        nombre del fichero abierto
'   Size            tamaño del fichero
'   IsOpen          devuelve True si el fichero está abierto
'   AutoFlush       si es True, 'WriteBytes' llama automáticamente a 'Flush'
'

Private Const W32F_SOURCE = "Win32File"
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_BEGIN = 0, FILE_CURRENT = 1, FILE_END = 2
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) 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 CloseHandle Lib "kernel32" (ByVal hObject 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 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 SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Public Enum W32F_Errors
    W32F_UNKNOWN_ERROR = 45600
    W32F_FILE_ALREADY_OPEN
    W32F_PROBLEM_OPENING_FILE
    W32F_FILE_ALREADY_CLOSED
    W32F_PROBLEM_SEEKING
End Enum

Private hFile As Long
Private sFName As String
Private fAutoFlush As Boolean

Public Property Get FileHandle() As Long

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    FileHandle = hFile
    
End Property

Public Property Get FileName() As String

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    FileName = sFName
    
End Property

Public Property Get Size() As Long

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    Size = GetFileSize(hFile, vbNull)

End Property

Public Property Get IsOpen() As Boolean

    IsOpen = hFile <> INVALID_HANDLE_VALUE
    
End Property

Public Property Get AutoFlush() As Boolean
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    AutoFlush = fAutoFlush
    
End Property

Public Property Let AutoFlush(ByVal NewVal As Boolean)
  
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    fAutoFlush = NewVal

End Property

Public Sub OpenFile(ByVal sFileName As String, ByVal ReadOnly As Boolean)
    Dim OpenMode As Long

    If hFile <> INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_OPEN, sFName
    End If
    
    If ReadOnly Then
        OpenMode = GENERIC_READ
    Else
        OpenMode = GENERIC_WRITE Or GENERIC_READ
    End If
    hFile = CreateFile(sFileName, OpenMode, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
      
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_PROBLEM_OPENING_FILE, sFileName
    End If
    
    sFName = sFileName
    
End Sub

Public Sub NewFile(ByVal sFileName As String)

    If hFile <> INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_OPEN, sFName
    End If
    
    hFile = CreateFile(sFileName, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
      
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_PROBLEM_OPENING_FILE, sFileName
    End If
    
    sFName = sFileName
    
End Sub

Public Sub CloseFile()

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    CloseHandle hFile
    sFName = ""
    hFile = INVALID_HANDLE_VALUE
    
End Sub

Public Function ReadBytes(ByVal ByteCount As Long) As Byte()
    Dim Bytes() As Byte
    Dim BytesRead As Long
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    ReDim Bytes(ByteCount - 1) As Byte
    ReadFile hFile, Bytes(0), ByteCount, BytesRead, 0
    ReadBytes = Bytes
    
End Function

Public Sub ReadString(ByRef s As String)
    Dim BytesRead As Long
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    ReadFile hFile, ByVal s, Len(s), BytesRead, 0
    
End Sub

Public Sub WriteBytes(DataBytes() As Byte)
    Dim fSuccess As Long, BytesToWrite As Long, BytesWritten As Long
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    BytesToWrite = UBound(DataBytes) - LBound(DataBytes) + 1
    fSuccess = WriteFile(hFile, DataBytes(LBound(DataBytes)), BytesToWrite, BytesWritten, 0)
    
    If fAutoFlush Then
        Flush
    End If
    
End Sub

Public Sub WriteString(ByVal s As String)
    Dim fSuccess As Long, BytesToWrite As Long, BytesWritten As Long
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    BytesToWrite = Len(s)
    fSuccess = WriteFile(hFile, ByVal s, BytesToWrite, BytesWritten, 0)
    
    If fAutoFlush Then
        Flush
    End If
    
End Sub

Public Sub Flush()

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    FlushFileBuffers hFile
    
End Sub

Public Sub SeekAbsolute(ByVal Pos As Long)

    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    SetFilePointer hFile, Pos, 0, FILE_BEGIN
    
End Sub

Public Sub SeekRelative(ByVal Offset As Long)
    Dim TempLow As Long, TempErr As Long
    
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    
    TempLow = SetFilePointer(hFile, Offset, 0, FILE_CURRENT)
    If TempLow = -1 Then
        TempErr = Err.LastDllError
        If TempErr Then
            RaiseError W32F_PROBLEM_SEEKING, "Error " & TempErr & "." & vbCrLf & CStr(TempErr)
        End If
    End If

End Sub

Private Sub Class_Initialize()

    hFile = INVALID_HANDLE_VALUE
    fAutoFlush = True
    
End Sub

Private Sub Class_Terminate()

    If hFile <> INVALID_HANDLE_VALUE Then
        CloseHandle hFile
    End If
    
End Sub

Private Sub RaiseError(ByVal ErrorCode As W32F_Errors, Optional sExtra)
    Dim Win32Err As Long
    Dim Win32Text As String
        
    Win32Err = Err.LastDllError
    
    If Win32Err Then
        Win32Text = vbCrLf & "Error " & Win32Err & vbCrLf & DecodeAPIErrors(Win32Err)
    End If
        
    Select Case ErrorCode
        Case W32F_FILE_ALREADY_OPEN
            Err.Raise W32F_FILE_ALREADY_OPEN, W32F_SOURCE, "El fichero '" & sExtra & "' ya está abierto." & Win32Text
        Case W32F_PROBLEM_OPENING_FILE
            Err.Raise W32F_PROBLEM_OPENING_FILE, W32F_SOURCE, "Error de apertura de '" & sExtra & "'." & Win32Text
        Case W32F_FILE_ALREADY_CLOSED
            Err.Raise W32F_FILE_ALREADY_CLOSED, W32F_SOURCE, "No hay ningún fichero abierto."
        Case W32F_PROBLEM_SEEKING
            Err.Raise W32F_PROBLEM_SEEKING, W32F_SOURCE, "Error en Seek." & vbCrLf & sExtra
        Case Else
            Err.Raise W32F_UNKNOWN_ERROR, W32F_SOURCE, "Error desconocido." & Win32Text
    End Select
    
End Sub

Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
    Dim sMessage As String
    Dim MessageLength As Long
    
    sMessage = Space(256)
    MessageLength = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, ErrorCode, 0&, sMessage, 256&, 0&)
    If MessageLength > 0 Then
        DecodeAPIErrors = Left(sMessage, MessageLength)
    Else
        DecodeAPIErrors = "Error desconocido."
    End If
    
End Function