« previous next »
Pages: [1]   Go Down

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

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
Logged
Pages: [1]   Go Up
« previous next »