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

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    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