Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Files packer/unpacker to one file
#2
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 Sub


Attached Files
.zip   Pmf2test2023.zip (Size: 3 MB / Downloads: 37)


Reply


Messages In This Thread
Files packer/unpacker to one file - by Petr - 03-06-2023, 07:41 PM
Files packer/unpacker to one file UPGRADE - by Petr - 03-13-2023, 07:56 PM
RE: Files packer/unpacker to one file - by Petr - 03-19-2023, 08:54 PM



Users browsing this thread: 1 Guest(s)