basbigfiles.bas

a Tiger Hash algorithmn code

        hFile = 0          ' Reset handle value
    End If
    
End Sub

' **************************************************************************
' Routine:       CreateBigFile
'
' Description:   Creates a file from 1 byte to greater than 2gb filled with
'                null values. I have created files greater than 5gb without
'                any problems.
'
' Parameters:    strFilename - Name of file to be created
'                curFileSize - Size of new file
'
' Returns:       TRUE - File was successfully created
'                FALSE - An error occurred
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Original routine
' ***************************************************************************
Public Function CreateBigFile(ByVal strFileName As String, _
                              ByVal curFilesize As Currency) As Boolean

    Dim hFile      As Long
    Dim blnGood    As Boolean
    Dim curNewSize As Currency
        
    Const ROUTINE_NAME As String = "CreateBigFile"

    On Error GoTo CreateBigFile_Error

    blnGood = False
    
    ' If a file by this name already exist,
    ' then make sure it is empty.
    If FileExists(strFileName) Then
    
        ' Make sure file attributes are normal
        SetAttr strFileName, vbNormal
        
        ' Empty the file
        hFile = FreeFile
        Open strFileName For Output As #hFile
        Close #hFile
    
    End If

    ' Open the file with read/write access
    If OpenReadWrite(strFileName, hFile) Then
    
        ' Load file with null values
        blnGood = LoadWithNullValues(hFile, curFilesize)
        
        ' Always release file handle
        ' when no longer needed.
        API_CloseFile hFile
        
        ' See if file was successsfully
        ' created and loaded with nulls
        If blnGood Then
        
            ' Calculate the size of the new file to
            ' see if it matches what was requested
            CalcFileSize strFileName, curNewSize
        
            ' Compare new file size to requested size
            If curNewSize <> curFilesize Then
                blnGood = False   ' File sizes do not match
            End If
        End If
    
    End If
        
CreateBigFile_CleanUp:
    CreateBigFile = blnGood   ' Set flag based on type of completion
    API_CloseFile hFile       ' Verify file handle has been released
    
    On Error GoTo 0
    Exit Function

CreateBigFile_Error:
    ErrorMsg MODULE_NAME, ROUTINE_NAME, Err.Description
    blnGood = False
    Resume CreateBigFile_CleanUp
    
End Function

' **************************************************************************
' Routine:       LoadWithNullValues
'
' Description:   Updates a file from 1 byte to greater than 2gb with null
'                values.
'
' Parameters:    hFile - Numeric designator of file to be updated
'                curFileSize - Amount of data to be written to file
'
' Returns:       TRUE - File was successfully loaded
'                FALSE - An error occurred
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Original routine
' ***************************************************************************
Public Function LoadWithNullValues(ByVal hFile As Long, _
                                   ByVal curFilesize As Currency) As Boolean

    Dim lngDistanceToMove     As Long
    Dim lngDistanceToMoveHigh As Long
    
    LoadWithNullValues = False  ' Preset to bad ending
    
    ' If no file handle then leave
    If hFile < 1 Then
        Exit Function
    End If
    
    ' Calculate the size of the new file
    Size2Long curFilesize, lngDistanceToMove, lngDistanceToMoveHigh
            
    ' Set the file pointers to mark the size of the file
    If SetFilePointer(hFile, lngDistanceToMove, _
                      lngDistanceToMoveHigh, FILE_BEGIN) > 0 Then
                  
        ' Test to see if we can identify
        ' the end of the new file
        If SetEndOfFile(hFile) Then
            LoadWithNullValues = True  ' Successful finish
        End If
    End If

End Function
                              
                              
' ***************************************************************************
' ***                Internal prcedures and Functions                     ***
' ***************************************************************************

