Page 2 of 2 FirstFirst 12
Results 41 to 61 of 61

Thread: VB6 - Huge (>2GB) File I/O Class

  1. #41
    Lively Member
    Join Date
    Feb 2012
    Posts
    106

    Re: VB6 - Huge (>2GB) File I/O Class

    Hello,

    Ok, but my question is to read bytes from the specific location and same for writing them back to another file.
    In the Class, we can read file like:

    Code:
    Set hbfFile = New HugeBinaryFile
    hbfFile.OpenFile "test.dat"
    But how to read bytes from the specific location?
    Do i need to use Seek first? Which option is correct of them-

    Code:
    hbfFile.SeekAbsolute
    hbfFile.SeekEnd
    hbfFile.Relative

    Thanks
    Regards,

  2. #42

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Huge (>2GB) File I/O Class

    If you want to move to the end after opening, call .SeekEnd().

    If you want to move to a specific byte position, call .SeekAbsolute() passing the 0-based byte offset from the beginning.

    If you want to move ahead or behind by a number of bytes, call .SeekRelative() passing a positive or negative offset from the current position.

    Both .ReadBytes() and .WriteBytes() update the file position by the number of bytes read or written.

    For more information look in your MSDN Library documentation for the API calls that this class uses. All legitimate versions of VB6 come with the MSDN Library CDs.

  3. #43
    Lively Member
    Join Date
    Feb 2012
    Posts
    106

    Re: VB6 - Huge (>2GB) File I/O Class

    Hello dilettante, Thanks

    I'v tried but still getting errors. Here's the codes i am using -

    Code:
    Option Explicit
    Private hbfFile As HugeBinaryFile
    
    Private Sub Command1_Click()
        Dim BB() As Byte
        
        Set hbfFile = Nothing
        Set hbfFile = New HugeBinaryFile
        
        hbfFile.OpenFile "D:\xp.vmd" '3 GB size
        
        hbfFile.SeekAbsolute 524288000 '500 Mb reading
        ReDim BB(1 To 524288000) '524288000= 500 mb
        hbfFile.ReadBytes BB
        If hbfFile.IsOpen Then hbfFile.CloseFile
    End Sub
    I am getting 2 error messages:

    1. run-time error '7':
    Out of memory


    2. After terminating Project and re-execute:
    Error opening file
    The process cannot acces the file because it is being used by another process.


    Where I'm doing wrong? Please suggest me anyone here..

    Thanks

  4. #44

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Huge (>2GB) File I/O Class

    Your first error is because there is a limit on how big the Byte array can be.

    I suggest you make it no larger than 512KB, and then after you Seek to the starting point do a series of 512KB reads and writes until you have copied almost everything. Finally Redim the array to fit any smaler leftover chunk at the end and read/write once more.

    Something like 256KB might even be better.

    The second problem occurs because the program aborts without closing the file (or files). This leaves a file handle open and it stays open until either the compiled EXE terminates or in the IDE the IDE must terminate. You might also use error trapping to catch any failure and then go to a "check for open, if open close the file" handler.

    At this point I think you probably need to start a separate question thread in the VB6 questions forum. You are having simple problems understanding how to write VB6 programs.

  5. #45
    Lively Member
    Join Date
    Feb 2012
    Posts
    106

    Re: VB6 - Huge (>2GB) File I/O Class

    Hello again,
    Ok that's enough for me on this topic, Problem solved after reducing the chunk size.

    Thanks & Regards

  6. #46
    New Member
    Join Date
    Mar 2008
    Posts
    13

    Re: VB6 - Huge (>2GB) File I/O Class

    Hello dilettante,
    I am trying to use your code in one of my projects. I have a few large files (greater than 2.5GB) and using your class I was able to scan and copy lines from the file. I just used your sample project and slightly modified it. This works absolutely fine except one problem. How can I start reading lines from a specific line position? I have 500,000 lines in my text file and I am only interested in the lines between 290,000 and 340,000.
    This code starts from line number 1 and takes almost 15 minutes to reach the lines that I require.... How can I force it to start reading lines at a specific position?
    Code:
    'Inside a loop or timer
        With htfIn
                Line = .ReadLine()
                txtLog.SelText = Line
                txtLog.SelText = vbNewLine
                currentlineNumber = currentlineNumber + 1
                labelReadProgress.Caption = "Reading: " & Format$(currentlineNumber, "#,##0")
                'htfOut.WriteLine Line
                DoEvents
        End With

  7. #47

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Huge (>2GB) File I/O Class

    Well, if you knew the starting position of the "line" (remembering that a "line" is an artificial abstraction, the file is a stream of bytes) you can seek to it and read from there.

    Without knowing that though (and there is no reason you would) you have little choice but to read forward counting lines as you go.

    You might use the SkipLines method passing n-1 to get to line n on he next read. That's about the only worthwhile improvement I can imagine though, and it won't be fantastically quicker.

    Sorry.

  8. #48
    New Member
    Join Date
    Mar 2008
    Posts
    13

    Re: VB6 - Huge (>2GB) File I/O Class

    Thanks for the reply....I have done one slight modification and there is significant improvement....
    txtLog.SelText = Line
    txtLog.SelText = vbNewLine

    I commented these lines (I know interaction with GUI should not have been done in the loop in the first place) but still the improvement was astonishing. Now I can loop through the complete file which btw has 470,880 lines and each line is roughly 5600 characters long in less than 1 minute. Without commenting the textbox related code it took almost 35 minutes.

  9. #49

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Huge (>2GB) File I/O Class

    Good point. GUI controls take a lot of processing to update and involve syncing with video hardware to avoid flicker. Making them invisible while updating them helps, but not updating them at all does wonders.

  10. #50
    New Member
    Join Date
    Dec 2013
    Posts
    1

    Re: VB6 - Huge (>2GB) Text and Binary File I/O Classes

    I wanted to thank the original author. I have been looking for a way to rapidly handle I/O on files larger than 2GB while staying enabled and without callbacks for years. This does it and is very fast. Thanks a bunch for this upload!! I wrote a more robust demo program around it and uploaded to PlanetSourceCode site for everyone to test with. It offers variable file size creation (writing) and file copy functions with status as it goes and the ability to stop it mid-function, demonstrating that it is enabled during operation. I tried many things and they all function as advertised. That is rare and the quality is great. Thanks again.

    Mike

    Quote Originally Posted by dilettante View Post
    I swear I did a search or two first but I hadn't seen this here.

    HugeBinaryFile.cls is a VB6 Class that is based on an old MS KB article for VB4.

    It works a bit like using Get#/Put# with Byte arrays, and supports absolute seeks to a byte position using a Currency value from 0 to far beyond the usual 2GB limit. It can also do seeks relative to the current file position accepting a signed Long value, and seek to EOF for appending. Its FileLen property returns the open file's length in bytes as a Currency value.

    Currency was used for convenience since huge files need a 64-bit position value. Since Currency values have an implied decimal point the class does scaling so that you can use 1 to mean 1 (1.0000) instead of using 0.0001 to mean byte 1.

    If you find this imperfect you can always modify the Class to accept and return a pair of unsigned Long values instead. In the end these can get pretty clumsy to work with though.

    I did a certain amount of testing, but I won't claim this code is bug-free.


    The Class is provided here bundled in a small demo project. To add it to your own projects simply copy the .cls file into your project folder and Add|File... to make it part of your project.


    It would be fairly easy to create another Class that wraps this one for doing text I/O.

    Look at the posts below for my HugeTextFile class.

  11. #51

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Huge (>2GB) File I/O Class

    Glad it is useful, but be sure to give credit to Microsoft. If I could find the old KB article online I'd provide a link.

  12. #52
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: VB6 - Huge (>2GB) File I/O Class

    Code:
    Private hbfFile As HugeBinaryFile
    Private hbfFilew As HugeBinaryFile
    Private bytBuf() As Byte
    Private bytBufencoded() As Byte
    
    Private lngBlocks As Long
    Dim MAX_BLOCKS As Long
    Dim lastbytes As Long
    Dim needlast As Boolean
    Dim factbyte As Currency
    
    Private Sub Command1_Click()
    
        On Error Resume Next
    
        factbyte = 1000000 ' = 1mb
    
        lngBlocks = 0
        lblRead.Caption = ""
        needlast = False
        Set hbfFile = New HugeBinaryFile
        Set hbfFilew = New HugeBinaryFile
    
        hbfFile.OpenFile "f:\test\1.mp4"
        
        Kill "f:\test\2.mp4"
        hbfFilew.OpenFile "f:\test\2.mp4"
        'hbfFilew.AutoFlush = True
        
        Caption = " Reading " _
           & Format$(hbfFile.FileLen, "##,###,###,###,##0") _
           & " bytes"
    
        'MAX_BLOCKS = CCur(hbfFile.FileLen \ factbyte)
        MAX_BLOCKS = CCur(Mid$(CStr(hbfFile.FileLen), 1, Len(CStr(hbfFile.FileLen)) - Len(CStr(factbyte)) + 1))
        lastbytes = CCur(hbfFile.FileLen) - CCur((MAX_BLOCKS * factbyte))
                  
        Timer1.Enabled = True
    End Sub
    
    
    Private Sub Timer1_Timer()
    
        If needlast = True Then
            ReDim bytBuf(1 To lastbytes)
        Else
        
            ReDim bytBuf(1 To factbyte)
        
        End If
        
        hbfFile.ReadBytes bytBuf
        
           
        If hbfFile.EOF Then
    
            Timer1.Enabled = False
            hbfFile.CloseFile
            Set hbfFile = Nothing
            hbfFilew.CloseFile
            Set hbfFilew = Nothing
        Else
            
            hbfFilew.WriteBytes bytBuf
            lngBlocks = lngBlocks + 1
            
            If lngBlocks + 1 > MAX_BLOCKS Then needlast = True
            
            If lngBlocks > MAX_BLOCKS Then
                lblRead.Caption = hbfFile.FileLen
            Else
                lblRead.Caption = CCur(lngBlocks) * CCur(UBound(bytBuf))
            End If
    
           
           
    
        End If
     
    End Sub
    i edited this class and i used aes encryption too, and tested over 3 gigabyte so result is :


    refrences used :
    HugeBinaryFile.cls + mdAesCtr.bas



    exe project:
    Attachment 184031
    download exe and mp4 tested full video:
    https://up.maralhost.com/download1504.html
    Last edited by Black_Storm; Feb 21st, 2022 at 06:10 AM. Reason: edited code

  13. #53
    New Member
    Join Date
    Jun 2021
    Posts
    2

    Re: VB6 - Huge (>2GB) File I/O Class

    Quote Originally Posted by Black_Storm View Post
    Code:
    Private hbfFile As HugeBinaryFile
    Private hbfFilew As HugeBinaryFile
    Private bytBuf() As Byte
    Private bytBufencoded() As Byte
    
    Private lngBlocks As Long
    Dim MAX_BLOCKS As Long
    Dim lastbytes As Long
    Dim needlast As Boolean
    Dim factbyte As Currency
    
    Private Sub Command1_Click()
    
        On Error Resume Next
    
        factbyte = 1000000 ' = 1mb
    
        lngBlocks = 0
        lblRead.Caption = ""
        needlast = False
        Set hbfFile = New HugeBinaryFile
        Set hbfFilew = New HugeBinaryFile
    
        hbfFile.OpenFile "f:\test\1.mp4"
        
        Kill "f:\test\2.mp4"
        hbfFilew.OpenFile "f:\test\2.mp4"
        'hbfFilew.AutoFlush = True
        
        Caption = " Reading " _
           & Format$(hbfFile.FileLen, "##,###,###,###,##0") _
           & " bytes"
    
        'MAX_BLOCKS = CCur(hbfFile.FileLen \ factbyte)
        MAX_BLOCKS = CCur(Mid$(CStr(hbfFile.FileLen), 1, Len(CStr(hbfFile.FileLen)) - Len(CStr(factbyte)) + 1))
        lastbytes = CCur(hbfFile.FileLen) - CCur((MAX_BLOCKS * factbyte))
                  
        Timer1.Enabled = True
    End Sub
    
    
    Private Sub Timer1_Timer()
    
        If needlast = True Then
            ReDim bytBuf(1 To lastbytes)
        Else
        
            ReDim bytBuf(1 To factbyte)
        
        End If
        
        hbfFile.ReadBytes bytBuf
        
           
        If hbfFile.EOF Then
    
            Timer1.Enabled = False
            hbfFile.CloseFile
            Set hbfFile = Nothing
            hbfFilew.CloseFile
            Set hbfFilew = Nothing
        Else
            
            hbfFilew.WriteBytes bytBuf
            lngBlocks = lngBlocks + 1
            
            If lngBlocks + 1 > MAX_BLOCKS Then needlast = True
            
            If lngBlocks > MAX_BLOCKS Then
                lblRead.Caption = hbfFile.FileLen
            Else
                lblRead.Caption = CCur(lngBlocks) * CCur(UBound(bytBuf))
            End If
    
           
           
    
        End If
     
    End Sub
    i edited this class and i used aes encryption too, and tested over 3 gigabyte so result is :


    refrences used :
    HugeBinaryFile.cls + mdAesCtr.bas



    exe project:
    Attachment 184031
    download exe and mp4 tested full video:
    https://up.maralhost.com/download1504.html
    Care to share the modified class?

  14. #54
    New Member
    Join Date
    Jun 2021
    Posts
    2

    Re: VB6 - Huge (>2GB) File I/O Class

    Care to share the modified class?

  15. #55
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: VB6 - Huge (>2GB) File I/O Class

    Quote Originally Posted by Arch_Stanton View Post
    Care to share the modified class?
    Everything Black_Storm has cobbled together concerning encryption can be found in the original thread (including an alternative to HugeBinaryFile class itself) so post there if you need any guidance.

    cheers,
    </wqw>

  16. #56
    Hyperactive Member
    Join Date
    Apr 2021
    Posts
    481

    Re: VB6 - Huge (>2GB) Text and Binary File I/O Classes

    Have been having issues with Dilettante's HBF class, though MOSTLY I am able to find workarounds for things...but there is ONE thing that has caused me problems, which I hope someone can help with.

    If I open a file and my app crashes (for instance if there's an error in my code) before I am able to .closefile the app is unable to be started again and reopen the same file because it seems there's still a lock in place for the file in the IDE. The only way I can fix this issue is by shutting the IDE down and opening it up again, which gets really annoying when you're trying to bugfix code...is there a way to unlock the file before trying to open it? I can't do a check to see if .IsOpen because it doesn't give me the option to tell it which file I think could be open, and it is specifically the file which is locked and not the IDE (though the IDE has locked the file, assumedly)

    I understand if this is more a filesystem/OS/IDE issue than one with the class, just wanted to know if there's an easy way to programmatically fix it

    Dilettante references this issue in #44, but I wonder if there has been any new ideas on ways to deal with it there? He also mentions error trapping, but aside from knowing "On Error" exists I have no experience with it, and I wonder if that would interfere with my debugging :-)
    Last edited by SmUX2k; Mar 3rd, 2024 at 03:52 PM.

  17. #57
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    Re: VB6 - Huge (>2GB) File I/O Class

    I have been having the same problem. When ever the program crashes (in the IDE or not), it leaves the file open. I am using file API, but I don't think that matters. The API requires the handle to the file in order to close it, and if the program crashes, that handle is gone. If the crash itself doesn't shut down the IDE, then I have to shut it down myself. In some cases, I actually have to reboot the system. Consequently, I have taken to working out the details in complex file routines in separate simulation packages, over which I have more control.

    I don't have the answer to your problem, but I am willing to work with you on it.

    J.A. Coutts

  18. #58
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: VB6 - Huge (>2GB) File I/O Class

    Quote Originally Posted by couttsj View Post
    I have been having the same problem.
    When ever the program crashes (in the IDE or not), it leaves the file open.
    In case dilettantes Class has an "automatic Handle-Cleanup" in Class_Terminate -
    then simply compiling his code into an externally referenced AX-Dll would help.

    If you want to test the behaviour of such an AX-Dll-FileClass without much fuss -
    the RC6 has a cStream and a cCSV-Class, which operate on that "auto-terminate"-principle.
    (havent seen a "file is still open"-warning in decades).

    Olaf

  19. #59
    Hyperactive Member
    Join Date
    Apr 2021
    Posts
    481

    Re: VB6 - Huge (>2GB) File I/O Class

    Quote Originally Posted by Schmidt View Post
    In case dilettantes Class has an "automatic Handle-Cleanup" in Class_Terminate -
    then simply compiling his code into an externally referenced AX-Dll would help.
    Thanks...but I have no idea how to do it...But, smart little me, I worked it out! Here's how I did it, for other people to follow...anyone should be able to follow it, if I did :-)

    1) Load the class on its own into VB
    2) Rename the project, NOT the class, "HugeBinaryFileDLL" (just so it is easy to recognise in the DLL list)
    3) Right click the project and go to properties. Set as ActiveX DLL, no startup object, leave the rest as-is
    4) The IMPORTANT bit (it seems)...click the class file and go to "instancing" and set it to something other than private...I chose GlobalMultiUse, I don't know if that is right or not.
    5) Compile as DLL, as normal...then reference the DLL in your app that usually uses it and you can remove the class file that usually did the work. I literally just did these and ran the app and it ran fine, just like if the class file was actually still there (as technically it is, just as a DLL).

    Confirmed that when my app crashes it I no longer get the error. And also confirmed that without doing #4 I wasn't even able to compile the DLL.

    I would post the DLL as that would save tons of time for everyone, but that is frowned upon here...also, you should know exactly what is in the DLL if at all possible, and this way you do!

  20. #60
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: VB6 - Huge (>2GB) File I/O Class

    Ok, I made some changes to Dil's HugeBinaryFile.cls to fix the problem mentioned above. Basically, it's only a problem when we're in the IDE. And, to summarize, the problem is, when you've got one of these big files open and you click the IDE's "Stop" button, the file doesn't get closed and the Class_Terminate event doesn't get raised. So, next time you run in the IDE, you get an "Already Open" error.

    If you exit the IDE, it cleans up, but that's a pain. So, I just saved our hFile in the registry. And, on each execution, I check the registry and make sure the file was previously closed. And, if it wasn't, I close it ... problem solved.

    The biggest advantage of this is that it allows us to just pull this class into our project (as opposed to any ActiveX DLL) and use it, and not be afraid of the "Stop" button.

    Here's my forked version of Dil's class:
    Code:
    Option Explicit
    '
    ' Tweaked by Elroy to fix IDE bug.
    '
    'HugeBinaryFile
    '==============
    '
    'A class for doing simple binary I/O on very large disk files
    '(well over the usual 2GB limit).  It only does I/O using Byte
    'arrays, and makes use of Currency values that are scaled to
    'whole numbers in places:
    '
    '   For a file of one byte the FileLen property returns 1.0000 as
    '   its value.
    '
    'Operation is similar in many ways to native VB Get#/Put# I/O, for
    'example the EOF property must be checked after a ReadBytes() call.
    'You must also Dim/Redim buffers to desired sizes before calling
    'ReadBytes() or WriteBytes().
    '
    'Short (signed Long) relative seeks and long (unsigned Currency)
    'absolute seeks from 0 may be done.
    '
    'AutoFlush may be set True to force buffer flushes on every write.
    'The Flush() method may be called explicitly if necessary.
    '
    
    Public Enum HBF_Errors
      HBF_UNKNOWN_ERROR = 45600
      HBF_FILE_ALREADY_OPEN
      HBF_OPEN_FAILURE
      HBF_SEEK_FAILURE
      HBF_FILELEN_FAILURE
      HBF_READ_FAILURE
      HBF_WRITE_FAILURE
      HBF_FILE_ALREADY_CLOSED
    End Enum
    
    Private Const HBF_SOURCE = "HugeBinaryFile"
    
    Private Const GENERIC_WRITE As Long = &H40000000
    Private Const GENERIC_READ As Long = &H80000000
    Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
    Private Const CREATE_ALWAYS = 2
    Private Const OPEN_ALWAYS = 4
    Private Const INVALID_HANDLE_VALUE = -1
    Private Const INVALID_SET_FILE_POINTER = -1
    Private Const INVALID_FILE_SIZE = -1
    
    Private Const FILE_BEGIN = 0, FILE_CURRENT = 1, FILE_END = 2
    
    Private Type MungeCurr
        Value As Currency
    End Type
    
    Private Type Munge2Long
        LowVal As Long
        HighVal As Long
    End Type
    
    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 GetFileSize Lib "kernel32" ( _
        ByVal hFile As Long, _
        lpFileSizeHigh 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 hFile As Long
    Private sFName As String
    Private fAutoFlush As Boolean
    Private fEOF As Boolean
    Private C As MungeCurr
    Private L As Munge2Long
    Private bIsInIDE As Boolean
    '
    
    Public Property Get AutoFlush() As Boolean
        RaiseErrorIfClosed
        AutoFlush = fAutoFlush
    End Property
    
    Public Property Let AutoFlush(ByVal NewVal As Boolean)
        RaiseErrorIfClosed
        fAutoFlush = NewVal
    End Property
    
    Public Property Get FileHandle() As Long
        RaiseErrorIfClosed
        FileHandle = hFile
    End Property
    
    Public Property Get FileLen() As Currency
        RaiseErrorIfClosed
        L.LowVal = GetFileSize(hFile, L.HighVal)
        If L.LowVal = INVALID_FILE_SIZE Then
            If Err.LastDllError Then RaiseError HBF_FILELEN_FAILURE
        End If
        LSet C = L
        FileLen = C.Value * 10000@
    End Property
    
    Public Property Get FileName() As String
        RaiseErrorIfClosed
        FileName = sFName
    End Property
    
    Public Property Get EOF() As Boolean
        RaiseErrorIfClosed
        EOF = fEOF
    End Property
    
    Public Property Get IsOpen() As Boolean
        IsOpen = hFile <> INVALID_HANDLE_VALUE
    End Property
    
    Public Sub CloseFile()
        RaiseErrorIfClosed
        CloseHandle hFile
        sFName = ""
        fAutoFlush = False
        fEOF = False
        hFile = INVALID_HANDLE_VALUE
        '
        ' Added by Elroy.
        ' And now we can delete our registry entry because we're closed.
        ' We use error trapping just in case we were tracing through this module when we clicked "Stop".
        ' We use the App.ThreadID in case multiple copies of the program are running.
        If bIsInIDE Then
            On Error Resume Next
                DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
            On Error GoTo 0
        End If
    End Sub
    
    Public Sub Flush()
        RaiseErrorIfClosed
        FlushFileBuffers hFile
    End Sub
    
    Public Sub OpenFile(ByVal OpenFileName As String)
        If hFile <> INVALID_HANDLE_VALUE Then
            RaiseError HBF_FILE_ALREADY_OPEN
        End If
        hFile = CreateFile(OpenFileName, GENERIC_WRITE Or GENERIC_READ, 0, _
                           0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
        If hFile = INVALID_HANDLE_VALUE Then
            RaiseError HBF_OPEN_FAILURE
        End If
        sFName = OpenFileName
        '
        ' Added by Elroy.
        ' And save our hFile so we can close it if we're in the IDE and clicked "Stop".
        ' We use the App.ThreadID in case multiple copies of the program are running.
        If bIsInIDE Then SaveSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle", hFile
    End Sub
    
    Public Function ReadBytes(ByRef Buffer() As Byte) As Long
        RaiseErrorIfClosed
        If ReadFile(hFile, _
                    Buffer(LBound(Buffer)), _
                    UBound(Buffer) - LBound(Buffer) + 1, _
                    ReadBytes, _
                    0) Then
            If ReadBytes = 0 Then
                fEOF = True
            End If
        Else
            RaiseError HBF_READ_FAILURE
        End If
    End Function
    
    Public Sub SeekAbsolute(ByVal Position As Currency)
        RaiseErrorIfClosed
        C.Value = Position / 10000@
        LSet L = C
        If SetFilePointer(hFile, L.LowVal, L.HighVal, FILE_BEGIN) _
            = INVALID_SET_FILE_POINTER Then
                If Err.LastDllError Then RaiseError HBF_SEEK_FAILURE
        End If
    End Sub
    
    Public Sub SeekEnd()
        RaiseErrorIfClosed
        If SetFilePointer(hFile, 0&, ByVal 0&, FILE_END) _
            = INVALID_SET_FILE_POINTER Then
                RaiseError HBF_SEEK_FAILURE
        End If
    End Sub
    
    Public Sub SeekRelative(ByVal Offset As Long)
        'Offset is signed.
        RaiseErrorIfClosed
        If SetFilePointer(hFile, Offset, ByVal 0&, FILE_CURRENT) _
            = INVALID_SET_FILE_POINTER Then
                RaiseError HBF_SEEK_FAILURE
        End If
    End Sub
    
    Public Function WriteBytes(Buffer() As Byte) As Long
        RaiseErrorIfClosed
        If WriteFile(hFile, _
                     Buffer(LBound(Buffer)), _
                     UBound(Buffer) - LBound(Buffer) + 1, _
                     WriteBytes, _
                     0) Then
            If fAutoFlush Then Flush
        Else
            RaiseError HBF_WRITE_FAILURE
        End If
    End Function
    
    Private Sub Class_Initialize()
        '
        ' Added by Elroy.
        ' Reworked this so that, when in the IDE, and we restart ...
        ' it still closes the file on the next run.
        ' We use the App.ThreadID in case multiple copies of the program are running.
        '
        Debug.Assert MakeTrue(bIsInIDE)
        '
        If bIsInIDE Then
            hFile = GetSetting(App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle", INVALID_HANDLE_VALUE)
            If hFile <> INVALID_HANDLE_VALUE Then
                CloseHandle hFile
                ' We use error trapping in case we were tracing through this code when we clicked "Stop".
                On Error Resume Next
                    DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
                On Error GoTo 0
                hFile = INVALID_HANDLE_VALUE
            End If
        Else
            hFile = INVALID_HANDLE_VALUE
        End If
    End Sub
    
    Private Function MakeTrue(ByRef b As Boolean) As Boolean
        MakeTrue = True: b = True
    End Function
    
    Private Sub Class_Terminate()
        '
        ' Added by Elroy.
        ' Reworked to delete our registry setting.
        ' We use the App.ThreadID in case multiple copies of the program are running.
        ' Just for clarity, went ahead and set hFile = INVALID_HANDLE_VALUE.
        '
        If hFile <> INVALID_HANDLE_VALUE Then
            CloseHandle hFile
            ' We use error trapping in case we were tracing through this code when we clicked "Stop".
            If bIsInIDE Then
                On Error Resume Next
                    DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
                On Error GoTo 0
            End If
            hFile = INVALID_HANDLE_VALUE
        End If
    End Sub
    
    Private Sub RaiseError(ByVal ErrorCode As HBF_Errors)
        Dim Win32Err As Long, Win32Text As String
    
        Win32Err = Err.LastDllError
        If Win32Err Then
            Win32Text = vbNewLine & "Error " & Win32Err & vbNewLine _
                      & DecodeAPIErrors(Win32Err)
        End If
        If IsOpen Then CloseFile
        Select Case ErrorCode
            Case HBF_FILE_ALREADY_OPEN
                Err.Raise HBF_FILE_ALREADY_OPEN, HBF_SOURCE, _
                    "File already open."
            Case HBF_OPEN_FAILURE
                Err.Raise HBF_OPEN_FAILURE, HBF_SOURCE, _
                    "Error opening file." & Win32Text
            Case HBF_SEEK_FAILURE
                Err.Raise HBF_SEEK_FAILURE, HBF_SOURCE, _
                    "Seek Error." & Win32Text
            Case HBF_FILELEN_FAILURE
                Err.Raise HBF_FILELEN_FAILURE, HBF_SOURCE, _
                    "GetFileSize Error." & Win32Text
            Case HBF_READ_FAILURE
                Err.Raise HBF_READ_FAILURE, HBF_SOURCE, _
                    "Read failure." & Win32Text
            Case HBF_WRITE_FAILURE
                Err.Raise HBF_WRITE_FAILURE, HBF_SOURCE, _
                    "Write failure." & Win32Text
            Case HBF_FILE_ALREADY_CLOSED
                Err.Raise HBF_FILE_ALREADY_CLOSED, HBF_SOURCE, _
                    "File must be open for this operation."
            Case Else
                Err.Raise HBF_UNKNOWN_ERROR, HBF_SOURCE, _
                   "Unknown error." & Win32Text
        End Select
    End Sub
    
    Private Sub RaiseErrorIfClosed()
        If hFile = INVALID_HANDLE_VALUE Then RaiseError HBF_FILE_ALREADY_CLOSED
    End Sub
    
    Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
        Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
        Dim strMsg As String, lngMsgLen As Long
    
        strMsg = Space$(256)
        lngMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
                                  ErrorCode, 0&, strMsg, 256&, 0&)
        If lngMsgLen > 0 Then
            DecodeAPIErrors = Left(strMsg, lngMsgLen)
        Else
            DecodeAPIErrors = "Unknown Error."
        End If
    End Function
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  21. #61
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: VB6 - Huge (>2GB) File I/O Class

    Btw, it's possible to just use Shell32 provided file streams from VB6 as COM based IUnknown references so that on pressing End button/statement the reference is Release'd by the IDE and the file handle gets closed automagically without extra hacks.

    The streams work with >2GB large (and even huge) files *and* support long filenames (can be above MAX_PATH) in Unicode (can be in arabic) on all versions of Windows as an added bonus.

    The impl code is pretty short as well w/ no additional typelibs (or thunks) and in client code one can just keep a reference to the actual stream instead of to the HugeBinaryFile instance so not much different.

    cheers,
    </wqw>

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width