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:

Option Explicit
 
Private Sub Form_Load()
    Dim FF As Integer
    
    ' Create some file as an example for testing...
    FF = FreeFile
    Open "C:\test_insert.txt" For Binary Access Read Write As FF
    Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"
    Close FF
    
    
    
    FF = FreeFile
    Open "C:\test_insert.txt" For Binary Access Read Write As FF
    
    ' insert some data into the file
    InsertData FF, "+-----+", 3
    
    Close FF
End Sub
 
Private Sub InsertData(ByVal FileNum As Integer, DataToInsert As String, ByVal InsertPos As Long)
    '
    '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    '  Original thread: [url]http://www.vbforums.com/showthread.php?t=433537[/url]
    '
 
    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 - 1)
        
        ' copy and paste the data to the new location
        Get FileNum, InsertPos, Buffer
        Put FileNum, InsertPos + Len(DataToInsert), Buffer
    Else
        ' we start from the end of the file
        BuffPos = LOF(FileNum)
        
        ' we HAVE to shift from right to left,
        ' otherwise we override important data
        
        Do Until BuffPos <= InsertPos
            ' 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 + Len(DataToInsert), Buffer
        Loop
    End If
    
    ' Insert the actual data
    Put FileNum, InsertPos, DataToInsert
End Sub

And here is an example on how to delete data:

VB Code:

Option Explicit
 
Private Const GENERIC_READ_WRITE As Long = &HC0000000
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_BEGIN As Long = 0
Private Const NO_ERROR As Long = 0
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _ 
     ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ 
     ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, _ 
     ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ 
     ByVal hTemplateFile 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 SetFilePointer Lib "kernel32" ( _ 
     ByVal hFile As Long, ByVal lDistanceToMove As Long, _ 
     lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _ 
     lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _ 
     lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _ 
     lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _ 
     lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
 
Private Declare Function GetLastError Lib "kernel32" () As Long
 
 
Private Sub DeleteData(ByVal FileName As String, DeletePos As Long, DeleteLength As Long)
    '
    '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    '  Original thread: [url]http://www.vbforums.com/showthread.php?t=433537[/url]
    '
    Const cBuffSize As Long = 262144 ' 256 KBytes
    
    Dim SA As SECURITY_ATTRIBUTES
    Dim FHandle As Long
    Dim FileLen As Double
    Dim Buffer() As Byte, BuffPtr As Long
    
    Dim BytesToRead As Long, BytesRead As Long
    Dim ReadPos As Double, WritePos As Double
    
    ' using API position 0 is the first byte, using VB functions position 1 is first byte
    ' so decrement by one to use the same standard...
    DeletePos = DeletePos - 1
    
    ' open the file
    FHandle = CreateFile(FileName, GENERIC_READ_WRITE, 0, SA, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    
    ' get file size
    FileLen = FileSizeDouble(FHandle)
    
    ' alocate memory
    ReDim Buffer(cBuffSize - 1)
    
    ' get memory pointer
    BuffPtr = VarPtr(Buffer(0))
    
    ' calculate read & write positions
    WritePos = DeletePos
    ReadPos = WritePos + DeleteLength
    
    ' shift the data to left
    
    Do Until ReadPos >= FileLen
        ' calculate how much data to read/write
        BytesToRead = dblMIN(cBuffSize, FileLen - ReadPos)
        
        ' copy and paste the data to the new location
        SeekPosDouble FHandle, ReadPos
        ReadFile FHandle, ByVal BuffPtr, BytesToRead, BytesRead, ByVal 0&
        
        SeekPosDouble FHandle, WritePos
        WriteFile FHandle, ByVal BuffPtr, BytesRead, BytesRead, ByVal 0&
        
        WritePos = WritePos + BytesRead
        ReadPos = WritePos + DeleteLength
    Loop
    
    If WritePos < FileLen Then
        ' Seek to where we need to truncate the file
        SeekPosDouble FHandle, WritePos
        
        ' truncate the file
        SetEndOfFile FHandle
    End If
    
    Erase Buffer
    If FHandle <> 0 Then CloseHandle FHandle
End Sub
 
Private Function dblMIN(ByVal V1 As Double, ByVal V2 As Double) As Double
    If V1 < V2 Then
        dblMIN = V1
    Else
        dblMIN = V2
    End If
End Function
 
Private Function SeekPosDouble(ByVal FHandle As Long, ByVal NewPos As Double) As Boolean
    Dim SizeLow As Long, SizeHigh As Long
    
    SizeLow = DoubleToLongs(NewPos, SizeHigh)
    
    SeekPosDouble = SeekPos(FHandle, SizeLow, SizeHigh)
End Function
 
Private Function SeekPos(ByVal FHandle As Long, ByVal NewPos As Long, _
                                   Optional ByVal PosHigh As Long = 0) As Boolean
    Dim Ret As Long, dwError As Long
    
    Ret = SetFilePointer(FHandle, NewPos, PosHigh, FILE_BEGIN)
    
    If Ret = -1 Then
        dwError = GetLastError
        If dwError = NO_ERROR Then SeekPos = True
    Else
        SeekPos = True
    End If
End Function
 
Private Function FileSizeDouble(ByVal FHandle As Long) As Double
    Dim SizeLow As Long, SizeHigh As Long
    
    If FHandle <> 0 Then SizeLow = GetFileSize(FHandle, SizeHigh)
    
    FileSizeDouble = CDbl(SizeHigh) * (2 ^ 32) + LongToDouble(SizeLow)
End Function
 
Private Function LongToDouble(ByVal Lng As Long) As Double
    If Lng And &H80000000 = 0 Then
        LongToDouble = CDbl(Lng)
    Else
        LongToDouble = (Lng Xor &H80000000) + (2 ^ 31)
    End If
End Function
 
Private Function DoubleToLongs(ByVal Dbl As Double, ByRef SizeHigh As Long) As Long
    Dim SizeLowDbl As Double
    
    SizeHigh = Fix(Dbl / 4294967296#)
    SizeLowDbl = Dbl - SizeHigh * 4294967296#
    
    If SizeLowDbl > 2147483647 Then
        DoubleToLongs = CLng(SizeLowDbl - 2147483648#) Xor &H80000000
    Else
        DoubleToLongs = SizeLowDbl
    End If
End Function
 
Private Sub Form_Load()
    Dim FF As Integer
    
    ' Create some file as an example for testing...
    FF = FreeFile
    Open "C:\test_delete.txt" For Binary Access Read Write As FF
    Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"
    Close FF
    
    ' delete 2 bytes from the 3'rd position
    ' it should decrease the file size by 2 bytes
    DeleteData "C:\test_delete.txt", 3, 2
End Sub

Since I have to use API to truncate the file, I decided to write the whole thing in API...

Works real well. :thumb: 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:

Open File For Binary Access Write As #1
    Seek #1, 3
    Put #1, , "fjlsfsflsflsdlf"
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.

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.

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

i have a question

VB Code:

InsertData FF, "+-----+", 3

inserts the data into the file so what does

VB Code:

Put FF, , "01234567890123456789012345678901234567890123456789012345678901234567890123456789"

do?

thanks

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:

Open File For Binary Access Write As #1
    Put #1, , "abcdefgh"
Close #1

Now if you want to insert "123" into the file at position 2, like this:

VB Code:

Open File For Binary Access Write As #1
    Put #1, 2, "123"
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:

Open File For Binary Access Read Write As #1
    InsertData 1, "123", 2
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

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

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.)

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

---

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

Quote:

---

Originally Posted by CVMichael

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

---

Yes....we are in 2022 seeing this ..... file (800Mb ) takes a few seconds...