' ***************************************************************************
' Routine:       Size2Long
'
' Description:   This routine will work out the higher 32 bits. This code
'                looks like it could be done with a simple division, but
'                you have the problem of the IDE using longs. So, rather
'                than running the risk of the IDE using a long somewhere
'                in the calculations (tests have returned varied results
'                where the division is often 1 out on certain file sizes),
'                you may find a division method that will give the correct
'                value every time, but for now this method will suffice.
'
'                With your max filesize being 922,337 Gb, the highest
'                value that LongHigh will hold is 2,147,630, way below the
'                maximum positive value that a Long can hold. This means
'                that you do not need to monitor it.
'
' Parameters:    curFileSize - File size to be evaluated
'                lngLowOrder - The highest value this will hold is 2,147,483,647
'                lngHighOrder - The highest value this will hold is 2,147,630
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-Jan-2007  Richard Newcombe
'              Wrote routine
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Modified and documented
' ***************************************************************************
Private Sub Size2Long(ByVal curFilesize As Currency, _
                      ByRef lngLowOrder As Long, _
                      ByRef lngHighOrder As Long)

    ' Called by API_ReadFile()
    '           API_WriteFile()
    '           CreateBigFile()
    
    Dim curMaxLimit As Currency
    
    lngHighOrder = 0
    lngLowOrder = 0
        
    ' Because VB6 uses Longs to store numbers in the IDE,
    ' you have to work around it a little by adding the
    ' biggest positive number possible (2,147,483,647)
    ' repetitively until you get your wanted number.
    ' (2147483647 + 2147483647 + 1 = 4294967295).
    curMaxLimit = MAXLONG
    curMaxLimit = curMaxLimit + MAXLONG + 1

    ' If the filesize is smaller than 4 Gb, the Do loop
    ' does not execute. Between 4 and 8 Gb the Do loop
    ' executes once.  Between 8-12 Gb, it executes twice.
    Do Until curFilesize < curMaxLimit
    
        lngHighOrder = lngHighOrder + 1
        curFilesize = curFilesize - curMaxLimit
    
    Loop

    ' Take the remainder and decide whether it needs the
    ' Sign bit of the long to hold a value (&H80000000).
    ' If it's smaller than 2,147,483,648 (&H80000000
    ' Unsigned), you can pass the value directly to your
    ' Long (LongLow).  If not, you have to convert the
    ' value to the hex equivalent in Signed 32bit.
    If curFilesize > MAXLONG Then
        ' Larger than 2gb
        lngLowOrder = (curMaxLimit - (curFilesize - 1)) * -1
    Else
        lngLowOrder = CLng(curFilesize)
    End If

End Sub

' ***************************************************************************
' Routine:       Long2Size
'
' Description:   This routine will convert two Long values into one
'                Currency value.  The multiplication here does not
'                give any erroneous results, but note that the currency
'                type variable must be listed first; otherwise, VB will
'                try to use a Long type variable to temporally store
'                the result. (This is one of the minor issues in VB6.
'                When doing calculations, VB uses the same variable
'                type of your first variable in the calculation and not
'                the variable type of the destination variable. This
'                has been documented on several sites.)
'
' Parameters:    curFileSize - File size to be calculated
'                lngLowOrder - The highest value this will hold is 2,147,483,647
'                lngHighOrder - The highest value this will hold is 2,147,630
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-Jan-2007  Richard Newcombe
'              Wrote routine
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Renamed, modified and documented
' ***************************************************************************
Private Sub Long2Size(ByRef curFilesize As Currency, _
                      ByVal lngLowOrder As Long, _
                      ByVal lngHighOrder As Long)

    ' Called by CalcFileSize()
    
    Dim curMaxLimit As Currency
    
    ' Because VB6 uses Longs to store numbers in the IDE,
    ' you have to work around it a little by adding the
    ' biggest positive number possible (2,147,483,647)
    ' repetitively until you get your desired number.
    ' (2147483647 + 2147483647 + 1 = 4294967295).
    curMaxLimit = MAXLONG
    curMaxLimit = curMaxLimit + MAXLONG + 1

    curFilesize = curMaxLimit * CCur(lngHighOrder)
    
    If lngLowOrder < 0 Then
        curFilesize = curFilesize + (curMaxLimit + CCur(lngLowOrder + 1))
    Else
        curFilesize = curFilesize + lngLowOrder
    End If

End Sub

' ***************************************************************************
' Routine:       NumberToHex
'
' Description:   Convert a whole number to hex without leading zeroes
'
' Parameters:    curNumber - Number to be converted
'
' Returns:       Hex string
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 03-Mar-2008  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Private Function NumberToHex(ByVal curNumber As Currency) As String

    ' Called by CalcFileSize()
    
    Dim curHex As Currency
    Dim strHex As String
    
    Const HEX_BASE As Currency = 16@
    
    strHex = ""
    
    Do While curNumber > 0
        
        curHex = Fix(curNumber / HEX_BASE)
        curHex = curNumber - (curHex * HEX_BASE)
        
        Select Case curHex
               Case 10:   strHex = "A" & strHex
               Case 11:   strHex = "B" & strHex
               Case 12:   strHex = "C" & strHex
               Case 13:   strHex = "D" & strHex
               Case 14:   strHex = "E" & strHex
               Case 15:   strHex = "F" & strHex
               Case Else: strHex = CStr(curHex) & strHex
        End Select
        
        curNumber = Int(curNumber / HEX_BASE)
    
    Loop
    
    NumberToHex = strHex

End Function

' ***************************************************************************
' Routine:       FileExists
'
' Description:   Test to see if a file exists.
'
' Syntax:        FileExists("C:\Program Files\Desktop.ini")
'
' Parameters:    strFilename - Path\filename to be queried.
'
' Returns:       True or False
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' dd-mmm-1997  Bruce McKinney "Hardcore Visual Basic"
'              http://vb.mvps.org/hardweb/mckinney.htm
' ***************************************************************************
Private Function FileExists(ByVal strFileName As String) As Boolean
    
    ' Called by OpenReadOnly()
    '           CreateBigFile()
    
    Dim lngAttrib As Long
    
    On Error GoTo FileExists_Exit
    
    lngAttrib = GetFileAttributes(strFileName)

    If (lngAttrib <> INVALID_HANDLE_VALUE) Then
        FileExists = CBool((lngAttrib And vbDirectory) <> vbDirectory)
    End If

FileExists_Exit:

End Function