This program will take !ALL FILES! in the current directory (from which it is run) and package them in a ".mpk file". Use the accompanying MediaUnpacker to unpack them. I'm using it alongside my level editor so that in the end there is a single level file with all media included, in one (easy to share) file. Use it however you want.
!!!255 files max, 32 characters max per file!!! for now...
Rem Project: MediaPacker
Rem Created: 6/12/2004 8:08:06 PM
Rem ***** Main Source File *****
dim files$(256)
dim filetypes(256)
dim sizes(256)
dim sizebytes(4)
dim offsets(256)
dim actualoffsets(4)
dim offsettemp(1)
directory$=get dir$()
findallfiles(directory$)
packmedia(directory$)
function findallfiles(directory$)
foundfiles=0
set dir directory$
find first
repeat
if get file type()=0 and get file name$() <> "MediaPacker.exe" and right$(get file name$(), 3) <> "mpk"
foundfiles=foundfiles+1
files$(foundfiles)=get file name$()
sizes(foundfiles)=file size(files$(foundfiles))
filetypes(foundfiles)=0
endif
find next
until get file type()=-1
rem generate offsets
offsettemp(1)=8+(256*8)
for entries=1 to foundfiles
offsets(entries)=offsettemp(1)
offsettemp(1)=offsettemp(1)+(42+sizes(entries))
next entries
endfunction
function packmedia(packdir$)
set dir packdir$
filename$="MediaPacker.mpk"
if file exist(filename$) then delete file filename$
open to write 1,filename$
write byte 1, asc("@")
write byte 1, asc("[")
write byte 1, asc("T")
write byte 1, asc("]")
write byte 1, asc("v")
write byte 1, asc("1")
write byte 1, asc(".")
write byte 1, asc("0")
for toc=1 to 256
gettocoffsets(toc)
write byte 1, asc("[")
write byte 1, toc
write byte 1, actualoffsets(1)
write byte 1, actualoffsets(2)
write byte 1, actualoffsets(3)
write byte 1, actualoffsets(4)
write byte 1, asc("R")
write byte 1, asc("]")
next toc
for files=1 to 255
if file exist(files$(files))=1
getsizebytes(files$(files))
write byte 1, asc("@")
write byte 1, asc("[")
write byte 1, asc("M")
write byte 1, asc("]")
write byte 1, sizebytes(1)
write byte 1, sizebytes(2)
write byte 1, sizebytes(3)
write byte 1, sizebytes(4)
for writenamechars=1 to 32
correctchar=getcorrectchar(files$(files),writenamechars)
write byte 1, correctchar
next writenamechars
write byte 1, asc("!")
write byte 1, asc("@")
open to read 2, files$(files)
for readbyte=1 to sizes(files)
read byte 2, temp
write byte 1, temp
next readbyte
close file 2
textout("Packing file "+files$(files))
endif
next files
close file 1
endfunction
function getsizebytes(filename$)
size=file size(filename$)
32bitstring$=d2db(size)
byte$=""
index=1
for bb=1 to 32
bit$=mid$(32bitstring$,bb)
byte$=byte$+bit$
if len(byte$)=8
sizebytes(index)=b2d(byte$)
byte$=""
index=index+1
endif
next bb
endfunction
function gettocoffsets(entrynum)
size=offsets(entrynum)
32bitstring$=d2db(size)
byte$=""
index=1
for bb=1 to 32
bit$=mid$(32bitstring$,bb)
byte$=byte$+bit$
if len(byte$)=8
actualoffsets(index)=b2d(byte$)
byte$=""
index=index+1
endif
next bb
endfunction
function getcorrectchar(filename$,m)
if m>len(filename$)
returnascii=asc("%")
else
returnascii=asc(mid$(filename$,m))
endif
endfunction returnascii
function d2db(decimal)
32bits$="00"
for b=29 to 0 step -1
if decimal>=(2^b)
bit$="1"
decimal=decimal-(2^b)
else
bit$="0"
endif
32bits$=32bits$+bit$
next b
endfunction 32bits$
function b2d(bits$)
decimal=0
for b=1 to 8
if mid$(bits$,b)="1"
decimal=decimal+(2^(8-b))
endif
next b
endfunction decimal
function debug(variable$)
cls
do
text 1,1,variable$
sync
if spacekey()=1 then exit
loop
do
if spacekey()=0 then exit
loop
endfunction
function textout(variable$)
cls
text 1,1,variable$
sync
endfunction
Here is the unpacker...
Rem Project: MediaPacker
Rem Created: 6/12/2004 8:08:06 PM
Rem ***** Main Source File *****
dim files$(256)
dim filetypes(256)
dim sizes(256)
dim sizebytes(4)
dim tocoffsets(256)
dim toctemp(4)
dim offsetbyte(4)
dim offsettemp(4)
directory$=get dir$()
unpackmedia(directory$)
function unpackmedia(packdir$)
set dir packdir$
find first
repeat
if get file type()=0 and right$(get file name$(),3)="mpk"
foundfiles=foundfiles+1
files$(foundfiles)=get file name$()
sizes(foundfiles)=file size(files$(foundfiles))
endif
find next
until get file type()=-1
foundblocks=0
for unpack=1 to foundfiles
if file exist(files$(foundfiles))=1 then open to read 1, files$(foundfiles)
skip bytes 1,8
for toc=1 to 256
read byte 1, null
read byte 1, null
read byte 1, temp1
read byte 1, temp2
read byte 1, temp3
read byte 1, temp4
read byte 1, null
read byte 1, null
offsetbyte(1)=temp1
offsetbyte(2)=temp2
offsetbyte(3)=temp3
offsetbyte(4)=temp4
temp$=setdecimaloffset()
tocoffsets(toc)=db2d(temp$)
next toc
for toc=1 to 255
if tocoffsets(toc)<>0 then extractfileblock(toc)
next toc
close file 1
next unpack
endfunction
function setdecimaloffset()
32bits$=""
for d=1 to 4
temp=offsetbyte(d)
32bits$=32bits$+d2b(temp)
next d
endfunction 32bits$
function getcorrectchar(filename$,m)
if m>len(filename$)
returnascii=asc("%")
else
returnascii=asc(mid$(filename$,m))
endif
endfunction returnascii
function db2d(bits$)
total=0
for bit=1 to 32
bit$=mid$(bits$,bit)
if bit$="1" then total=total + (2^(32-bit))
next newbit
rem debug(str$(total))
endfunction total
function d2b(decimal)
8bits$=""
for b=7 to 0 step -1
if decimal>=(2^b)
bit$="1"
decimal=decimal-(2^b)
else
bit$="0"
endif
8bits$=8bits$+bit$
next b
endfunction 8bits$
function debug(variable$)
cls
do
text 1,1,variable$
sync
if spacekey()=1 then exit
loop
do
if spacekey()=0 then exit
loop
text 1,1,variable$
sync
endfunction
function extractfileblock(toc)
read byte 1, null
read byte 1, null
read byte 1, null
read byte 1, null
read byte 1, temp1
read byte 1, temp2
read byte 1, temp3
read byte 1, temp4
offsettemp(1)=temp1
offsettemp(2)=temp2
offsettemp(3)=temp3
offsettemp(4)=temp4
temp$=getdecimaloffset()
filelength=db2d(temp$)
filename$=""
rem ####################################################################################
for b=1 to 32
read byte 1, byt
if chr$(byt)<>"%" then filename$=filename$+chr$(byt)
next b
rem debug(filename$)
read byte 1, null
read byte 1, null
if file exist(filename$)=1 then delete file filename$
open to write 2, filename$
for wnfbbb=1 to filelength
read byte 1, tempp
write byte 2, tempp
next wnfbbb
close file 2
endfunction
function getdecimaloffset()
32bits$=""
for d=1 to 4
temp=offsettemp(d)
32bits$=32bits$+d2b(temp)
next d
endfunction 32bits$
"Creativity is knowing how to hide your sources" - Einstein
