03-06-2023, 07:41 PM
Let me introduce the PMF2 (that's my own file format) archiver. It is a compression program, the main advantage of which is that files can be compressed and decompressed using only QB64 directly from the source code. It allows you to view packed files and can unpack just one specific file or all files from the archive. It has a built-in feature that makes sure that if the unzipped file already exists on the hard drive, the new unzipped file will have a parenthesis with a number after the name, just like Windows does.
So you get the option to have many files in a single file with the option to extract just one specific one or all files.
Higher operations, such as updating a specific file in the archive, or deleting one file in the archive are not yet supported, I also saved something for another time, that's clear after all
Well, it's probably dawning on someone. So who asked how to add more files to the EXE? I'll add a new thread directly to that in a moment.
rewrite in source code file names for your correct files in array FL for trying!
So you get the option to have many files in a single file with the option to extract just one specific one or all files.
Higher operations, such as updating a specific file in the archive, or deleting one file in the archive are not yet supported, I also saved something for another time, that's clear after all
Well, it's probably dawning on someone. So who asked how to add more files to the EXE? I'll add a new thread directly to that in a moment.
rewrite in source code file names for your correct files in array FL for trying!
Code: (Select All)
Type Header ' Header 1
ID As String * 4 ' file format signature PMF2
Files_Total As Long ' how much files container contains
End Type
Type File_List ' Header 2
FileNameLEN As _Unsigned _Byte 'Lenght for file name (example: Untitled.bas = file name lenght = 12)
Compress As _Unsigned _Byte ' Compression. 0 = not used, 1 = used (_INFLATE$)
Offset As Long ' Area in file (offset) where start this file data
BlockSize As Long ' Byte size (how much bytes is used for this file in PMF2 container, size after compression if used)
End Type
Dim Shared PMF2H As Header
ReDim Shared PMF2FL(0) As File_List 'each added file has its own index in this field
Const Show = -1
Const Unpack_All = 0
Dim FL(13) As String ' add here your own files for test it. Array can not have NONE empty records and must start from zero AND ALL RECORDS IN ARRAY FL() MUST BE VALID, or program automaticaly end, because file not exists.
FL(0) = "mrakyM.gif"
FL(1) = "NEW jezis.gif"
FL(2) = "NEW jezisek.gif"
FL(3) = "NEW sane.gif"
FL(4) = "NEW skret.gif"
FL(5) = "NEW sob.gif"
FL(6) = "New sprez.gif"
FL(7) = "NEWest1.gif"
FL(8) = "NEWest2.gif"
FL(9) = "NEWest3.gif"
FL(10) = "NEWest4.gif"
FL(11) = "NEWest5.gif"
FL(12) = "test.mp3"
FL(13) = "mech.ogg" '!all 13 records must contains valid file names! of course your limit for this array size (all files size) is limited just by your RAM size (tested)
' if you add here some 1.3 GB movies, is possible it crash with message OUT OF MEMORY, but.... why add so much? Solution for so big file but exists:
' Break really big file down into smaller units and put it back together as you unpack. But I didn't deal with that here.
Pack_PMF2 "Pmf2test2023", FL() ' create Pmf2test2023.pmf2 file container
UnPack_PMF2 "Pmf2test2023.pmf2", Show ' just read heads from created file Pmf2test and show you, which files are in PMF2 container and compressed file size in archive pmf2
Sleep
UnPack_PMF2 "Pmf2test2023.pmf2", Unpack_All ' Extract all files from PMF2 container (now is set to add parentheses and number if file already exists on harddrive)
UnPack_PMF2 "Pmf2test2023.pmf2", 2 ' Unpack just file nr.2 from archive
'BUT - You can also extract just one file from archive, not all at once: First look, which number is file, you need extract - use UnPack_PMF2 "Pmf2test.pmf2", Show
' look to left to "Pos". Now add this number and use it (for example for file 3 in PMF2) UnPack_PMF2 "Pmf2test.pmf2", 3
' next options be added later, but is released now, for free use for you all, so all can do Christmas theme :)
' So if you can package many files into one file... who asked about how to add multiple files to an EXE file, eh?
End
Sub UnPack_PMF2 (ArchiveName As String, METHOD As _Byte)
'method: -1 = show files in PMF2 file
' 0 = UnPack all files from PMF2 file
' > 0 = Unpack file writed in this position in PMF2 file (-1) - use record number printed in Show mode
If _FileExists(ArchiveName) Then
FF = FreeFile
Open ArchiveName For Binary As FF
Get FF, , PMF2H ' read head 1
If PMF2H.ID = "PMF2" Then
If PMF2H.Files_Total > -1 Then
ReDim As File_List PMF2FL(PMF2H.Files_Total)
Get FF, , PMF2FL() ' read head 2
ReDim As String Names(PMF2H.Files_Total)
For ReadFileNames = 0 To PMF2H.Files_Total ' read files names in file
N$ = Space$(PMF2FL(ReadFileNames).FileNameLEN)
Get FF, , N$
Names(ReadFileNames) = N$
N$ = ""
Next
Select Case METHOD ' This is information block (Show)
Case -1
Print "Pos. File name Compressed Size in PMF2 file [bytes]"
Print "-----------------------------------------------------------------"
For ReadContent = 0 To PMF2H.Files_Total
F_Name$ = Names(ReadContent)
If Len(F_Name$) > 15 Then F_Name$ = Mid$(F_Name$, 1, 12) + "..."
If PMF2FL(ReadContent).Compress Then F_Compress$ = "Yes" Else F_Compress$ = "No"
F_Size& = PMF2FL(ReadContent).BlockSize
ddd = Len(LTrim$(Str$(ReadContent)))
Print LTrim$(Str$(ReadContent + 1)) + "."; Spc(4 - ddd); F_Name$; Spc(18 - Len(F_Name$) + ddd); F_Compress$; Spc(12); F_Size&
If ReadContent Mod 18 = 0 And ReadContent > 0 Then
Print "Press any key for next..."
Sleep
Cls
Print "Pos. File name Compressed Size in PMF2 file [bytes]"
Print "-----------------------------------------------------------------"
End If
Next
Case 0 ' extract it
For UnPack = 0 To PMF2H.Files_Total
If _FileExists(Names(UnPack)) Then 'add automaticaly parentheses and number, if file exists
u = 0
Do Until _FileExists(Names(UnPack)) = 0
Dot = InStr(1, Names(UnPack), ".") - 1
Test$ = Mid$(Names(UnPack), 1, Dot) + "(" + _Trim$(Str$(u) + ")") + Right$(Names(UnPack), PMF2FL(UnPack).FileNameLEN - Dot)
If _FileExists(Test$) = 0 Then Names(UnPack) = Test$
Test$ = ""
u = u + 1
Loop
End If
EF = FreeFile
Open Names(UnPack) For Binary As EF
N$ = Space$(PMF2FL(UnPack).BlockSize)
Get FF, , N$
If PMF2FL(UnPack).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
Put EF, , Rec$
N$ = ""
Rec$ = ""
Close EF
Next UnPack
Case Is > 0 ' unpack just one concrete file
Fi = METHOD - 1
If Fi > UBound(Names) Then Print "Invalid record add as parameter for Unpack_PMF2 SUB!": Sleep 3: End
If _FileExists(Names(Fi)) Then 'add automaticaly parentheses and number, if file exists
u = 0
Do Until _FileExists(Names(Fi)) = 0
Dot = InStr(1, Names(Fi), ".") - 1
Test$ = Mid$(Names(Fi), 1, Dot) + "(" + _Trim$(Str$(u) + ")") + Right$(Names(Fi), PMF2FL(Fi).FileNameLEN - Dot)
If _FileExists(Test$) = 0 Then Names(Fi) = Test$
Test$ = ""
u = u + 1
Loop
End If
EF = FreeFile
Open Names(Fi) For Binary As EF
N$ = Space$(PMF2FL(Fi).BlockSize)
Seek FF, PMF2FL(Fi).Offset
Get FF, , N$
If PMF2FL(Fi).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
Put EF, , Rec$
N$ = ""
Rec$ = ""
Close EF
End Select
Else
Print "Invalid record: Number of files in PMF2 file: "; PMF2H.Files_Total: Sleep 3: End
End If
Else
Print "Invalid PMF2 file format. ": Sleep 3: End
End If
Else
Print "PMF2 file: "; ArchiveName$; " not exists. Can not continue.": Sleep 3: End
End If
End Sub
Sub Pack_PMF2 (ArchiveName As String, FileList() As String) 'Array in input contains file names for add to archive
If LCase$(Right$(ArchiveName, 5)) <> ".pmf2" Then ArchiveName$ = ArchiveName$ + ".pmf2"
PMF2H.ID = "PMF2"
PMF2H.Files_Total = UBound(FileList)
Dim Binaries(PMF2H.Files_Total) As String, Size As Long, C As _Byte
Dim Names(PMF2H.Files_Total) As String, Begin As Long
ReDim PMF2FL(PMF2H.Files_Total) As File_List
FF = FreeFile
For Names_And_Sizes = 0 To PMF2H.Files_Total
If _FileExists(FileList(Names_And_Sizes)) Then
Open FileList(Names_And_Sizes) For Binary As FF
Size = LOF(FF) 'if is copression not used, is block size the same as file size
test$ = Space$(Size)
Get #FF, , test$
Close #FF
Compressed$ = _Deflate$(test$)
If Len(Compressed$) < Size Then Binaries(Names_And_Sizes) = Compressed$: C = 1: Size = Len(Compressed$) Else Binaries(Names_And_Sizes) = test$: C = 0
PMF2FL(Names_And_Sizes).BlockSize = Size 'This Size and previous is different, if compression is used, or not (row 200)
Compressed$ = ""
test$ = ""
PMF2FL(Names_And_Sizes).FileNameLEN = Len(FileList(Names_And_Sizes))
Names(Names_And_Sizes) = FileList(Names_And_Sizes)
PMF2FL(Names_And_Sizes).Compress = C
PMF2FL(Names_And_Sizes).Offset = 0&
Else Print "Error: Can not add file "; FileList(Names_And_Sizes); " to archive, because this file not exists. Operation aborted!": Sleep 3: End
End If
Next
If _FileExists(ArchiveName$) Then Kill ArchiveName$ 'Here is next place for upgrade (dialog File exists: Replace / Rename / Skip / Add files) - now set for rewrite [PMF2 file with the same name!]
Open ArchiveName$ For Binary As FF
Put #FF, , PMF2H
BytePos = Seek(FF)
Put #FF, , PMF2FL()
'insert files names to PMF2
For NameIt = 0 To PMF2H.Files_Total
n$ = Names(NameIt)
Put #FF, , n$
Next
n$ = ""
'insert start offsets and files binary data
For starts = 0 To PMF2H.Files_Total
Begin = Seek(FF)
PMF2FL(starts).Offset = Begin 'record real End Offsets sizes
n$ = Binaries(starts)
Put #FF, , n$
n$ = ""
Next
'upgrade END OFFSETs info for all files in PMF2 in head2
Put #FF, BytePos, PMF2FL() ' Replace Head 2 - now contains also end offsets for files in PMF2
Close #FF
End Sub