+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: Petr (https://qb64phoenix.com/forum/forumdisplay.php?fid=52)
+---- Thread: Files packer/unpacker to one file (/showthread.php?tid=1532)
Files packer/unpacker to one file - Petr - 03-06-2023
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!
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 SubFiles packer/unpacker to one file UPGRADE - Petr - 03-13-2023
I'm releasing the promised upgrade to my PMF2 file decompressor. This only applies to those using QB64PE version 3.6.0 and above, this will not work on older versions.
So. Now you can extract the archive to RAM without the files ever being written to the hard drive. Thanks to the new option of the LoadImage command, it is now possible to take images directly from a PMF2 archive, unpack them into memory without using the hard disk, and then use them in the normal way.
The program creates a field in the RAM memory called PMF2Files and has the following structure:
Type PMF2Files
FileName As String
FileData As String
End Type
So, as you can see, a file name is also available for each record, for better orientation. The file name always corresponds to the specific file data. I love this.
If you use this version of the program (only the unpacker was modernized), this can of course be used in conjunction with adding and unpacking the archive directly from the EXE file, the procedure remained the same, only the Unpack_PMF2 call must use new parameters - as in the attached sample. I would like to point out that in order to unpack a specific file into RAM memory, the number 30000 must be added to its position in the PMF2 file (this is also in the sample).
Hey developers, you make dreams come true before they are spoken! Really very good job!
You can test it as it works, in attachment is in ZIP format created PMF2 archive file.
Download it, unpack ZIP to folder with this source and compile it in QB64PE 3.6.0
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
Type PMF2Files
FileName As String
FileData As String
End Type
ReDim Shared PMF2Files(0) As PMF2Files
Dim Shared PMF2H As Header
ReDim Shared PMF2FL(0) As File_List 'each added file has its own index in this field
Const MemoryAll = 30000
Const Show = -1
Const Unpack_All = 0
'-------------- THIS ALL IS NOT NEED FOR UNPACKING ------------------ -it is here for show you, how is archive file created
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.
'
'UnPack_PMF2 "Pmf2Test2023.pmf2", 12 - extract FL(11) from previous list, for unpacking one file, always drive by index on left side created with SHOW parameter: UnPack_PMF2 "Pmf2test2023.pmf2", Show
'Pack_PMF2 "Pmf2test2023", FL() ' create Pmf2test2023.pmf2 file container
'---------------------------------------------------------------------
UnPack_PMF2 "Pmf2test2023.pmf2", Show 'Show files in archive
Sleep
UnPack_PMF2 "pmf2test2023.pmf2", 30001 'extract fist record to RAM not to harddrive
image& = _LoadImage(PMF2Files(0).FileData, 32, "MEMORY")
Screen _NewImage(1024, 768, 32)
Cls , &HFFFFFF00
' just read heads from created file Pmf2test and show you, which files are in PMF2 container and compressed file size in archive pmf2
_PutImage , image&
Print "Unpacking just first file from PMF2 to RAM complete."
Sleep 3
'so extracting one file work. Try extract all files to memory!
'first delete records from my array from previous extracting to memory:
ReDim PMF2FL(0) As File_List
UnPack_PMF2 "Pmf2Test2023.pmf2", MemoryAll
Screen _NewImage(1024, 768, 32)
For ShowAll = 0 To UBound(PMF2FL) - 1
_PrintMode _KeepBackground
Color &HFF000000
Select Case UCase$(Right$(PMF2Files(ShowAll).FileName$, 3))
Case "JPG", "PNG", "TGA", "BMP", "PSD", "GIF", "HDR", "PIC", "PNM", "PCX"
i& = _LoadImage(PMF2Files(ShowAll).FileData, 32, "MEMORY")
Cls , &HFFFFFF00
_PutImage (1, 1), i&
_PrintString (1, 1), "File extracted to RAM from PMF2 archive WITHOUT WRITE TO HARDDRIVE: " + PMF2Files(ShowAll).FileName
Sleep 3
_FreeImage i&
End Select
Next
_PrintMode _FillBackground
Color &HFFFFFFFF
Print "And as last - extracting TO HARDDRIVE file mech.ogg (Merry Christmas)."
UnPack_PMF2 "Pmf2Test2023.pmf2", 14 'and as in previous version - you still can extract files also to harddrive - this extract last OGG file from archive to harddrive.
' for unpacking this concrete file to RAM must be used UnPack_PMF2 "Pmf2Test2023.pmf2", 30014 - just add 30000
'UnPack_PMF2 "Pmf2test2023.pmf2", Unpack_All ' Extract all files from PMF2 container TO HARDDRIVE (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 TO HARDDRIVE
'UnPack_PMF2 "Pmf2test2023.pmf2", MemoryAll ' Extract all files from PMF2 container TO RAM ARRAY, nothing to HardDrive
'UnPack_PMF2 "Pmf2test2023.pmf2", 30002 ' Unpack just file nr.2 from archive TO RAM ARRAY
'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 Long)
' 30000 = do not extract files to harddrive, but ALL FILES as long strings to array PMF2Files() - option for program compiled in QB64PE 3.6.0 and higher
' 30001 = extract just file 1 to RAM to array PMF2Files as one long string
' -1 = show files in PMF2 file
' 0 = UnPack all files from PMF2 file
'> 0 < 30 000 = Unpack file writed in this position in PMF2 file - 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 30000 ' extract it TO RAM (array PMF2files AS STRING() ) for ALL files in archive
For UnPack = 0 To PMF2H.Files_Total
N$ = Space$(PMF2FL(UnPack).BlockSize)
Get FF, , N$
If PMF2FL(UnPack).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
PMF2Files(pmf2_i).FileName = Names(UnPack)
PMF2Files(pmf2_i).FileData = Rec$
pmf2_i = pmf2_i + 1
ReDim _Preserve PMF2Files(pmf2_i) As PMF2Files
N$ = ""
Rec$ = ""
Next UnPack
Case 30001 To 60000 'extract one file TO RAM (information in block with parameter SHOW + 30.000 -> so for extracting file 1 from PMF2 to RAM use Unpack_PMF2 ("Archive.pmf2", 30001)
Fi = METHOD - 30001
If Fi > UBound(Names) Then Print "Invalid record add as parameter for Unpack_PMF2 SUB!": Sleep 3: End
N$ = Space$(PMF2FL(Fi).BlockSize)
Seek FF, PMF2FL(Fi).Offset
Get FF, , N$
If PMF2FL(Fi).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
PMF2Files(pmf2_i).FileName = Names(Fi)
PMF2Files(pmf2_i).FileData = Rec$
pmf2_i = pmf2_i + 1
ReDim _Preserve PMF2Files(pmf2_i) As PMF2Files
N$ = ""
Rec$ = ""
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 0 To 29999 ' unpack just one concrete file, maximum files in archive limited to 29999 files
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 SubRE: Files packer/unpacker to one file - Petr - 03-19-2023
We have here next, this time a greatly improved version of the PMF2 compressor / decompressor. I worked on it for a few days, always in my free time. The PMF2 output of this version is not backward compatible with the previous version, but just change the FileNameLen data type in the File_List field. This version is intended for the command line, but can also be used internally for your program in QB64.
So what are our options here:
(assume the program is compiled as a PMF2.EXE file
PMF2 -a file.txt archive ----> this add file file.txt to archive.pmf2
PMF2 -a archive.pmf2 *.* ----> this add all files in directory to archive.pmf2, all mask form can be used.
PMF2 -u file.txt archive ----> upgrade file file.txt in archive.pmf2 with file the same name in current directory (file.txt)
PMF2 -f music.mp3 archive ----> find if file music.mp3 exists in PMF2 archive and return this record index
PMF2 -fr 4 archive ----> find what file name contains 4th record in PMF2 archive and return this name
PMF2 -ren image.gif archive ----> run renaming dialog, ask for new name and then rename file in PMF2 archive
PMF2 -del image.pcx archive----> delete file image.pcx in archive.pmf2
PMF2 -delrec 5 archive ----> delete file in 5.th position in archive.pmf2
PMF2 -l archive ----> list archive.pmf2 to screen and show files in archive
PMF2 -uaf archive ----> unpack archive.pmf2 to harddrive (all files from archive)
PMF2 -uf filename archive ----> unpack file from archive.pmf2 to harddrive (can be filename in archive or also file record number) - one file
PMF2 -? ----> show this help for command$
Of course, the possibility of unpacking PMF2 files into RAM remained, the command in QB64 UnPack2Mem is used for this, but for logical reasons it is not represented from the command line. Despite the fact that I mainly tried for maximum functionality, if you encounter a problem, please write to me here. Hope you find this program useful.
If you need to also pack subdirectories into the archive, this is currently only possible by entering the full path via QB64 (everyone will cough on that), and this is precisely the modernization path that I will deal with in the next few days.
Code: (Select All)
Option _Explicit
'-----------------------------------------------------------------
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 Long ' 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
Type PMF2Files
FileName As String
FileData As String
End Type
ReDim Shared PMF2Files(0) As PMF2Files
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 All = 0
'in this version array FL(0) must NOT be full, as you see, just 0 to 9 is used, but array UBOUND is 20
'What's new:
'-Add next files to exists PMF2 archive AddFiles "Archive.PMF2", FileArray() as String
'-Update packed file in PMF2 archive UpdateFile "Archive.PMF2", "FileName"; UpdateRec "Archive.PMF2", RecordNumber
'-Delete file in packed PMF2 archive DeleteFile "Archive.PMF2", "FileName"; DeleteRec "Archive.PMF2", RecordNumber
'-Rename file in packed PMF2 archive RenameFile "Archive.PMF2", "FileName"; RenameRec "Archive.PMF2", RecordNumber
'-List files packed in PMF2 to screen ListFiles "Archive.PMF2"
'-Find fast, if file is in PMF2 archive or his record number GetRec ("Archive.PMF2", "RecordNumber") - return FileName as string;
' GetRec ("Archive.PMF2", "FileName") - return record number as string
'-Unpack File (>1) or files (0) to RAM {struct PMF2Files} Unpack2Mem "Archive.PMF2", num: 0 here = unpack all files, or if positive number, unpack just this record to RAM
'-Unpack File (>1) or Files (0) to Harddrive Unpack2HDD "Archive.PMF2", num: 0 = all files from archive, or if positive number, unpack just this record to harddrive
If Len(Command$) Then
Cmnd
End If
Sub AddFiles (ArchiveName As String, ArrayWithFileNames() As String)
AddToPMF2 ArchiveName, ArrayWithFileNames()
End Sub
Sub PackPMF2 (ArchiveName As String, ArrayWithFileNames() As String)
Pack_PMF2 ArchiveName, ArrayWithFileNames()
End Sub
Sub UpdateFile (ArchiveName As String, FileName As String)
Dim As Long FileRecNr
FileRecNr = 90000 + Val(PMF2Record$(ArchiveName$, FileName$))
Print "Updating file "; FileName; " in archive "; ArchiveName
UnPack_PMF2 ArchiveName$, FileRecNr
End Sub
Sub UpdateRec (ArchiveName$, FileRecNr As Integer)
If FileRecNr < 1 Or FileRecNr > 29999 Then Print "UpdateRec: Invalid FileRecNr value. ": End
Dim As Long FRN
FRN = FileRecNr + 90000
UnPack_PMF2 ArchiveName$, FRN
End Sub
Sub DeleteFile (ArchiveName As String, FileName As String)
Dim As Long FileRecNr
FileRecNr = 60000 + Val(PMF2Record$(ArchiveName$, FileName$))
UnPack_PMF2 ArchiveName$, FileRecNr
End Sub
Sub DeleteRec (ArchiveName As String, FileRec As Integer)
If FileRec < 1 Or FileRec > 29999 Then Print "DeleteRec: Invalid FileRecNr value. ": End
Dim As Long FRN
FRN = FileRec + 60000
Print "Deleting record nr."; FileRec; "from archive "; ArchiveName$
UnPack_PMF2 ArchiveName$, FRN
End Sub
Sub RenameFile (ArchiveName As String, FileName As String)
Dim As Long FileRecNr
FileRecNr = 150000 + Val(PMF2Record$(ArchiveName$, FileName$))
UnPack_PMF2 ArchiveName, FileRecNr
End Sub
Sub RenameRec (ArchiveName As String, FileRec As Integer)
If FileRec < 1 Or FileRec > 29999 Then Print "RenameRec: Invalid FileRec value. ": End
UnPack_PMF2 ArchiveName, FileRec + 150000
End Sub
Sub ListFiles (ArchiveName As String)
' If Right$(ArchiveName, 5) <> ".pmf2" Then ArchiveName = ArchiveName + ".pmf2"
UnPack_PMF2 ArchiveName, -1
End Sub
Sub Unpack2Mem (ArchiveName As String, AllorOne)
If AllorOne < 0 Or AllorOne > 29999 Then Print "UnPack2Mem: Invalid AllOrOne value (0 to 29999)": End
If AllorOne = 0 Then
UnPack_PMF2 ArchiveName, 30000
Else
UnPack_PMF2 ArchiveName, 30000 + AllorOne
End If
End Sub
Sub UnPack2HDD (ArchiveName As String, AllOrOne)
If AllOrOne < 0 Or AllOrOne > 29999 Then Print "UnPack2HDD: Invalid AllOrOne value (0 to 29999)": End
If AllOrOne = 0 Then
UnPack_PMF2 ArchiveName, 0
Else
UnPack_PMF2 ArchiveName, AllOrOne
End If
End Sub
Function PMF2Record$ (archive$, record$) 'find if in PMF2 archive exist file Record$
PMF2Record$ = "" 'no match, file / record not found
Dim As Long frf, R, Names, W, t
Dim As String S
frf = FreeFile
If _FileExists(archive$) Then
Open archive$ For Binary As frf
Get frf, , PMF2H
If PMF2H.ID <> "PMF2" Then Print "Invalid PMF2 file format.": Sleep 3: End
R& = PMF2H.Files_Total
ReDim PMF2FL(R&) As File_List
Get frf, , PMF2FL()
Dim N(R&) As String
For Names = 0 To R&
S$ = Space$(PMF2FL(Names).FileNameLEN)
Get frf, , S$
N(Names) = S$
Next Names
Close frf
W = Val(record$) - 1
If W > -1 And W <= R& Then PMF2Record$ = N(W) 'if is numeric value used as record$, function return file name, if found
For t = 0 To R&
If UCase$(record$) = UCase$(N(t)) Then PMF2Record$ = Str$(t + 1): Exit Function 'if is filename used as record$, function return this record number (as string), if found
Next
Else
Print "Archive PMF2 file "; archive$; " not found.": Sleep 3: End
End If
End Function
Sub UnPack_PMF2 (ArchiveName As String, METHOD As Long)
' 30000 = do not extract files to harddrive, but ALL FILES as long strings to array PMF2Files() - option for program compiled in QB64PE 3.6.0 and higher
' 30001 to 60000 = extract just file 1 to RAM to array PMF2Files as one long string
' 61001 to 90000 = Delete 1 file from archive (this number - 60000
' -1 = show files in PMF2 file
' 0 = UnPack all files from PMF2 file
'> 0 < 30 000 = Unpack file writed in this position in PMF2 file - use record number printed in Show mode
Dim As Long FF, MYFF, ReadFileNames, UnPack, PMF2_i, Fi, DeletedRecord, RamDisc_I, NameIt, Starts, Begin, FF3, BytePos, FreeRam, UpdateRecord
Dim As String N, Rec, Uf
If _FileExists(ArchiveName) Then
FF = FreeFile
Open ArchiveName For Binary As FF
MYFF = 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 30000 ' extract it TO RAM (array PMF2files AS STRING() ) for ALL files in archive
For UnPack = 0 To PMF2H.Files_Total
N$ = Space$(PMF2FL(UnPack).BlockSize)
Get FF, , N$
If PMF2FL(UnPack).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
PMF2Files(PMF2_i).FileName = Names(UnPack)
PMF2Files(PMF2_i).FileData = Rec$
PMF2_i = PMF2_i + 1
ReDim _Preserve PMF2Files(PMF2_i) As PMF2Files
N$ = ""
Rec$ = ""
Next UnPack
Case 30001 To 60000 'extract one file TO RAM (information in block with parameter SHOW + 30.000 -> so for extracting file 1 from PMF2 to RAM use Unpack_PMF2 ("Archive.pmf2", 30001)
Fi = METHOD - 30001
If Fi > UBound(Names) Then Print "Invalid record add as parameter for Unpack_PMF2 SUB!": Sleep 3: End
N$ = Space$(PMF2FL(Fi).BlockSize)
Seek FF, PMF2FL(Fi).Offset
Get FF, , N$
If PMF2FL(Fi).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
PMF2Files(PMF2_i).FileName = Names(Fi)
PMF2Files(PMF2_i).FileData = Rec$
PMF2_i = PMF2_i + 1
ReDim _Preserve PMF2Files(PMF2_i) As PMF2Files
N$ = ""
Rec$ = ""
Case 60001 To 90000 'delete one file in archive PMF2
DeletedRecord = METHOD - 60001
Type RamDisc
Binars As _MEM
FileName As String
Compressed As _Byte
End Type
Dim RamDisc(PMF2H.Files_Total - 1) As RamDisc
Dim FileList2(PMF2H.Files_Total - 1) As File_List
' Dim As Long UnPack, RamDisc_I, NameIt, Starts, Begin 'asi taky stacilo k oprave - pri vymazani nektere soubory v PMF2 zacaly hlasit nulovou velikost na disku pred DIM
For UnPack = 0 To PMF2H.Files_Total
If UnPack = DeletedRecord Then GoTo here
FileList2(RamDisc_I).FileNameLEN = PMF2FL(UnPack).FileNameLEN
FileList2(RamDisc_I).Compress = PMF2FL(UnPack).Compress
FileList2(RamDisc_I).Offset = 0& 'doplnit po zapisu
FileList2(RamDisc_I).BlockSize = PMF2FL(UnPack).BlockSize
RamDisc(RamDisc_I).Binars = _MemNew(PMF2FL(UnPack).BlockSize)
RamDisc(RamDisc_I).FileName = Names(UnPack)
N$ = Space$(FileList2(RamDisc_I).BlockSize)
Seek #FF, PMF2FL(UnPack).Offset
Get #FF, , N$
_MemPut RamDisc(RamDisc_I).Binars, RamDisc(RamDisc_I).Binars.OFFSET, N$
N$ = ""
RamDisc_I = RamDisc_I + 1
here:
Next UnPack
Dim Header2 As Header
Header2.ID = "PMF2"
Header2.Files_Total = UBound(RamDisc)
FF3 = FreeFile
If _FileExists("___NEW_PMF2.pmf2") Then Kill "___NEW_PMF2.pmf2"
Open "___NEW_PMF2.pmf2" For Binary As FF3
Put #FF3, , Header2
BytePos = Seek(FF3)
Put #FF3, , FileList2()
'insert files names to PMF2
For NameIt = 0 To PMF2H.Files_Total - 1
N$ = RamDisc(NameIt).FileName
Put #FF3, , N$
Next
N$ = ""
'insert start offsets and files binary data
For Starts = 0 To PMF2H.Files_Total - 1
Begin = Seek(FF3)
FileList2(Starts).Offset = Begin 'record real End Offsets sizes
N$ = Space$(FileList2(Starts).BlockSize)
_MemGet RamDisc(Starts).Binars, RamDisc(Starts).Binars.OFFSET, N$
Put #FF3, , N$
N$ = ""
Next
'upgrade END OFFSETs info for all files in PMF2 in head2
Put #FF3, BytePos, FileList2() ' Replace Head 2 - now contains also end offsets for files in PMF2
Close #FF3
Rem JobUpg
Close
Kill ArchiveName
Name "___NEW_PMF2.pmf2" As ArchiveName
'uvolnit ramku....
For FreeRam = 0 To PMF2H.Files_Total - 1
_MemFree RamDisc(FreeRam).Binars
Next FreeRam
Erase RamDisc
Erase FileList2
Rem otestovano a zda se byti v poradki
Case 90001 To 120000: Rem Upgrade record in archive /both files, in archive and on hard drive must be the same name, or use option for add next record to archive
Rem reserved pro Upgrade konkretniho souboru to probehne tak, jako odebrani souboru, jen v miste kdy dojde k prekoceni konkretniho zanamu,
Rem bude stavajici zaznam nacten souborem stejneho jmena z disku a tim bude nahrazen puvodni zaznam v PMF2
UpdateRecord = METHOD - 90001
Dim RamDisc(PMF2H.Files_Total) As RamDisc
Rem tohle bude stejny Dim FileList2(PMF2H.Files_Total - 1) As File_List
Dim As Long Uff, compr
For UnPack = 0 To PMF2H.Files_Total
If UnPack = UpdateRecord Then
Uff = FreeFile
Open Names(UpdateRecord) For Binary As #Uff
Uf$ = Space$(LOF(Uff))
Get Uff, , Uf$
If Len(_Deflate$(Uf$)) < Len(Uf$) Then Rec$ = _Deflate$(Uf$): compr = 1 Else Rec$ = Uf$: compr = 0
RamDisc(UnPack).Binars = _MemNew(Len(Rec$))
RamDisc(UnPack).FileName = Names(UnPack)
_MemPut RamDisc(UnPack).Binars, RamDisc(UnPack).Binars.OFFSET, Rec$
Rem aktualizovat take pmf2fl.offset a pmf2fl.blocksize
PMF2FL(UnPack).BlockSize = Len(Rec$)
Rec$ = ""
GoTo Updated
End If
RamDisc(UnPack).Binars = _MemNew(PMF2FL(UnPack).BlockSize)
RamDisc(UnPack).FileName = Names(UnPack)
N$ = Space$(PMF2FL(UnPack).BlockSize)
Seek #FF, PMF2FL(UnPack).Offset
Get #FF, , N$
_MemPut RamDisc(UnPack).Binars, RamDisc(UnPack).Binars.OFFSET, N$
N$ = ""
Updated:
Next UnPack
Rem bude stejny Dim Header2 As Header
Rem bude stejny Header2.ID = "PMF2"
Rem bude stejny Header2.Files_Total = UBound(RamDisc)
FF3 = FreeFile
If _FileExists("___NEW_PMF2.pmf2") Then Kill "___NEW_PMF2.pmf2"
Open "___NEW_PMF2.pmf2" For Binary As FF3
Put #FF3, , PMF2H
BytePos = Seek(FF3)
Put #FF3, , PMF2FL()
'insert files names to PMF2
For NameIt = 0 To PMF2H.Files_Total
N$ = RamDisc(NameIt).FileName
Put #FF3, , N$
Next
N$ = ""
'insert start offsets and files binary data
For Starts = 0 To PMF2H.Files_Total
Begin = Seek(FF3)
PMF2FL(Starts).Offset = Begin 'record real End Offsets sizes
N$ = Space$(PMF2FL(Starts).BlockSize)
_MemGet RamDisc(Starts).Binars, RamDisc(Starts).Binars.OFFSET, N$
Put #FF3, , N$
N$ = ""
Next
'upgrade END OFFSETs info for all files in PMF2 in head2
Put #FF3, BytePos, PMF2FL() ' Replace Head 2 - now contains also end offsets for files in PMF2
Close #FF3
Rem JobUpg
Close
Kill ArchiveName
Name "___NEW_PMF2.pmf2" As ArchiveName
'uvolnit ramku....
For FreeRam = 0 To PMF2H.Files_Total - 1
_MemFree RamDisc(FreeRam).Binars
Next FreeRam
Erase RamDisc
Case 150001 To 180000
'rename file in PMF2
Dim As Long OldLenght, NewLenght, RenRec, DeltaRec, Recalc, test, ffo 'definice datovych typu opravila to, ze pri rename se nejakym souborum velikost smrskla na nulu
Dim As String FileData, NewName
RenRec = METHOD - 150001
FileData$ = Space$(LOF(FF) - Seek(FF))
Get FF, , FileData$
ask7:
Print "Input new file name for rename file in PMF2 archive ("; Names(RenRec); ") or press enter for quit.";
Input NewName$
If NewName$ = "" Then Close: System
For test = 0 To PMF2H.Files_Total
If UCase$(NewName$) = UCase$(Names(test)) Then Print "This name is already used.": GoTo ask7
Next
OldLenght = Len(Names(RenRec))
NewLenght = Len(NewName$)
DeltaRec = OldLenght - NewLenght
Names(RenRec) = NewName$
PMF2FL(RenRec).FileNameLEN = NewLenght
Close FF
ffo = FreeFile
Open ArchiveName$ For Output As ffo
Close ffo
Open ArchiveName$ For Binary As FF
Put FF, , PMF2H
For Recalc = 0 To PMF2H.Files_Total
PMF2FL(Recalc).Offset = PMF2FL(Recalc).Offset - DeltaRec
Next
Put FF, , PMF2FL()
For NameIt = 0 To PMF2H.Files_Total
Put FF, , Names(NameIt)
Next
Put FF, , FileData$
Close FF
Case -1
Dim As Long LastRecord, Fg, G, F, UsedSizeInPmf, i, SizeB, U, Dot
Dim As Single CompressRatio
Dim As String Compress, C_FileName, S, EFE
Print "+--------+----------------------+-----+-------------+-------------+----------+"
LastRecord = PMF2H.Files_Total
Print "| Pos. | File Name |Cmprs| PMF2 size | File size | Ratio |"
Print "+--------+----------------------+-----+-------------+-------------+----------+"
ReDim ExtractedSizes(LastRecord) As Long
For Fg = 0 To LastRecord
N$ = Space$(PMF2FL(Fg).BlockSize)
Seek FF, PMF2FL(Fg).Offset
Get FF, , N$
ExtractedSizes(Fg) = Len(_Inflate$(N$))
Next Fg
G = 0
For F = 0 To LastRecord
G = G + 1
If PMF2FL(F).Compress Then Compress$ = "Yes" Else Compress$ = "No"
C_FileName$ = Names(F)
UsedSizeInPmf& = PMF2FL(F).BlockSize
Print Tab(1); "|";
Print Space$(4 - Len(Str$(i))); LTrim$(Str$(F + 1) + ".");
Print Tab(10); "|";
If Len(C_FileName$) > 18 Then C_FileName$ = Mid$(C_FileName$, 1, 15) + "..."
Print Tab(12); C_FileName$;
Print Tab(33); "|";
If Len(Compress$) > 3 Then Compress$ = Mid$(Compress$, 1, 3): Rem tady bude YES nebo NO
Print Tab(35) + Compress$;
Print Tab(39); "|";
S$ = Str$(UsedSizeInPmf&)
If Len(S$) > 10 Then S$ = ">9999999": Rem tady bude velikost souboru a je moznost upgradu - prepocet velikosti na B, KB, MB, GB a TB
Print Tab(41) + S$; " B";
Print Tab(53); "|";
If Compress$ = "No" Then ' velikost souboru po rozbaleni (dle hlavy PMF2)
SizeB& = UsedSizeInPmf&
Else
SizeB& = ExtractedSizes(F)
End If
S$ = Str$(SizeB&)
If Len(S$) > 10 Then S$ = ">9999999": Rem tady bude velikost souboru a je moznost upgradu - prepocet velikosti na B, KB, MB, GB a TB
Print Tab(55) + S$; " B";
Print Tab(67); "|";
Rem posleni sloupec bude kompresni pomer, tedy velikost po rozbaleni deleno stem krat velikost v archivu
CompressRatio = Int((UsedSizeInPmf& / SizeB&) * 100)
If UsedSizeInPmf& = SizeB& Then CompressRatio = 100
S$ = Str$(CompressRatio)
If Len(S$) > 5 Then S$ = "> 999": Rem tady bude velikost souboru a je moznost upgradu - prepocet velikosti na B, KB, MB, GB a TB
Print Tab(69) + S$; "%";
Print Tab(78); "|";
If F = LastRecord Then
Print "+--------+----------------------+-----+-------------+-------------+----------+"
Print "End of archive. Press any key for quit."
Sleep
End If
If G Mod 18 = 0 Then
Print "+--------+----------------------+-----+-------------+-------------+----------+"
Print "Press any key for next..."
Sleep
Cls
Print "+--------+----------------------+-----+-------------+-------------+----------+"
Print "| Pos. | File Name |Cmprs| PMF2 size | File size | Ratio |"
Print "+--------+----------------------+-----+-------------+-------------+----------+"
End If
Next
Case 0 ' extract it
Dim As String Testa
Dim As Long EF
For UnPack = 0 To PMF2H.Files_Total
If _FileExists(Names(UnPack)) Then 'add automaticaly parentheses and number, if file exists
ask2:
Print "Extracted file: "; Names(UnPack); "already exists. <A>bort, <O>verwrite, <S>kip, <W>rite as next copy with index?": Input EFE$
Select Case UCase$(EFE$)
Case "A"
Close
System
Case "O"
Kill Names(UnPack)
GoTo ReWrite
Case "S"
' Do Not Write But Shift In File!!!!
N$ = Space$(PMF2FL(UnPack).BlockSize)
Get FF, , N$
N$ = ""
GoTo SkipIsHere
Case "W"
U = 0
Do Until _FileExists(Names(UnPack)) = 0
Dot = InStr(1, Names(UnPack), ".") - 1
Testa$ = Mid$(Names(UnPack), 1, Dot) + "(" + _Trim$(Str$(U) + ")") + Right$(Names(UnPack), PMF2FL(UnPack).FileNameLEN - Dot)
If _FileExists(Testa$) = 0 Then Names(UnPack) = Testa$
Testa$ = ""
U = U + 1
Loop
Case Else
GoTo ask2
End Select
EFE$ = ""
End If
ReWrite:
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
SkipIsHere:
Next UnPack
Case 1 To 29999 ' unpack just one concrete file, maximum files in archive limited to 29999 files
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
Testa$ = Mid$(Names(Fi), 1, Dot) + "(" + _Trim$(Str$(U) + ")") + Right$(Names(Fi), PMF2FL(Fi).FileNameLEN - Dot)
If _FileExists(Testa$) = 0 Then Names(Fi) = Testa$
Testa$ = ""
U = U + 1
Loop
End If
EF = FreeFile
Print "Unpacking file "; Names(Fi); " from archive..."
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 AddToPMF2 (ArchiveName As String, FileList() As String) 'NEHRABAT, OPRAVENO OTESTOVANO, nebo ZABIJU!!!!!!!!!!!!!!!!!!!!
Dim As Long ArrayControl, NewRecord, FF, MYFF, ReadFileNames, UnPack, HDD2RAM, PresenceTest, FreeRam, Parameter, PresTest, CopyNewToRam, FFG, Compresse
Dim As String N, AddToArchive, Ask5, NewFileNameToPMF2, cN
'precist stavajici soubor PMF2 do ramdisku vcetne hlav
'zatim to tam jen pripise, bez kontroly toho jestli to tam uz neni
'kontrola pole se soubory k pridani, esi to obsahuje platne zaznamy ci nikoliv
If UBound(FileList) < 0 Then Print "Ubound pod nulou pico": Exit Sub
For ArrayControl = 0 To UBound(FileList) 'empty records in FileList() prevent
Print FileList(ArrayControl), ArrayControl
If Len(FileList(ArrayControl)) Then NewRecord = NewRecord + 1
Next
' If NewRecord = 0 Then Print "Input array contains none valid files or is empty. Adding files is not possible.": End
Print "NewRecord"; NewRecord; FileList(NewRecord)
'cteni soucasneho souboru do ktereho se maji pridavat nove zaznamy
If _FileExists(ArchiveName) Then
FF = FreeFile
Open ArchiveName For Binary As FF
MYFF = 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
Dim RamDisc(PMF2H.Files_Total + NewRecord + 1) As RamDisc '+1 because first record NEWRECORD start on zero
Dim SaveItAs(PMF2H.Files_Total + NewRecord + 1) As String
'nejprve rozbalime stavajici soubor PMF2 do ram discu
For UnPack = 0 To PMF2H.Files_Total
If Len(_Trim$(Names(UnPack))) Then
RamDisc(UnPack).Binars = _MemNew(PMF2FL(UnPack).BlockSize)
RamDisc(UnPack).FileName = Names(UnPack)
SaveItAs(UnPack) = Names(UnPack)
RamDisc(UnPack).Compressed = PMF2FL(UnPack).Compress
N$ = Space$(PMF2FL(UnPack).BlockSize)
Seek #FF, PMF2FL(UnPack).Offset
Get #FF, , N$
_MemPut RamDisc(UnPack).Binars, RamDisc(UnPack).Binars.OFFSET, N$
N$ = ""
End If
Next UnPack
'nyni do ramdiscu pridame take soubory z harddisku, s tim, ze se take provede kontrola, esi ten soubor uz v souboru je nebo neni
For HDD2RAM = 0 To NewRecord 'NewRecord je pocet zaznamu v poli na vstupu funkce
If Len(_Trim$(FileList(HDD2RAM))) Then
If _FileExists(FileList(HDD2RAM)) Then AddToArchive$ = FileList(HDD2RAM) Else Print "File: "; FileList(HDD2RAM); " not exist. Can not continue.": Sleep 3: End
'nactu jmeno souboru ze vstupniho pole FileList (pole s do promenne AddToArchive$
For PresenceTest = 0 To PMF2H.Files_Total
If UCase$(AddToArchive$) = UCase$(RamDisc(PresenceTest).FileName) Then
ask5:
Print "This file: "; RamDisc(PresenceTest).FileName; " already exist in PMF2 archive file - record nr.["; Str$(PresenceTest); "]. <S>ave it to archive under another name, <U>pdate current file in PMF2 archive, <E>xit";: Input Ask5$
Select Case UCase$(Ask5$)
Case "E"
For FreeRam = 0 To PMF2H.Files_Total
_MemFree RamDisc(FreeRam).Binars
Next FreeRam
Erase RamDisc
Close
End
Case "U"
Rem pouziju jiz funkcni packpmf2 s prislusnymi parametry
Parameter = 90001 + HDD2RAM
UnPack_PMF2 ArchiveName, Parameter
Rem internal hack here
SaveItAs(PresenceTest) = "Updated_" + FileList(PresenceTest): Rem to sluvko UPDATED tu nusi byt jinak to smycka furt vraci, ze to je pritomno vickrat
Exit For
Case "S"
Rem
ask6:
Input "Save this file to archive as: "; NewFileNameToPMF2$
If NewFileNameToPMF2$ = "" Then Print "File name can not be empty string!": GoTo ask6
'test, jestli toto nove jmeno uz neni v archivu
For PresTest = 0 To UBound(RamDisc)
If UCase$(RamDisc(PresTest).FileName) = UCase$(NewFileNameToPMF2$) Then Print "This file: "; RamDisc(PresTest).FileName; " already exist in PMF2 archive file - record nr.["; Str$(PresTest); "]. Insert another name.": GoTo ask6
Next PresTest
SaveItAs(HDD2RAM) = NewFileNameToPMF2$ 'zrejme to taky dela bordel pri pokusu o nacteni tohoto noveho (neexistujiciho) souboru dale
Case Else
GoTo ask5
End Select
End If
Next PresenceTest
End If
Next HDD2RAM
'po kontrole jmen v poli filelist to prikopirovat do ramdisku
Dim As Long RamDisc_Index, add
RamDisc_Index = PMF2H.Files_Total + 1
For CopyNewToRam = 0 To NewRecord
If Len(_Trim$(FileList(CopyNewToRam))) Then
add = add + 1
FFG = FreeFile
Open FileList(CopyNewToRam) For Binary As FFG
N$ = Space$(LOF(FFG))
Get FFG, , N$
Close FFG
cN$ = _Deflate$(N$)
Compresse = 1
If Len(cN$) > Len(N$) Then cN$ = N$: Compresse = 0
N$ = ""
RamDisc(RamDisc_Index).Binars = _MemNew(Len(cN$))
RamDisc(RamDisc_Index).FileName = FileList(CopyNewToRam)
If SaveItAs(RamDisc_Index) = "" Then SaveItAs(RamDisc_Index) = FileList(CopyNewToRam)
RamDisc(RamDisc_Index).Compressed = Compresse
_MemPut RamDisc(RamDisc_Index).Binars, RamDisc(RamDisc_Index).Binars.OFFSET, cN$
RamDisc_Index = RamDisc_Index + 1
cN$ = ""
End If
Next
Print "To RamDisk added:"; add; "files"
RamDisc_Index = RamDisc_Index - 1
Dim HeadC As Header
Dim As Long H2F, FF3, BytePos, NameIt, Starts, Begin
HeadC.ID = "PMF2"
HeadC.Files_Total = RamDisc_Index
Dim FiLi2(RamDisc_Index) As File_List
For H2F = 0 To RamDisc_Index
If Len(_Trim$(RamDisc(H2F).FileName)) Then
Print "File add: "; SaveItAs(H2F)
RamDisc(H2F).FileName = SaveItAs(H2F)
FiLi2(H2F).FileNameLEN = Len(RamDisc(H2F).FileName)
FiLi2(H2F).Compress = RamDisc(H2F).Compressed
FiLi2(H2F).Offset = 0&
FiLi2(H2F).BlockSize = ConvertOffset(RamDisc(H2F).Binars.SIZE)
End If
Next
FF3 = FreeFile
If _FileExists("___NEW_PMF2.pmf2") Then Kill "___NEW_PMF2.pmf2"
Open "___NEW_PMF2.pmf2" For Binary As FF3
Put #FF3, , HeadC
BytePos = Seek(FF3)
Put #FF3, , FiLi2()
'insert files names to PMF2
For NameIt = 0 To RamDisc_Index
If Len(_Trim$(RamDisc(NameIt).FileName)) Then
N$ = RamDisc(NameIt).FileName
' Print N$
' Sleep
Put #FF3, , N$
End If
Next
N$ = ""
'insert start offsets and files binary data
For Starts = 0 To UBound(RamDisc) - 1: Rem _Index - 1
If Len(_Trim$(RamDisc(Starts).FileName)) Then
Begin = Seek(FF3)
FiLi2(Starts).Offset = Begin 'record real End Offsets sizes
Rem Print (FiLi2(starts).BlockSize), starts
Rem Sleep
N$ = Space$(FiLi2(Starts).BlockSize)
_MemGet RamDisc(Starts).Binars, RamDisc(Starts).Binars.OFFSET, N$
Put #FF3, , N$
N$ = ""
End If
Next
'upgrade END OFFSETs info for all files in PMF2 in head2
Put #FF3, BytePos, FiLi2() ' Replace Head 2 - now contains also end offsets for files in PMF2
Close #FF3
Rem JobUpg
Close
Kill ArchiveName
Name "___NEW_PMF2.pmf2" As ArchiveName
'uvolnit ramku....
For FreeRam = 0 To UBound(RamDisc) - 1
_MemFree RamDisc(FreeRam).Binars
Next FreeRam
Erase RamDisc
End If
End If
End If
End Sub
Function ConvertOffset&& (value As _Offset)
$Checking:Off
Dim m As _MEM 'Define a memblock
m = _Mem(value) 'Point it to use value
$If 64BIT Then
Dim As _Integer64 temp
'On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64
_MemGet m, m.OFFSET, temp&&
ConvertOffset&& = temp&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
$Else
dim as long temp
'However, on 32 bit OSes, an OFFSET is only 4 bytes. We need to put it into a LONG variable first
_MemGet m, m.OFFSET, temp& 'Like this
ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
$End If
_MemFree m 'Free the memblock
$Checking:On
End Function
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"
Rem toto bylo puvodne PMF2H.Files_Total = UBound(FileList)
Dim As Long ArrayControl, FF, Names_And_Sizes, BytePos, NameIt, Starts
Dim As String test, Compressed, FileExistsChoice, Quit, NewArchiveName, n
If UBound(FileList) < 0 Then Exit Sub
Do Until ArrayControl = UBound(FileList) 'empty records in FileList() prevent
If Len(FileList(ArrayControl)) Then PMF2H.Files_Total = PMF2H.Files_Total + 1
ArrayControl = ArrayControl + 1
Loop
PMF2H.Files_Total = PMF2H.Files_Total - 1
If PMF2H.Files_Total = -1 Then Print "Input array contains none valid files or is empty": End
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 Len(FileList(Names_And_Sizes)) Then
If _FileExists(FileList(Names_And_Sizes)) Then
Open FileList(Names_And_Sizes) For Binary As FF
Size = LOF(FF) 'if is compression 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
End If
Next
If _FileExists(ArchiveName$) Then
ask3:
Print "Archive file PMF2 this name "; ArchiveName$; " exists. Overwrite it? <Y>es, <N>o, <R>ename, <A>dd new records to archive": Input FileExistsChoice$
Select Case UCase$(FileExistsChoice$)
Case "Y"
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!]
Print "Previous Archive file delted..."
Case "N"
ask4:
Print "Abort operation? <Y>es or <N>o ";: Input Quit$
Select Case UCase$(Quit$)
Case "Y"
Close FF
System
Case "N"
Input "Set new PMF2 archive file name: "; ArchiveName$
If LCase$(Right$(ArchiveName$, 5)) <> ".pmf2" Then ArchiveName$ = ArchiveName$ + ".pmf2"
Case Else
GoTo ask4
End Select
Case "R"
Input "Set new PMF2 archive file name: "; NewArchiveName$
If NewArchiveName$ = ArchiveName$ Then Print "This archive exists, try other option or insert other archive file name.": GoTo ask3
If NewArchiveName$ = "" Then GoTo ask3
ArchiveName$ = NewArchiveName$
If LCase$(Right$(ArchiveName$, 5)) <> ".pmf2" Then ArchiveName$ = ArchiveName$ + ".pmf2"
Case "A"
AddToPMF2 ArchiveName, FileList()
Case Else
GoTo ask3
End Select
End If
Open ArchiveName$ For Binary As FF
Print "Creating archive: "; ArchiveName$
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
Print "Adding file "; Names(Starts)
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
Sub Cmnd 'command$ support
Dim As Long GitCa, i
Dim As String Update, s, Archive, AFile, RecName, A, f
Select Case LCase$(_Trim$(Command$(1)))
Case "-a" 'add to archive
If InStr(1, getCommand(2), "*") > 0 Or InStr(1, getCommand(2), "?") > 0 Then Print "Bad use. Mask must be at last third position.": Sleep 3: System
'-a archive.pmf2 *.*
' 1 2 3
ReDim As Integer PARAMETER1, PARAMETER2, Added
ReDim What As String
Dim As _Byte Reduce
PARAMETER1 = InStr(1, LCase$(getCommand$(2)), ".pmf2")
PARAMETER2 = InStr(1, LCase$(getCommand$(3)), ".pmf2")
If PARAMETER1 = 0 And PARAMETER2 = 0 Then Print "Extension .pmf2 in archive file name must be used in this statement, otherwise archive file is not created.": Sleep 3: End
If PARAMETER1 > 0 Then Archive$ = getCommand$(2): What$ = getCommand$(3): Reduce = 0 Else Archive$ = getCommand$(3): What$ = getCommand$(2): Reduce = 1
Print "Archiv pres getCommand$ "; Archive$
'pripona pmf2 je povinna pri zadani
Added = 1
If InStr(1, What$, "*") > 0 Or InStr(1, What$, "?") > 0 Then Added = 0 '1 = add 1 file, 0 = add array
If Added = 0 Then 'add files in array (more than 1)
Print "Blok Added -a 0"
Dim arr(_CommandCount) As String
For GitCa = 3 To _CommandCount ' - Reduce
If _FileExists(Command$(GitCa)) Then arr(i) = Command$(GitCa): i = i + 1 ' testovano
Print Command$(GitCa)
Print "Do seznamu pridavam "; arr(i); i
Next
Else ' add one file
' Print "Adding "; What$
Dim arr(5) As String ' TENTO BLOK JE PLNE FUNKCNI. NEHRABAT
arr(0) = What$
End If
Print "Opening archive "; Archive$
PackPMF2 Archive$, arr()
Erase arr
Case "-add"
' pmf2 -add *.exe archive.pmf2
If InStr(1, getCommand(2), "*") > 0 Or InStr(1, getCommand(2), "?") > 0 Then Print "Bad use. Mask must be at last third position.": Sleep 3: System
PARAMETER1 = InStr(1, LCase$(getCommand$(2)), ".pmf2")
PARAMETER2 = InStr(1, LCase$(getCommand$(3)), ".pmf2")
If PARAMETER1 = 0 And PARAMETER2 = 0 Then Print "Extension .pmf2 in archive file name must be used in this statement, otherwise records to PMF2 file are not add.": Sleep 3: End
If PARAMETER1 > 0 Then Archive$ = getCommand$(2): What$ = getCommand$(3): Reduce = 0 Else Archive$ = getCommand$(3): What$ = getCommand$(2): Reduce = 1
'reduce je tam proto, ze kdyz zadas archiv.pmf2 jako posledni, misto masky ti vyjede mrda souboru no a na konci....prave ten archiv.pmf2
Print "Archiv pres getCommand$ "; Archive$, "What: "; What$
Sleep
'pripona pmf2 je povinna pri zadani
Added = 1
If InStr(1, What$, "*") > 0 Or InStr(1, What$, "?") > 0 Then Added = 0 '1 = add 1 file, 0 = add array
Rem Print InStr(1, What$, ".*")
If Added = 0 Then 'add files in array (more than 1)
Print "Added pro pole"
ReDim arr(_CommandCount) As String
' Print _CommandCount
For GitCa = 3 To _CommandCount ' - Reduce
If _FileExists(Command$(GitCa)) Then
arr(i) = Command$(GitCa)
Print "-add Do seznamu pridavam "; arr(i); "["; _Trim$(Str$(i)); "]/["; _Trim$(Str$(_CommandCount - 3 - Reduce)); "]"
i = i + 1 ' testovano
Else
Print "Error: "; Command$(GitCa); " not found"
End If
Next
Else ' add one file
Print "Jede Added pro 1 soubor"
Print "Adding "; What$
Dim arr(5) As String
arr(0) = What$
End If
Print "Opening archive "; Archive$
Sleep
AddFiles Archive$, arr()
Erase arr
Case "-ad"
Print "Subdirectories add is future function, now it is posible from QB64 directly using defined path strings": End
Case "-u"
'-u image.jpg archive.pmf2
If _FileExists(Command$(2)) Then
Update$ = Command$(2)
Else
Print "File "; Command$(2); " not found. ": End
End If
s$ = Command$(3)
If LCase$(Right$(s$, 5)) <> ".pmf2" Then s$ = s$ + ".pmf2" ' testovano
If _FileExists(s$) Then
Archive$ = s$
UpdateFile Archive$, Update$
Else
Print "PMF2 file: "; s$; "not found.": End
End If
Case "-f"
'pmf2 -f record.ini archive.pmf2
s$ = Command$(3)
If LCase$(Right$(s$, 5)) <> ".pmf2" Then s$ = s$ + ".pmf2" ' testovano
If _FileExists(s$) Then
AFile$ = s$
Else
Print "File "; s$; " not found. ": End
End If
If PMF2Record$(AFile$, Command$(2)) = "" Then Print "This file or record is not contained in this PMF2 archive.": Sleep 3: System
Print "Record nr. for "; Command$(2); " is "; PMF2Record$(AFile$, Command$(2))
Case "-fr"
'pmf2 -fr 2 archive.pmf2
s$ = Command$(3)
If LCase$(Right$(s$, 5)) <> ".pmf2" Then s$ = s$ + ".pmf2" ' testovano
If Val(Command$(2)) Then
If _FileExists(s$) Then
Archive$ = s$
RecName$ = PMF2Record(Archive$, Command$(2))
Else
Print "PMF2 archive file "; s$; " not exist.": End
End If
Else
Print "2.nd parameter must be number.": End
End If
Print "Filename for record"; Val(Command$(2)); "is "; RecName$ ' testovano
Case "-ren"
'pmf2 -ren utitled.bas archive.pmf2 ----> ENTER ----> run rename dialog
Dim M As String
s$ = Command$(3)
If LCase$(Right$(s$, 5)) <> ".pmf2" Then s$ = s$ + ".pmf2" ' testovano
If _FileExists(s$) Then
Archive$ = s$
Else
Print "PMF File "; s$; " not found. ": End
End If
' If Len(PMF2Record(Archive$, Command$(2))) Then
M$ = (PMF2Record(Archive$, Command$(2)))
If Len(M$) Then
If Val(M$) > 0 Then M$ = PMF2Record(Archive$, M$) 'user give us number, we convert it to file name string
RenameFile Archive$, M$ 'command$(2)
Print "Renaming done"
Else
Print "Recorded file in PMF2 archive "; Command$(2); " not found. ": End
End If
Case "-del"
'pmf2 -del s.jpg archive.pmf2
s$ = Command$(3)
If LCase$(Right$(s$, 5)) <> ".pmf2" Then s$ = s$ + ".pmf2" ' testovano
If _FileExists(s$) Then
Archive$ = s$
Else
Print "PMF File "; Command$(3); " not found. ": End
End If
If Len(PMF2Record(Archive$, Command$(2))) Then
DeleteFile Archive$, Command$(2)
Print "Record "; Command$(2); " deleted from archive "; s$
Else
Print "Record "; Command$(2); " in archive "; s$; " not found."
End If
Case "-delrec"
' 1 2 3
'PMF2 -delrec 5 archive
A$ = Command$(3)
If LCase$(Right$(A$, 5)) <> ".pmf2" Then A$ = A$ + ".pmf2"
If _FileExists(A$) Then
Archive$ = A$
Else
Print "PMF File "; A$; " not found. ": End
End If
If Len(PMF2Record(Archive$, Command$(2))) Then ' testovano
DeleteRec Archive$, Val(Command$(2))
End If
Print "Record "; Command$(2); " deleted."
Case "-l"
A$ = Command$(2)
If LCase$(Right$(A$, 5)) <> ".pmf2" Then A$ = A$ + ".pmf2" ' testovano
If _FileExists(A$) Then
Archive$ = A$
Else
Print "PMF File "; A$; " not found. ": End
End If
ListFiles Archive$
Case "-uaf" 'unpack all files
f$ = Command$(2)
If LCase$(Right$(f$, 5)) <> ".pmf2" Then f$ = f$ + ".pmf2"
If _FileExists(f$) Then
Archive$ = f$
Else
Print "PMF File "; f$; " not found. ": End ' ok
End If
UnPack2HDD Archive$, 0
Case "-uf" 'unpack one file
'pmf2 -uf filename$, archive$
Dim RecordNumo As Long
f$ = Command$(3)
If LCase$(Right$(f$, 5)) <> ".pmf2" Then f$ = f$ + ".pmf2" ' ok
If _FileExists(f$) Then
Archive$ = f$
Else
Print "PMF File "; Command$(3); " not found. ": End
End If
If Val(Command$(2)) = 0 Then RecordNumo = Val(PMF2Record$(f$, Command$(2))) Else RecordNumo = Val(Command$(2))
If RecordNumo = 0 Then Print "File not found in archive."
If Len(PMF2Record$(f$, Str$(RecordNumo))) Then
'text uz pise kdesi cosi
UnPack2HDD Archive$, RecordNumo
End If
Case "-?" ' ok
Screen _NewImage(170, 20, 0)
Print " PMF2.EXE Command$ values:"
Print
Print "PMF2 -a file.txt archive ----> this add file file.txt to archive.pmf2"
Print "PMF2 -a *.* archive ----> this add all files in directory to archive.pmf2, all mask form can be used."
Print "PMF2 -ad all archive ----> this add all subdirectories and files to archive.pmf2 - future function, NOW UNSUPPORTED directly, but possible from QB64"
Print "PMF2 -u file.txt archive ----> upgrade file file.txt in archive.pmf2 with file the same name in current directory (file.txt)"
Print "PMF2 -f music.mp3 archive ----> find if file music.mp3 exists in PMF2 archive and return this record index"
Print "PMF2 -fr 4 archive ----> find what file name contains 4th record in PMF2 archive and return this name"
Print "PMF2 -ren image.gif archive ----> run renaming dialog, ask for new name and then rename file in PMF2 archive"
Print "PMF2 -del image.pc archive ----> delete file image.pcx in archive.pmf2"
Print "PMF2 -delrec 5 archive ----> delete file in 5.th position in archive.pmf2"
Print "PMF2 -l archive ----> list archive.pmf2 to screen and show files in archive"
Print "PMF2 -uaf archive ----> unpack archive.pmf2 to harddrive (all files from archive)"
Print "PMF2 -uf filename archive ----> unpack file from archive.pmf2 to harddrive (can be filename in archive or also file record number) - one file"
Print "PMF2 -? ----> show this help for command$"
Print
Print "Press any key for end..."
Sleep
End
End Select
End Sub
Function getCommand$ (n%)
'author: mdijkens
$If WIN Then
Dim a As _Offset, sp0 As Integer, sp1 As Integer
Static cmd$(100), ccount As Integer
If cmd$(0) = "" Then
Declare Library
Function getCommandLine%& Alias GetCommandLineA ()
End Declare
Dim m As _MEM, ms As String * 1000
a%& = getCommandLine: m = _Mem(a%&, Len(ms)): ms = _MemGet(m, m.OFFSET, String * 1000)
ms = _Trim$(Left$(ms, InStr(ms, Chr$(0)) - 1))
ccount = 0: sp0% = 1: sp1% = InStr(ms, " ")
Do While sp1% > 0
cmd$(ccount) = _Trim$(Mid$(ms, sp0%, sp1% - sp0%))
If cmd$(ccount) <> "" Then ccount = ccount + 1
sp0% = sp1% + 1: sp1% = InStr(sp1% + 1, ms, " ")
Loop
cmd$(ccount) = _Trim$(Mid$(ms, sp0%)): If Left$(cmd$(ccount), 1) = Chr$(0) Then ccount = ccount - 1
_MemFree m
End If
If n% < 0 Then
getCommand$ = _Trim$(Str$(ccount))
ElseIf n% <= ccount Then
getCommand$ = cmd$(n%)
Else
getCommand$ = ""
End If
$Else
getCommand$ = Command$(n%)
$End If
End Function