-
Oct 17th, 2006, 09:48 PM
#1
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...
Last edited by CVMichael; Nov 27th, 2006 at 09:21 AM.
-
Oct 18th, 2006, 09:38 AM
#2
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:
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.
-
Oct 18th, 2006, 10:33 AM
#3
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.
-
Oct 19th, 2006, 10:02 PM
#4
Re: VB6 - Insert & Delete data from a file
I just updated the first post to delete data too...
-
Jan 16th, 2007, 08:22 PM
#5
Lively Member
Re: VB6 - Insert & Delete data from a file
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
-
Jan 16th, 2007, 09:14 PM
#6
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:
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
-
Jan 19th, 2007, 09:22 PM
#7
Lively Member
Re: VB6 - Insert & Delete data from a file
alright i get it, thank you :-) nice code
-
May 13th, 2008, 04:31 PM
#8
Hyperactive Member
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.)
-
Oct 8th, 2011, 03:25 AM
#9
New Member
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
-
Oct 8th, 2011, 02:10 PM
#10
Re: VB6 - Insert & Delete data from a file
I'm surprised people are still using this...
-
May 12th, 2022, 05:47 PM
#11
Re: VB6 - Insert & Delete data from a file
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...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|