basbigfiles.bas

a Tiger Hash algorithmn code

Attribute VB_Name = "basBigFiles"
' ***************************************************************************
'  Module:     basBigFiles.bas
'
'  Purpose:    This module calculates the size of a file.  Can handle
'              file sizes greater than 2gb.
'
' Reference:   Richard Newcombe  22-Jan-2007
'              Getting Past the 2 Gb File Limit
'              http://www.codeguru.com/vb/controls/vb_file/directory/article.php/c12917__1/
'
'              How To Seek Past VBA's 2GB File Limit
'              http://support.microsoft.com/kb/189981
'
'              How To Write Data to a File Using WriteFile API
'              http://support.microsoft.com/kb/165942/EN-US/
'
' Description: The descriptions in this module are excerts from Richard
'              Newcombe's article.
'
'              When working in the IDE, any numbers that are entered are
'              limited to a Long variable type. Actually, as far I've
'              found, the IDE uses Longs for most numeric storage within
'              the projects that you write.
'
'              Okay, so what's the problem with Longs? Well, by definition
'              they are a signed 4-byte variable, in hex &H7FFFFFFF, with a
'              lower limit of -2,147,483,648 and an upper limit of
'              2,147,483,647 (2 Gb). &H80000000 stores the sign of the
'              value. Even when you enter values in Hex, they are stored in
'              a Long.
'
'              Working with random access files, you quite often use a Long
'              to store the filesize and current position, completely
'              unaware that if the file you access is just one byte over
'              the 2 Gb size, you can cause your application to corrupt the
'              file when writing to it.
'
'              Unfortunately, there is no quick fix for this. To get around
'              the problem, you need to write your own file handling
'              module, one that uses windows APIs to open, read, write, and
'              close any file.
'
'              The API's expect the Low and High 32-bit values in unsigned
'              format. Also, the APIs return unsigned values. So, the first
'              thing you have to do is decide on a variable type that you
'              can use to store values higher than 2 Gb. After some serious
'              thought, I decided to use a Currency type (64-bit scaled
'              integer) this gives you a 922,337 gig upper file limit, way
'              bigger that the largest hard drive available today.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-Jan-2007  Richard Newcombe
'              http://www.codeguru.com/vb/controls/vb_file/directory/article.php/c12917__1/
' 03-Feb-2008  Kenneth Ives  [e-mail]
'              Documented and modified
' ***************************************************************************
Option Explicit

' ********************************************************************
' Constants
' ********************************************************************
  Private Const MODULE_NAME            As String = "basBigFiles"
  Private Const DUMMY_NUMBER           As Long = vbObjectError + 513
  Private Const MAXLONG                As Long = 2147483647
  Private Const FILE_BEGIN             As Long = 0
  Private Const FILE_SHARE_READ        As Long = &H1
  Private Const FILE_SHARE_WRITE       As Long = &H2
  Private Const CREATE_NEW             As Long = 1
  Private Const GENERIC_READ           As Long = &H80000000
  Private Const GENERIC_WRITE          As Long = &H40000000
  Private Const OPEN_EXISTING          As Long = 3
  Private Const OPEN_ALWAYS            As Long = 4
  Private Const INVALID_HANDLE_VALUE   As Long = -1
  Private Const FILE_ATTRIBUTE_NORMAL  As Long = &H80
  
