Results 1 to 11 of 11

Thread: VB6 - Insert & Delete data from a file

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,802

    VB6 - Insert & Delete data from a file

    It was asked in one of the threads (here) how to insert data into a file without loosing (overriding) any data, and also how to delete data from a file resulting in a smaller file size.

    The theory is simple, when inserting data, you have to shift the data to the right from the position you plan to insert to, and insert the actual data to that position and for deleting, you have to shift the data to the left until the position of deletion, and then truncate the file.

    Here's an example how to insert data:

    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.     Dim FF As Integer
    5.    
    6.     ' Create some file as an example for testing...
    7.     FF = FreeFile
    8.     Open "C:\test_insert.txt" For Binary Access Read Write As FF
    9.     Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"
    10.     Close FF
    11.    
    12.    
    13.    
    14.     FF = FreeFile
    15.     Open "C:\test_insert.txt" For Binary Access Read Write As FF
    16.    
    17.     ' insert some data into the file
    18.     InsertData FF, "+-----+", 3
    19.    
    20.     Close FF
    21. End Sub
    22.  
    23. Private Sub InsertData(ByVal FileNum As Integer, DataToInsert As String, ByVal InsertPos As Long)
    24.     '
    25.     '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    26.     '  Original thread: [url]http://www.vbforums.com/showthread.php?t=433537[/url]
    27.     '
    28.  
    29.     Const cBuffSize As Long = 262144 ' 256 KBytes
    30.    
    31.     Dim Buffer() As Byte, BuffPos As Long
    32.    
    33.     ' Shift all data to the right
    34.    
    35.     If LOF(FileNum) - InsertPos < cBuffSize Then
    36.         ' we can do it in one copy, we don't need a loop
    37.        
    38.         ' resize the buffer so we don't copy too much (more than file size)
    39.         ReDim Buffer(LOF(FileNum) - InsertPos - 1)
    40.        
    41.         ' copy and paste the data to the new location
    42.         Get FileNum, InsertPos, Buffer
    43.         Put FileNum, InsertPos + Len(DataToInsert), Buffer
    44.     Else
    45.         ' we start from the end of the file
    46.         BuffPos = LOF(FileNum)
    47.        
    48.         ' we HAVE to shift from right to left,
    49.         ' otherwise we override important data
    50.        
    51.         Do Until BuffPos <= InsertPos
    52.             ' substract the buffer size from current position
    53.             BuffPos = BuffPos - cBuffSize
    54.            
    55.             If BuffPos < InsertPos Then
    56.                 ' we reached the last copy
    57.                 ' data passed the InsertPos position, so we have to
    58.                 ' resize the buffer so it does not go over InsertPos
    59.                
    60.                 ReDim Buffer(cBuffSize - (InsertPos - BuffPos) - 1)
    61.                 BuffPos = InsertPos
    62.             Else
    63.                 ReDim Buffer(cBuffSize - 1)
    64.             End If
    65.            
    66.             ' copy and paste the data to the new location
    67.             Get FileNum, BuffPos, Buffer
    68.             Put FileNum, BuffPos + Len(DataToInsert), Buffer
    69.         Loop
    70.     End If
    71.    
    72.     ' Insert the actual data
    73.     Put FileNum, InsertPos, DataToInsert
    74. End Sub
    And here is an example on how to delete data:
    VB Code:
    1. Option Explicit
    2.  
    3. Private Const GENERIC_READ_WRITE As Long = &HC0000000
    4. Private Const OPEN_EXISTING As Long = 3
    5. Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
    6. Private Const FILE_BEGIN As Long = 0
    7. Private Const NO_ERROR As Long = 0
    8.  
    9. Private Type SECURITY_ATTRIBUTES
    10.     nLength As Long
    11.     lpSecurityDescriptor As Long
    12.     bInheritHandle As Long
    13. End Type
    14.  
    15. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
    16.      ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    17.      ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, _
    18.      ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    19.      ByVal hTemplateFile As Long) As Long
    20. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    21. Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, _
    22.      lpFileSizeHigh As Long) As Long
    23. Private Declare Function SetFilePointer Lib "kernel32" ( _
    24.      ByVal hFile As Long, ByVal lDistanceToMove As Long, _
    25.      lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
    26. Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
    27.  
    28. Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
    29.      lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
    30.      lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
    31. Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
    32.      lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
    33.      lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
    34.  
    35. Private Declare Function GetLastError Lib "kernel32" () As Long
    36.  
    37.  
    38. Private Sub DeleteData(ByVal FileName As String, DeletePos As Long, DeleteLength As Long)
    39.     '
    40.     '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    41.     '  Original thread: [url]http://www.vbforums.com/showthread.php?t=433537[/url]
    42.     '
    43.     Const cBuffSize As Long = 262144 ' 256 KBytes
    44.    
    45.     Dim SA As SECURITY_ATTRIBUTES
    46.     Dim FHandle As Long
    47.     Dim FileLen As Double
    48.     Dim Buffer() As Byte, BuffPtr As Long
    49.    
    50.     Dim BytesToRead As Long, BytesRead As Long
    51.     Dim ReadPos As Double, WritePos As Double
    52.    
    53.     ' using API position 0 is the first byte, using VB functions position 1 is first byte
    54.     ' so decrement by one to use the same standard...
    55.     DeletePos = DeletePos - 1
    56.    
    57.     ' open the file
    58.     FHandle = CreateFile(FileName, GENERIC_READ_WRITE, 0, SA, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    59.    
    60.     ' get file size
    61.     FileLen = FileSizeDouble(FHandle)
    62.    
    63.     ' alocate memory
    64.     ReDim Buffer(cBuffSize - 1)
    65.    
    66.     ' get memory pointer
    67.     BuffPtr = VarPtr(Buffer(0))
    68.    
    69.     ' calculate read & write positions
    70.     WritePos = DeletePos
    71.     ReadPos = WritePos + DeleteLength
    72.    
    73.     ' shift the data to left
    74.    
    75.     Do Until ReadPos >= FileLen
    76.         ' calculate how much data to read/write
    77.         BytesToRead = dblMIN(cBuffSize, FileLen - ReadPos)
    78.        
    79.         ' copy and paste the data to the new location
    80.         SeekPosDouble FHandle, ReadPos
    81.         ReadFile FHandle, ByVal BuffPtr, BytesToRead, BytesRead, ByVal 0&
    82.        
    83.         SeekPosDouble FHandle, WritePos
    84.         WriteFile FHandle, ByVal BuffPtr, BytesRead, BytesRead, ByVal 0&
    85.        
    86.         WritePos = WritePos + BytesRead
    87.         ReadPos = WritePos + DeleteLength
    88.     Loop
    89.    
    90.     If WritePos < FileLen Then
    91.         ' Seek to where we need to truncate the file
    92.         SeekPosDouble FHandle, WritePos
    93.        
    94.         ' truncate the file
    95.         SetEndOfFile FHandle
    96.     End If
    97.    
    98.     Erase Buffer
    99.     If FHandle <> 0 Then CloseHandle FHandle
    100. End Sub
    101.  
    102. Private Function dblMIN(ByVal V1 As Double, ByVal V2 As Double) As Double
    103.     If V1 < V2 Then
    104.         dblMIN = V1
    105.     Else
    106.         dblMIN = V2
    107.     End If
    108. End Function
    109.  
    110. Private Function SeekPosDouble(ByVal FHandle As Long, ByVal NewPos As Double) As Boolean
    111.     Dim SizeLow As Long, SizeHigh As Long
    112.    
    113.     SizeLow = DoubleToLongs(NewPos, SizeHigh)
    114.    
    115.     SeekPosDouble = SeekPos(FHandle, SizeLow, SizeHigh)
    116. End Function
    117.  
    118. Private Function SeekPos(ByVal FHandle As Long, ByVal NewPos As Long, _
    119.                                    Optional ByVal PosHigh As Long = 0) As Boolean
    120.     Dim Ret As Long, dwError As Long
    121.    
    122.     Ret = SetFilePointer(FHandle, NewPos, PosHigh, FILE_BEGIN)
    123.    
    124.     If Ret = -1 Then
    125.         dwError = GetLastError
    126.         If dwError = NO_ERROR Then SeekPos = True
    127.     Else
    128.         SeekPos = True
    129.     End If
    130. End Function
    131.  
    132. Private Function FileSizeDouble(ByVal FHandle As Long) As Double
    133.     Dim SizeLow As Long, SizeHigh As Long
    134.    
    135.     If FHandle <> 0 Then SizeLow = GetFileSize(FHandle, SizeHigh)
    136.    
    137.     FileSizeDouble = CDbl(SizeHigh) * (2 ^ 32) + LongToDouble(SizeLow)
    138. End Function
    139.  
    140. Private Function LongToDouble(ByVal Lng As Long) As Double
    141.     If Lng And &H80000000 = 0 Then
    142.         LongToDouble = CDbl(Lng)
    143.     Else
    144.         LongToDouble = (Lng Xor &H80000000) + (2 ^ 31)
    145.     End If
    146. End Function
    147.  
    148. Private Function DoubleToLongs(ByVal Dbl As Double, ByRef SizeHigh As Long) As Long
    149.     Dim SizeLowDbl As Double
    150.    
    151.     SizeHigh = Fix(Dbl / 4294967296#)
    152.     SizeLowDbl = Dbl - SizeHigh * 4294967296#
    153.    
    154.     If SizeLowDbl > 2147483647 Then
    155.         DoubleToLongs = CLng(SizeLowDbl - 2147483648#) Xor &H80000000
    156.     Else
    157.         DoubleToLongs = SizeLowDbl
    158.     End If
    159. End Function
    160.  
    161. Private Sub Form_Load()
    162.     Dim FF As Integer
    163.    
    164.     ' Create some file as an example for testing...
    165.     FF = FreeFile
    166.     Open "C:\test_delete.txt" For Binary Access Read Write As FF
    167.     Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"
    168.     Close FF
    169.    
    170.     ' delete 2 bytes from the 3'rd position
    171.     ' it should decrease the file size by 2 bytes
    172.     DeleteData "C:\test_delete.txt", 3, 2
    173. End Sub
    Since I have to use API to truncate the file, I decided to write the whole thing in API...
    Last edited by CVMichael; Nov 27th, 2006 at 09:21 AM.

  2. #2
    "Digital Revolution"
    Join Date
    Mar 2005
    Posts
    4,471

    Re: VB6 - Insert & Delete data from a file

    Works real well. A little slow on large files but I'm not sure there's anyway around that.

    Have you tested the Seek statement in Binary mode to see if that works? ie:

    VB Code:
    1. Open File For Binary Access Write As #1
    2.     Seek #1, 3
    3.     Put #1, , "fjlsfsflsflsdlf"
    4. Close #1

    I know it won't work in append mode but it may work in binary mode...I don't have VB on this computer so I can't test it.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,802

    Re: VB6 - Insert & Delete data from a file

    I don't even need to test, I've been working with files for a very long time, and I can tell you for sure it won't work, it will override the existing data in the file, it will not move the data then insert...

    And regarding to speed... there is not much you can do, except write the whole thing in API, even then it won't be much of an increase in speed.

    Every time it has to insert data, it has to copy ALL the data after the point you want to insert and paste it at new location. It is expectable to take a long time...

    Maybe you might want to add a progress bar to that code, to make the waiting a little easyer, not that your gonna wait less... but sometimes it seems that it's faster if you look at the progress bar.
    Last edited by CVMichael; Oct 18th, 2006 at 10:37 AM.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,802

    Re: VB6 - Insert & Delete data from a file

    I just updated the first post to delete data too...

  5. #5
    Lively Member
    Join Date
    Nov 2006
    Posts
    122

    Re: VB6 - Insert & Delete data from a file

    i have a question

    VB Code:
    1. InsertData FF, "+-----+", 3

    inserts the data into the file so what does

    VB Code:
    1. Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"
    do?

    thanks

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,802

    Re: VB6 - Insert & Delete data from a file

    Hehe

    I think I know what you mean, you are probably wondering why all that code just to insert data into a file ?

    Actually, there is a big difference...

    The function I made will insert data into an already creaded file with data already in the file. It will insert data without overiding any other data, and without deleting any other data.

    For example, try this:
    First create a file with data in it:
    VB Code:
    1. Open File For Binary Access Write As #1
    2.     Put #1, , "abcdefgh"
    3. Close #1
    Now if you want to insert "123" into the file at position 2, like this:
    VB Code:
    1. Open File For Binary Access Write As #1
    2.     Put #1, 2, "123"
    3. Close #1
    What will you get ?
    Well... you get this
    "a123efgh"

    As you see, some of the data got deleted, where did the "bcd" go ? well, it looks like we lost some data...

    But if you use my function,
    VB Code:
    1. Open File For Binary Access Read Write As #1
    2.     InsertData 1, "123", 2
    3. Close #1
    You will get the result:
    "a123bcdefgh"

    As you can see, using my function will not delete any data, "bcd" is still there...

    So, my function really inserts data (moving other data), it will not overide any data

  7. #7
    Lively Member
    Join Date
    Nov 2006
    Posts
    122

    Re: VB6 - Insert & Delete data from a file

    alright i get it, thank you :-) nice code

  8. #8
    Hyperactive Member dsy5's Avatar
    Join Date
    Jul 2000
    Location
    Lockport, NY
    Posts
    362

    Re: VB6 - Insert & Delete data from a file

    I have found 3 flaws which cause the InsertData code posted to fail to recreate the file properly!
    The first two are minor as it lops off the last byte of the file; however, in a file other than text, this can be disasterous!
    The last error occurs in files longer than the buffer size(256Kbytes).
    This error causes the last buffer of data to overwrite previously written data, if the remaining data is less than the full buffer size on the last pass in the loop. This is a bad one.
    I'm not sure if you tested a large file with this code, but it really screwed up on a Flac audio file application I tried it with.
    I've made a few changes that have fixed these problems.

    Code:
    Private Sub InsertData(ByVal FileNum As Integer, DataToInsert() As Byte, ByVal InsertPos As Long)    '
    '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    '  Original thread: http://www.vbforums.com/showthread.php?t=433537
    '
    Const cBuffSize As Long = 262144 ' 256 KBytes
    Dim Buffer() As Byte, BuffPos As Long
    ' Shift all data to the right
    If LOF(FileNum) - InsertPos < cBuffSize Then
            ' we can do it in one copy, we don't need a loop
            ' resize the buffer so we don't copy too much (more than file size)
            ReDim Buffer(LOF(FileNum) - InsertPos)  '<=  Removed: - 1 to avoid losing the last byte!
            ' copy and paste the data to the new location
            Get FileNum, InsertPos, Buffer
            Put FileNum, InsertPos + UBound(DataToInsert()) + 1, Buffer
    Else
            ' we start from the end of the file
            BuffPos = LOF(FileNum) + 1 '<= Added: MUST add 1 to avoid losing the last byte!
            ' we HAVE to shift from right to left,
            ' otherwise we override important data
    
            Do Until BuffPos <= InsertPos
                'we HAVE to dimension this now or the Buffer will
                'remain 256K in length for the last read,
                'overwriting data we previously moved
                'it is Redimmed later if we need the full Buffer size
                ReDim Buffer(BuffPos - InsertPos - 1)         '<= Added            
                ' substract the buffer size from current position
                BuffPos = BuffPos - cBuffSize
                If BuffPos < InsertPos Then
                    ' we reached the last copy
                    ' data passed the InsertPos position, so we have to
                    ' resize the buffer so it does not go over InsertPos                                                ReDim Buffer(cBuffSize - (InsertPos - BuffPos) - 1)
                    BuffPos = InsertPos
                Else
                    ReDim Buffer(cBuffSize - 1)
                End If
                            ' copy and paste the data to the new location
                Get FileNum, BuffPos, Buffer
                Put FileNum, BuffPos + 1 + UBound(DataToInsert()), Buffer
            Loop
        End If
            ' Insert the actual data
        Put FileNum, InsertPos, DataToInsert
    End Sub
    I have changed the code otherwize to use a byte array as the source of the data to insert.
    You may wish to simply add the changes to the original code.

    Always remember to test your code!
    (No disrespect intended Michael, your code was a great help to me.)
    Donald Sy - VB (ab)user

  9. #9
    New Member
    Join Date
    Oct 2011
    Posts
    1

    Re: VB6 - Insert & Delete data from a file

    Hi all guys. Thanks for the code!

    @dsy5
    Code:
    ReDim Buffer(LOF(FileNum) - InsertPos)  '<=  Removed: - 1 to avoid losing the last byte!
    Correct!

    Code:
    BuffPos = LOF(FileNum) + 1 '<= Added: MUST add 1 to avoid losing the last byte!
    Wrong: LOF(fid) is the file size (1-based)

    Code:
    ReDim Buffer(BuffPos - InsertPos - 1)         '<= Added
    Useless: you don't use the array before resizing it again.

    The changes I did to are:
    1. moving the ReDim Buffer(cBuffSize - 1) outside the loop (since the size is eventually changed only at the last loop)
    2. saving the data size ubound(data)+1 on a variable outside the loop (to avoid useless operations)
    3. using also lbound(data) to consider both 0 and 1-based arrays
    resulting in the following:

    Code:
    Private Sub InsertData(ByVal fId As Integer, ByRef data() As Byte, ByVal position As Long)
        '
        '  Made by Michael Ciurescu (CVMichael from vbforums.com)
        '  Original thread: http://www.vbforums.com/showthread.php?t=433537
        '
        Const buffSize As Long = 262144 '256 KBytes
       
        Dim buff() As Byte
        Dim buffPos As Long
        Dim dataLen As Long
        
        ' prepare the data buffer for the insertion
        If (LOF(fId) - position < buffSize) Then
            ' we can do it in one copy, we don't need a loop
            ' resize the buffer so we don't copy too much (more than file size)
            ReDim buff(LOF(fId) - position)
            ' copy and paste the data to the new location
            Get fId, position, buff
            Put fId, position + (UBound(data) - LBound(data) + 1), buff
        Else
            ' we start from the end of the file
            buffPos = LOF(fId)
            ' resize the buffer outside the loop
            ReDim buff(buffSize - 1)
            ' save the data (to insert) size
            dataLen = UBound(data) - LBound(data) + 1 
            ' shift data starting from the end of the file
            Do Until (buffPos <= position)
                ' substract the buffer size from current position
                buffPos = buffPos - buffSize
                ' check if we have anough data to fill the whole buffer
                If (buffPos < position) Then
                    ' not enough data => resize the buffer
                    ReDim buff(buffSize - (position - buffPos) - 1)
                    buffPos = position
    '            Else
    '                ReDim Buffer(cBuffSize - 1)
                End If
                ' copy and paste the data to the new location
                Get fId, buffPos, buff
                Put fId, buffPos + dataLen, buff
            Loop
        End If
        ' insert the actual data
        Put fId, position, data
    End Sub

  10. #10

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,802

    Re: VB6 - Insert & Delete data from a file

    I'm surprised people are still using this...

  11. #11
    Fanatic Member Episcopal's Avatar
    Join Date
    Mar 2019
    Location
    Brazil
    Posts
    547

    Re: VB6 - Insert & Delete data from a file

    Quote Originally Posted by CVMichael View Post
    I'm surprised people are still using this...
    Yes....we are in 2022 seeing this ..... file (800Mb ) takes a few seconds...

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