Untitled

ItsPingu

Jul 4th, 2025

345

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

FreeBasic 9.92 KB | None | 0 0

raw download clone embed print report

' Append data to uncompressed test.txt inside a ZIP (no external libs)
Type ZipFileEntry
filename As String
method As UShort
crc As UInteger
compSize As UInteger
uncompSize As UInteger
localHeaderOffset As UInteger
data As String
End Type
Function ReadUInt32(f As Integer) As UInteger
Dim As UInteger val
Dim As UByte b(3)
For i As Integer = 0 To 3
Get #f, , b(i)
Next
val = b(0) Or (b(1) << 8) Or (b(2) << 16) Or (b(3) << 24)
Return val
End Function
Function ReadUInt16(f As Integer) As UShort
Dim As UShort val
Dim As UByte b(1)
For i As Integer = 0 To 1
Get #f, , b(i)
Next
val = b(0) Or (b(1) << 8)
Return val
End Function
Function ReadString(f As Integer, length As Integer) As String
Dim As String s
Dim As UByte b
For i As Integer = 1 To length
Get #f, , b
s += Chr(b)
Next
Return s
End Function
' Find EOCD (End of central directory) from the end of file
Function FindEOCD(f As Integer) As UInteger
Dim As Integer filesize = Lof(f)
Dim As Integer maxSearch = Min(filesize, 65536)
Dim As Integer pos = filesize - maxSearch
Dim As UByte b1, b2, b3, b4
For offset As Integer = maxSearch To 0 Step -1
Seek #f, pos + offset
Get #f, , b1
Get #f, , b2
Get #f, , b3
Get #f, , b4
If b1 = &H50 And b2 = &H4B And b3 = &H05 And b4 = &H06 Then
Return pos + offset
End If
Next
Return 0
End Function
Sub AppendToUncompressedFileInZip(ByVal zipPath As String, ByVal targetFile As String, ByVal appendData As String, ByVal outputZip As String)
Dim As Integer f = FreeFile()
Open zipPath For Binary Access Read As #f
Dim As UInteger eocdPos = FindEOCD(f)
If eocdPos = 0 Then
Print "EOCD not found. Not a valid ZIP?"
Close #f
Exit Sub
End If
' Read EOCD (22 bytes min)
Seek #f, eocdPos + 4
Dim totalEntries As UShort = ReadUInt16(f)
Dim centralDirSize As UInteger = ReadUInt32(f)
Dim centralDirOffset As UInteger = ReadUInt32(f)
' Read central directory entries
Seek #f, centralDirOffset
Dim entries() As ZipFileEntry
Redim entries(totalEntries - 1)
For i As Integer = 0 To totalEntries - 1
Dim As UInteger sig = ReadUInt32(f)
If sig <> &H2014B50 Then ' Central dir file header signature 0x02014b50
Print "Invalid central directory signature"
Close #f
Exit Sub
End If
' Skip version made by(2), version needed(2), flags(2)
Seek #f, Seek(#f) + 6
Dim method As UShort = ReadUInt16(f)
' Skip mod time/date
Seek #f, Seek(#f) + 4
Dim crc As UInteger = ReadUInt32(f)
Dim compSize As UInteger = ReadUInt32(f)
Dim uncompSize As UInteger = ReadUInt32(f)
Dim fnameLen As UShort = ReadUInt16(f)
Dim extraLen As UShort = ReadUInt16(f)
Dim commentLen As UShort = ReadUInt16(f)
' Skip disk start(2), internal attr(2), external attr(4)
Seek #f, Seek(#f) + 10
Dim localHdrOffset As UInteger = ReadUInt32(f)
Dim fname As String = ReadString(f, fnameLen)
' Skip extra and comment
Seek #f, Seek(#f) + extraLen + commentLen
entries(i).filename = fname
entries(i).method = method
entries(i).crc = crc
entries(i).compSize = compSize
entries(i).uncompSize = uncompSize
entries(i).localHeaderOffset = localHdrOffset
Next
' Find target file index
Dim targetIdx As Integer = -1
For i As Integer = 0 To totalEntries - 1
If entries(i).filename = targetFile Then
targetIdx = i
Exit For
End If
Next
If targetIdx = -1 Then
Print "File not found in archive: "; targetFile
Close #f
Exit Sub
End If
' Read target file local header and data
Seek #f, entries(targetIdx).localHeaderOffset
Dim localSig As UInteger = ReadUInt32(f)
If localSig <> &H4034B50 Then ' Local file header signature 0x04034b50
Print "Invalid local file header signature"
Close #f
Exit Sub
End If
' Skip version needed(2), flags(2), method(2), time(2), date(2)
Seek #f, Seek(#f) + 10
Dim localCRC As UInteger = ReadUInt32(f)
Dim localCompSize As UInteger = ReadUInt32(f)
Dim localUncompSize As UInteger = ReadUInt32(f)
Dim localNameLen As UShort = ReadUInt16(f)
Dim localExtraLen As UShort = ReadUInt16(f)
Dim localName As String = ReadString(f, localNameLen)
' Read file data (uncompressed)
Dim As String fileData
Seek #f, Seek(#f) + localExtraLen
fileData = String(entries(targetIdx).compSize, Chr(0))
Get #f, , fileData
Close #f
' Check compression method = 0 (stored)
If entries(targetIdx).method <> 0 Then
Print "File is compressed; this method only works with uncompressed files."
Exit Sub
End If
' Append new data
fileData += appendData
' Recalculate CRC32 (simple, just demo: you can implement full CRC32 if needed)
' Here we'll keep old CRC to keep example simple.
' Update sizes
entries(targetIdx).compSize = Len(fileData)
entries(targetIdx).uncompSize = Len(fileData)
' Now rebuild the ZIP
Dim outf = FreeFile()
Open outputZip For Binary Access Write As #outf
Dim localOffsets(totalEntries - 1) As UInteger
Dim curOffset As UInteger = 0
' Write all local file headers + data (replace target file with new data)
For i As Integer = 0 To totalEntries - 1
localOffsets(i) = curOffset
' Local file header signature
Put #outf, , &H4034B50
' Version needed
Put #outf, , CType(20, UShort)
' Flags
Put #outf, , CType(0, UShort)
' Method
Put #outf, , entries(i).method
' Mod time/date
Put #outf, , mod_time
Put #outf, , mod_date
' CRC, sizes
Dim writeCRC As UInteger = entries(i).crc
Dim writeCompSize As UInteger = entries(i).compSize
Dim writeUncompSize As UInteger = entries(i).uncompSize
' If this is target file, update sizes and fake CRC
If i = targetIdx Then
writeCompSize = Len(fileData)
writeUncompSize = Len(fileData)
writeCRC = 0 ' TODO: calculate real CRC if you want
End If
Put #outf, , writeCRC
Put #outf, , writeCompSize
Put #outf, , writeUncompSize
' File name length and extra length
Put #outf, , CType(Len(entries(i).filename), UShort)
Put #outf, , CType(0, UShort)
' File name
Put #outf, , entries(i).filename
' File data
Dim writeData As String
If i = targetIdx Then
writeData = fileData
Else
' Open old ZIP and read data for this entry
Dim oldf = FreeFile()
Open zipPath For Binary Access Read As #oldf
Seek #oldf, entries(i).localHeaderOffset
' Skip local header
ReadUInt32(oldf) : Seek #oldf, Seek(oldf) + 26 ' Skip 26 bytes after signature
Dim nlen As UShort = ReadUInt16(oldf)
Dim nextra As UShort = ReadUInt16(oldf)
Seek #oldf, Seek(oldf) + nlen + nextra
Dim dataStr As String = String(entries(i).compSize, Chr(0))
Get #oldf, , dataStr
Close #oldf
writeData = dataStr
End If
Put #outf, , writeData
curOffset = Seek(#outf)
Next
' Write central directory
Dim centralDirStart = curOffset
For i As Integer = 0 To totalEntries - 1
Put #outf, , &H2014B50 ' Central dir signature
Put #outf, , CType(20, UShort) ' version made by
Put #outf, , CType(20, UShort) ' version needed
Put #outf, , CType(0, UShort) ' flags
Put #outf, , entries(i).method
Put #outf, , mod_time
Put #outf, , mod_date
Dim writeCRC As UInteger = entries(i).crc
Dim writeCompSize As UInteger = entries(i).compSize
Dim writeUncompSize As UInteger = entries(i).uncompSize
If i = targetIdx Then
writeCompSize = Len(fileData)
writeUncompSize = Len(fileData)
writeCRC = 0 ' TODO: real CRC
End If
Put #outf, , writeCRC
Put #outf, , writeCompSize
Put #outf, , writeUncompSize
Put #outf, , CType(Len(entries(i).filename), UShort)
Put #outf, , CType(0, UShort) ' extra length
Put #outf, , CType(0, UShort) ' comment length
Put #outf, , CType(0, UShort) ' disk number start
Put #outf, , CType(0, UShort) ' internal attr
Put #outf, , CType(0, UInteger) ' external attr
Put #outf, , localOffsets(i)
Put #outf, , entries(i).filename
Next
Dim centralDirEnd = Seek(#outf)
' Write EOCD
Put #outf, , &H6054B50
Put #outf, , CType(0, UShort) ' disk number
Put #outf, , CType(0, UShort) ' disk with central dir
Put #outf, , CType(totalEntries, UShort) ' entries on disk
Put #outf, , CType(totalEntries, UShort) ' total entries
Put #outf, , CType(centralDirEnd - centralDirStart, UInteger) ' central dir size
Put #outf, , CType(centralDirStart, UInteger) ' offset central dir
Put #outf, , CType(0, UShort) ' zip comment length
Close #outf
Print "Appended data to '"; targetFile; "' and saved as: "; outputZip
End Sub
' --- Example Usage ---
Dim as String zipFile = "input.zip"
Dim as String outputFile = "output.zip"
Dim as String targetFileInZip = "test.txt"
Dim as String dataToAppend = " <-- appended text"
AppendToUncompressedFileInZip(zipFile, targetFileInZip, dataToAppend, outputFile)

Add Comment

Please, Sign In to add comment