' *****************************************************************************
' API Declares
' *****************************************************************************
  ' The CreateFile function creates or opens the following objects and
  ' returns a handle that can be used to access the object:
  '
  '       Files
  '       pipes
  '       mailslots
  '       communications resources
  '       disk devices (Windows NT only)
  '       consoles
  '       directories (open only)
  Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
          (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
          ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, _
          ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
          ByVal hTemplateFile As Long) As Long

  ' CloseHandle invalidates the specified object handle, decrements
  ' the object抯 handle count, and performs object retention checks.
  ' Once the last handle to an object is closed, the object is removed
  ' from the operating system. In other words, closes an open file.
  Private Declare Function CloseHandle Lib "kernel32" _
          (ByVal hFile As Long) As Long

  ' This API is used to set the current position in the open file.
  ' This function is very important because any reads or writes to
  ' the file do not automatically forward the file position.
  Private Declare Function SetFilePointer Lib "kernel32" _
          (ByVal hFile As Long, ByVal lDistanceToMove As Long, _
          lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

  ' Use SetEndOfFile to set the new end of the file marker. This
  ' function moves the end-of-file position for the specified file
  ' to the current position of the file pointer.
  Private Declare Function SetEndOfFile Lib "kernel32" _
          (ByVal hFile As Long) As Long

  ' This function writes data to a file, starting at the position
  ' indicated by the file pointer. After the write operation has
  ' been completed, the file pointer is adjusted by the number of
  ' bytes written.
  Private Declare Function WriteFile Lib "kernel32" _
          (ByVal hFile As Long, lpBuffer As Any, _
          ByVal nNumberOfBytesToWrite As Long, _
          lpNumberOfBytesWritten As Long, _
          ByVal lpOverlapped As Any) As Long

  ' This function reads data from a file, starting at the position
  ' indicated by the file pointer. After the read operation has
  ' been completed, the file pointer is adjusted by the number of
  ' bytes read.
  Private 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

  ' GetFileSize determines the size of the file. The file size is
  ' given in a 64-bit value that is split into two 32-bit values.
  ' The high-order half is put into the variable passed as
  ' lpFileSizeHigh; the low-order half is returned by the function.
  ' To get the size, you can either put the binary or hexadecimal
  ' values of the two variables side-by-side, or use the formula
  ' filesize = lpFileSizeHigh * 2^32 + return value. If an error
  ' occurs, the function instead returns -1.
  Private Declare Function GetFileSize Lib "kernel32.dll" _
          (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

  ' Forces Windows to flush the write cache.
  Private Declare Function FlushFileBuffers Lib "kernel32" _
          (ByVal hFile As Long) As Long

  ' Retrieves a set of FAT file system attributes for a specified file
  ' or directory. Used here to determine if a path or file exist.
  Private Declare Function GetFileAttributes Lib "kernel32" _
          Alias "GetFileAttributesA" (ByVal lpSpec As String) As Long


' ***************************************************************************
' ***                           Methods                                   ***
' ***************************************************************************

' ***************************************************************************
' Routine:       OpenReadOnly
'
' Description:   Open a file to be used as input.  The file must already
'                exist.  If the file does not exist, an error will occur.
'
' WARNING:       Always make a backup of the files that are to be processed.
'
' Parameters:    strFileName - Fully qualified path and file name
'                hFile - Numeric value designating an open file
'
' Returns:       TRUE - Successfully opened file
'                FALSE - An error occurred while accessing the file
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Public Function OpenReadOnly(ByVal strFileName As String, _
                             ByRef hFile As Long) As Boolean

    Const ROUTINE_NAME As String = "OpenReadOnly"

    On Error GoTo OpenReadOnly_Error

    OpenReadOnly = False   ' Preset to bad ending
    
    ' See if the user wants to stop processing
    DoEvents
    If gblnStopProcessing Then
        Exit Function
    End If
    
    ' make sure the file does exist
    If Not FileExists(strFileName) Then
    
        Err.Raise DUMMY_NUMBER, ROUTINE_NAME, _
                  "Cannot find file at this location." & vbCrLf & vbCrLf & _
                  "File:  " & strFileName
    End If

    ' Open a file that is to be used as input (read only).
    hFile = CreateFile(strFileName, _
                       GENERIC_READ, FILE_SHARE_READ, _
                       0&, OPEN_EXISTING, 0&, 0&)
    
    ' error opening the file
    If hFile = INVALID_HANDLE_VALUE Then
        
        Err.Raise DUMMY_NUMBER, ROUTINE_NAME, _
                  "Could not open file." & vbCrLf & vbCrLf & _
                  "File:  " & strFileName
    End If
    
    ' Set the pointer to start at the beginning of the file
    SetFilePointer hFile, 0, 0, FILE_BEGIN
    
    ' See if the user wants to stop processing
    DoEvents
    If gblnStopProcessing Then
        API_CloseFile hFile     ' Verify file handle has been released
    Else
        OpenReadOnly = True
    End If
    
OpenReadOnly_CleanUp:
    On Error GoTo 0
    Exit Function

OpenReadOnly_Error:
    ErrorMsg MODULE_NAME, ROUTINE_NAME, Err.Description
    API_CloseFile hFile     ' Verify file handle has been released
    OpenReadOnly = False
    Resume OpenReadOnly_CleanUp

End Function

' ***************************************************************************
' Routine:       OpenReadWrite
'
' Description:   Open a file to update.  If the file exist, if will be
'                opened.  If the file does not exist, it will be created.
'                Use carefully.  If you open an existing file and something
'                goes wrong, the file may become a zero byte file.  There
'                is no recovery of the data available.  I use this to access
'                a temporary work file only.
'
' WARNING:       Always make a backup of the files that are to be processed.
'
' Parameters:    strFileName - Fully qualified path and file name
'                hFile - Numeric value designating an open file
'
' Returns:       TRUE - Successfully opened file
'                FALSE - An error occurred while accessing the file
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-Jan-2007  Richard Newcombe
'              Wrote routine
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Modified and documented
' ***************************************************************************
Public Function OpenReadWrite(ByVal strFileName As String, _
                              ByRef hFile As Long) As Boolean

    Const ROUTINE_NAME As String = "OpenReadWrite"

    On Error GoTo OpenReadWrite_Error

    OpenReadWrite = False  ' Preset to bad ending
    
    ' See if the user wants to stop processing
    DoEvents
    If gblnStopProcessing Then
        Exit Function
    End If
    
    ' Open a file that is to be updated.
    hFile = CreateFile(strFileName, _
                       GENERIC_READ Or GENERIC_WRITE, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                       0&, OPEN_ALWAYS, 0&, 0&)
    
    ' error opening the file
    If hFile = INVALID_HANDLE_VALUE Then
        
        Err.Raise DUMMY_NUMBER, ROUTINE_NAME, _
                  "Could not open file." & vbCrLf & vbCrLf & _
                  "File:  " & strFileName
    End If
    
    ' Set the pointer to start at the beginning of the file
    SetFilePointer hFile, 0, 0, FILE_BEGIN
    
    ' See if the user wants to stop processing
    DoEvents
    If gblnStopProcessing Then
        API_CloseFile hFile     ' Verify file handle has been released
    Else
        OpenReadWrite = True
    End If

OpenReadWrite_CleanUp:
    On Error GoTo 0
    Exit Function

OpenReadWrite_Error:
    ErrorMsg MODULE_NAME, ROUTINE_NAME, Err.Description
    API_CloseFile hFile     ' Verify file handle has been released
    OpenReadWrite = False
    Resume OpenReadWrite_CleanUp

End Function

' ***************************************************************************
' Routine:       CalcFileSize
'
' Description:   This routine is used to open a file as read only and
'                calculate it's size.
'
' WARNING:       Always make a backup of the files that are to be processed.
'
' Parameters:    strFileName  - Name of file
'                curFileSize  - Returned file size in bytes
'                strBitsInHex - OPTIONAL - Return the file size calculated
'                               into bits and in hex format without leading
'                               zeroes. Used for calculating a hash.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-Jan-2007  Richard Newcombe
'              Wrote routine
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Modified and documented
' ***************************************************************************
Public Sub CalcFileSize(ByVal strFileName As String, _
                        ByRef curFilesize As Currency, _
               Optional ByRef strBitsInHex As String = "")

    Dim hFile        As Long      ' receives a handle to the file
    Dim lngLowOrder  As Long      ' receive the low-order half of the file size
    Dim lngHighOrder As Long      ' receive the high-order half of the file size
    Dim curHexTemp   As Currency  ' Holding area if greater than 2gb
    
    Const ROUTINE_NAME As String = "CalcFileSize"
    
    On Error GoTo CalcFileSize_Error
    
    ' See if the user wants to stop processing
    DoEvents
    If gblnStopProcessing Then
        Exit Sub
    End If