Author Topic: PMF2 archiver  (Read 2998 times)

0 Members and 1 Guest are viewing this topic.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
PMF2 archiver
« on: December 16, 2021, 12:49:34 pm »
Hello. It's time to introduce a new version of my program to store multiple files in one. Some of you may know the first version (with the PMF extension). It was used, for example, in my game of volleyball. Yeah, it's been a long time. So here is the second version.

What can he do? Add files to one file without limiting their number, however, extreme size is not addressed, so if you add a gigabyte size file, it will crash. It really isn't meant for that. Data compression using INFLATE $ and DEFLATE $ is used. It can unpack a single specific file, or all at once. It can list the contents of a PMF2 file.

I will gradually improve it, but it is usable now. I think this might be useful for compressing many images and sounds. This file can then be packaged using Base64 and used on a Christmas theme. Exactly in this program are packaged data on the Christmas theme, which I published here yesterday. Now you have the opportunity too. The link to Base64 is in a thread with a Christmas theme :)

Code: QB64: [Select]
  1.  
  2. Type Header '                        Header 1
  3.     ID As String * 4 '               file format signature PMF2
  4.     Files_Total As Long '            how much files container contains
  5.  
  6. Type File_List '                     Header 2
  7.     FileNameLEN As _Unsigned _Byte 'Lenght for file name (example: Untitled.bas = file name lenght = 12)
  8.     Compress As _Unsigned _Byte '   Compression. 0 = not used, 1 = used (_INFLATE$)
  9.     Offset As Long '                Area in file (offset) where start this file data
  10.     BlockSize As Long '             Byte size (how much bytes is used for this file in PMF2 container, size after compression if used)
  11.  
  12.  
  13.  
  14.  
  15. Dim Shared PMF2H As Header
  16. ReDim Shared PMF2FL(0) As File_List 'each added file has its own index in this field
  17.  
  18. Const Show = -1
  19. Const Unpack_All = 0
  20.  
  21.  
  22.  
  23. Dim FL(18) As String '    add here your own files for test it. Array can not have empty records and must start from zero!
  24. FL(0) = "mrakyM.gif"
  25. FL(1) = "NEW jezis.gif"
  26. FL(2) = "NEW jezisek.gif"
  27. FL(3) = "NEW sane.gif"
  28. FL(4) = "NEW skret.gif"
  29. FL(5) = "NEW sob.gif"
  30. FL(6) = "New sprez.gif"
  31. FL(7) = "NEWest1.gif"
  32. FL(8) = "NEWest2.gif"
  33. FL(9) = "NEWest3.gif"
  34. FL(10) = "NEWest4.gif"
  35. FL(11) = "NEWest5.gif"
  36. FL(12) = "v2.gif"
  37. FL(13) = "mech.ogg"
  38. FL(14) = "NEWest1.xml"
  39. FL(15) = "NEWest2.xml"
  40. FL(16) = "NEWest3.xml"
  41. FL(17) = "NEWest4.xml"
  42. FL(18) = "NEWest5.xml"
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49. Pack_PMF2 "Pmf2test", FL() '                   create Pmf2test.pmf2 file container
  50. UnPack_PMF2 "Pmf2test.pmf2", Show '            just read heads from created file Pmf2test and show you, which files are in PMF2 container
  51. UnPack_PMF2 "Pmf2test.pmf2", Unpack_All '      Extract all files from PMF2 container (now is set to add parentheses and number if file already exists on harddrive)
  52.  
  53.  
  54. 'BUT - You can also extract just one file from archive, not all at once: Frist look, which number is file, you need extract - use  UnPack_PMF2 "Pmf2test.pmf2", Show
  55. '      look to left to "Pos". Now add minus before this number and use (for example for file 3 in PMF2)  UnPack_PMF2 "Pmf2test.pmf2", -3
  56.  
  57. '      next options be added later, but is released now, for free use for you all, so all can do Christmas theme :)
  58.  
  59.  
  60.  
  61.  
  62. Sub UnPack_PMF2 (ArchiveName As String, METHOD As _Byte)
  63.     'method: -1 = show files in PMF2 file
  64.     '         0 = UnPack all files from PMF2 file
  65.     '       > 0 = Unpack file writed in this position in PMF2 file (-1) - use record number printed in Show mode
  66.  
  67.     If _FileExists(ArchiveName) Then
  68.         FF = FreeFile
  69.         Open ArchiveName For Binary As FF
  70.         Get FF, , PMF2H '                                       read head 1
  71.         If PMF2H.ID = "PMF2" Then
  72.             If PMF2H.Files_Total > -1 Then
  73.                 ReDim As File_List PMF2FL(PMF2H.Files_Total)
  74.                 Get FF, , PMF2FL() '                            read head 2
  75.                 ReDim As String Names(PMF2H.Files_Total)
  76.  
  77.                 For ReadFileNames = 0 To PMF2H.Files_Total '    read files names in file
  78.                     N$ = Space$(PMF2FL(ReadFileNames).FileNameLEN)
  79.                     Get FF, , N$
  80.                     Names(ReadFileNames) = N$
  81.                     N$ = ""
  82.                 Next
  83.  
  84.                 Select Case METHOD '                                                                                 This is information block (Show)
  85.                     Case -1
  86.                         Print "Pos. File name      Compressed          Size in PMF2 file [bytes]"
  87.                         Print "-----------------------------------------------------------------"
  88.                         For ReadContent = 0 To PMF2H.Files_Total
  89.                             F_Name$ = Names(ReadContent)
  90.                             If Len(F_Name$) > 15 Then F_Name$ = Mid$(F_Name$, 1, 12) + "..."
  91.                             If PMF2FL(ReadContent).Compress Then F_Compress$ = "Yes" Else F_Compress$ = "No"
  92.                             F_Size& = PMF2FL(ReadContent).BlockSize
  93.  
  94.                             ddd = Len(LTrim$(Str$(ReadContent)))
  95.                             Print LTrim$(Str$(ReadContent + 1)) + "."; Spc(4 - ddd); F_Name$; Spc(18 - Len(F_Name$) + ddd); F_Compress$; Spc(12); F_Size&
  96.                             If ReadContent Mod 22 = 0 And ReadContent > 0 Then
  97.                                 Print "Press any key for next..."
  98.                                 Sleep
  99.                                 Cls
  100.                                 Print "Pos. File name      Compressed          Size in PMF2 file [bytes]"
  101.                                 Print "-----------------------------------------------------------------"
  102.                             End If
  103.                         Next
  104.                     Case 0 '                                        extract it
  105.                         For UnPack = 0 To PMF2H.Files_Total
  106.                             If _FileExists(Names(UnPack)) Then 'add automaticaly parentheses and number, if file exists
  107.                                 u = 0
  108.                                 Do Until _FileExists(Names(UnPack)) = 0
  109.                                     Dot = InStr(1, Names(UnPack), ".") - 1
  110.                                     Test$ = Mid$(Names(UnPack), 1, Dot) + "(" + _Trim$(Str$(u) + ")") + Right$(Names(UnPack), PMF2FL(UnPack).FileNameLEN - Dot)
  111.                                     If _FileExists(Test$) = 0 Then Names(UnPack) = Test$
  112.                                     Test$ = ""
  113.                                     u = u + 1
  114.                                 Loop
  115.                             End If
  116.                             EF = FreeFile
  117.                             Open Names(UnPack) For Binary As EF
  118.                             N$ = Space$(PMF2FL(UnPack).BlockSize)
  119.                             Get FF, , N$
  120.                             If PMF2FL(UnPack).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
  121.                             Put EF, , Rec$
  122.                             N$ = ""
  123.                             Rec$ = ""
  124.                             Close EF
  125.                         Next UnPack
  126.                     Case Is > 0 '                   unpack just one concrete file
  127.                         Fi = METHOD - 1
  128.                         If Fi > UBound(Names) Then Print "Invalid record add as parameter for Unpack_PMF2 SUB!": Sleep 3: End
  129.                         If _FileExists(Names(Fi)) Then 'add automaticaly parentheses and number, if file exists
  130.                             u = 0
  131.                             Do Until _FileExists(Names(Fi)) = 0
  132.                                 Dot = InStr(1, Names(Fi), ".") - 1
  133.                                 Test$ = Mid$(Names(Fi), 1, Dot) + "(" + _Trim$(Str$(u) + ")") + Right$(Names(Fi), PMF2FL(Fi).FileNameLEN - Dot)
  134.                                 If _FileExists(Test$) = 0 Then Names(Fi) = Test$
  135.                                 Test$ = ""
  136.                                 u = u + 1
  137.                             Loop
  138.                         End If
  139.  
  140.                         EF = FreeFile
  141.                         Open Names(Fi) For Binary As EF
  142.                         N$ = Space$(PMF2FL(Fi).BlockSize)
  143.                         Seek FF, PMF2FL(Fi).Offset
  144.                         Get FF, , N$
  145.                         If PMF2FL(Fi).Compress Then Rec$ = _Inflate$(N$) Else Rec$ = N$
  146.                         Put EF, , Rec$
  147.                         N$ = ""
  148.                         Rec$ = ""
  149.                         Close EF
  150.                 End Select
  151.             Else
  152.                 Print "Invalid record: Number of files in PMF2 file: "; PMF2H.Files_Total: Sleep 3: End
  153.             End If
  154.         Else
  155.             Print "Invalid PMF2 file format. ": Sleep 3: End
  156.         End If
  157.     Else
  158.         Print "PMF2 file: "; ArchiveName$; " not exists. Can not continue.": Sleep 3: End
  159.     End If
  160.  
  161.  
  162.  
  163.  
  164.  
  165. Sub Pack_PMF2 (ArchiveName As String, FileList() As String) 'Array in input contains file names for add to archive
  166.     If LCase$(Right$(ArchiveName, 5)) <> ".pmf2" Then ArchiveName$ = ArchiveName$ + ".pmf2"
  167.     PMF2H.ID = "PMF2"
  168.     PMF2H.Files_Total = UBound(FileList)
  169.  
  170.     Dim Binaries(PMF2H.Files_Total) As String, Size As Long, C As _Byte
  171.     Dim Names(PMF2H.Files_Total) As String, Begin As Long
  172.  
  173.     ReDim PMF2FL(PMF2H.Files_Total) As File_List
  174.     FF = FreeFile
  175.     For Names_And_Sizes = 0 To PMF2H.Files_Total
  176.         If _FileExists(FileList(Names_And_Sizes)) Then
  177.             Open FileList(Names_And_Sizes) For Binary As FF
  178.             Size = LOF(FF) 'if is copression not used, is block size the same as file size
  179.             test$ = Space$(Size)
  180.             Get #FF, , test$
  181.             Close #FF
  182.             Compressed$ = _Deflate$(test$)
  183.             If Len(Compressed$) < Size Then Binaries(Names_And_Sizes) = Compressed$: C = 1: Size = Len(Compressed$) Else Binaries(Names_And_Sizes) = test$: C = 0
  184.             PMF2FL(Names_And_Sizes).BlockSize = Size 'This Size and previous is different, if compression is used, or not (row 200)
  185.             Compressed$ = ""
  186.             test$ = ""
  187.             PMF2FL(Names_And_Sizes).FileNameLEN = Len(FileList(Names_And_Sizes))
  188.             Names(Names_And_Sizes) = FileList(Names_And_Sizes)
  189.             PMF2FL(Names_And_Sizes).Compress = C
  190.             PMF2FL(Names_And_Sizes).Offset = 0&
  191.         Else Print "Error: Can not add file "; FileList(Names_And_Sizes); " to archive, because this file not exists. Operation aborted!": Sleep 3: End
  192.         End If
  193.     Next
  194.  
  195.     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!]
  196.     Open ArchiveName$ For Binary As FF
  197.     Put #FF, , PMF2H
  198.     BytePos = Seek(FF)
  199.     Put #FF, , PMF2FL()
  200.  
  201.     'insert files names to PMF2
  202.     For NameIt = 0 To PMF2H.Files_Total
  203.         n$ = Names(NameIt)
  204.         Put #FF, , n$
  205.     Next
  206.     n$ = ""
  207.  
  208.     'insert start offsets and files binary data
  209.     For starts = 0 To PMF2H.Files_Total
  210.         Begin = Seek(FF)
  211.         PMF2FL(starts).Offset = Begin 'record real End Offsets sizes
  212.         n$ = Binaries(starts)
  213.         Put FF, , n$
  214.         n$ = ""
  215.     Next
  216.  
  217.     'upgrade END OFFSETs info for all files in PMF2 in head2
  218.     Put #FF, BytePos, PMF2FL() '                     Replace Head 2 - now contains also end offsets for files in PMF2
  219.     Close #FF
  220.  

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: PMF2 archiver
« Reply #1 on: December 16, 2021, 03:33:55 pm »
Works good!  Helpful utility.  Thanks for sharing.

- Dav