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 :)
ID
As String * 4 ' file format signature PMF2 Files_Total
As Long ' how much files container contains
Type File_List
' Header 2 FileNameLEN
As _Unsigned _Byte 'Lenght for file name (example: Untitled.bas = file name lenght = 12) 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)
ReDim Shared PMF2FL
(0) As File_List
'each added file has its own index in this field
Dim FL
(18) As String ' add here your own files for test it. Array can not have empty records and must start from zero! 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) = "v2.gif"
FL(13) = "mech.ogg"
FL(14) = "NEWest1.xml"
FL(15) = "NEWest2.xml"
FL(16) = "NEWest3.xml"
FL(17) = "NEWest4.xml"
FL(18) = "NEWest5.xml"
Pack_PMF2 "Pmf2test", FL() ' create Pmf2test.pmf2 file container
UnPack_PMF2 "Pmf2test.pmf2", Show ' just read heads from created file Pmf2test and show you, which files are in PMF2 container
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)
'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
' 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
' next options be added later, but is released now, for free use for you all, so all can do Christmas theme :)
'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
Get FF
, , PMF2H
' read head 1 If PMF2H.Files_Total
> -1 Then ReDim As File_List PMF2FL
(PMF2H.Files_Total
) Get FF
, , PMF2FL
() ' read head 2
For ReadFileNames
= 0 To PMF2H.Files_Total
' read files names in file N$
= Space$(PMF2FL
(ReadFileNames
).FileNameLEN
) Names(ReadFileNames) = N$
N$ = ""
Select Case METHOD
' This is information block (Show) Print "Pos. File name Compressed Size in PMF2 file [bytes]" Print "-----------------------------------------------------------------" For ReadContent
= 0 To PMF2H.Files_Total
F_Name$ = Names(ReadContent)
If PMF2FL
(ReadContent
).Compress
Then F_Compress$
= "Yes" Else F_Compress$
= "No" F_Size& = PMF2FL(ReadContent).BlockSize
Print "Press any key for next..." Print "Pos. File name Compressed Size in PMF2 file [bytes]" Print "-----------------------------------------------------------------" For UnPack
= 0 To PMF2H.Files_Total
If _FileExists(Names
(UnPack
)) Then 'add automaticaly parentheses and number, if file exists u = 0
Dot
= InStr(1, Names
(UnPack
), ".") - 1 Test$
= Mid$(Names
(UnPack
), 1, Dot
) + "(" + _Trim$(Str$(u
) + ")") + Right$(Names
(UnPack
), PMF2FL
(UnPack
).FileNameLEN
- Dot
) Test$ = ""
u = u + 1
N$
= Space$(PMF2FL
(UnPack
).BlockSize
) N$ = ""
Rec$ = ""
Case Is > 0 ' unpack just one concrete file Fi = METHOD - 1
If _FileExists(Names
(Fi
)) Then 'add automaticaly parentheses and number, if file exists u = 0
Dot
= InStr(1, Names
(Fi
), ".") - 1 Test$
= Mid$(Names
(Fi
), 1, Dot
) + "(" + _Trim$(Str$(u
) + ")") + Right$(Names
(Fi
), PMF2FL
(Fi
).FileNameLEN
- Dot
) Test$ = ""
u = u + 1
N$
= Space$(PMF2FL
(Fi
).BlockSize
) Seek FF
, PMF2FL
(Fi
).Offset
N$ = ""
Rec$ = ""
Print "Invalid record: Number of files in PMF2 file: "; PMF2H.Files_Total:
Sleep 3:
End Print "PMF2 file: "; ArchiveName$;
" not exists. Can not continue.":
Sleep 3:
End
Sub Pack_PMF2
(ArchiveName
As String, FileList
() As String) 'Array in input contains file names for add to archive PMF2H.ID = "PMF2"
PMF2H.Files_Total
= UBound(FileList
)
ReDim PMF2FL
(PMF2H.Files_Total
) As File_List
For Names_And_Sizes
= 0 To PMF2H.Files_Total
Size
= LOF(FF
) 'if is copression not used, is block size the same as file size 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
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!]
'insert files names to PMF2
For NameIt
= 0 To PMF2H.Files_Total
n$ = Names(NameIt)
n$ = ""
'insert start offsets and files binary data
For starts
= 0 To PMF2H.Files_Total
PMF2FL(starts).Offset = Begin 'record real End Offsets sizes
n$ = Binaries(starts)
n$ = ""
'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