FileTypes

Filetype text

Filetype application/binary

End FileTypes

Class Window1 Inherits Window

EventHandler Sub Open() dim folder,file as FolderItem dim b as BinaryStream dim i,c as integer folder=SpecialFolder.Desktop.Child("test") file=SpecialFolder.Desktop.Child("archive") // add a few files b=File.CreateBinaryFile("application/binary") c=folder.Count for i=1 to c file=folder.TrueItem(i) if file.Visible then AddFile b,file end if next MsgBox str(CountFiles(b))+" files." folder=SpecialFolder.Desktop.Child("test output") folder.CreateAsFolder for i=1 to c file=ExtractFile(b,i,folder) next End EventHandler

End Class

MenuBar MenuBar1

MenuItem UntitledMenu1 = ""

MenuItem FileMenu = "&File"

MenuItem FileQuit = "Quit"

MenuItem UntitledMenu5 = ""

MenuItem EditMenu = "&Edit"

MenuItem EditUndo = "&Undo"

MenuItem UntitledMenu0 = "-"

MenuItem EditCut = "Cu&t"

MenuItem EditCopy = "&Copy"

MenuItem EditPaste = "&Paste"

MenuItem EditClear = "Clear"

MenuItem UntitledMenu4 = ""

MenuItem UntitledMenu3 = ""

MenuItem UntitledMenu2 = ""

End MenuBar

Class App Inherits Application

End Class

Module Util

Sub AddFile(b as binaryStream, file as folderitem) dim n as string dim l,ll as integer dim bb as BinaryStream dim s as string dim ss as string b.Write "FILE" // first name n=file.Name l=lenb(n) b.WriteInt32 l b.Write n // creator #If RBVersion < 2020 Then n = file.MacCreator #Else n = "" #EndIf l=lenb(n) b.WriteInt32 l b.Write n // type #If RBVersion < 2020 Then n = file.MacCreator #Else n = "" #EndIf l=lenb(n) b.WriteInt32 l b.Write n // content l=0 bb=file.OpenAsBinaryFile(false) if bb<>nil then l=bb.Length s=bb.Read(l) end if b.WriteInt32 l // uncompressed size if l>0 then ss=CompressZLibMBS(s,9) ll=lenb(ss) if ll>=l then // compressed bigger than uncompressed? ss=S ll=l end if b.WriteInt32 ll b.Write ss else b.WriteInt32 0 // nothing inside end if End Sub

Function CountFiles(b as binaryStream) As integer dim n,count as integer dim s as string dim l,c as integer n=b.Position b.Position=0 // start at start count=0 while not b.eof s=b.Read(4) if s="FILE" then count=count+1 l=b.ReadInt32 s=b.Read(l) l=b.ReadInt32 s=b.Read(l) l=b.ReadInt32 s=b.Read(l) l=b.ReadInt32 c=b.ReadInt32 s=b.Read(c) end if wend b.Position=n Return count End Function

Function ExtractFile(b as binaryStream, index as integer, dest as folderitem) As folderitem dim n,count as integer dim s,Name,Type,Creator,Content as string dim l,c as integer dim f as FolderItem dim bb as BinaryStream n=b.Position b.Position=0 // start at start count=0 while not b.eof s=b.Read(4) if s="FILE" then count=count+1 l=b.ReadInt32 Name=b.Read(l) l=b.ReadInt32 Creator=b.Read(l) l=b.ReadInt32 Type=b.Read(l) l=b.ReadInt32 c=b.ReadInt32 Content=b.Read(c) if index=count then if l<>c then // decompress if needed Content=DecompressZLibMBS(Content,l) end if f=dest.Child(name) bb=f.CreateBinaryFile("application/binary") if bb=nil then f=nil else bb.Write content bb.Close #If RBVersion < 2019 f.MacType = type f.MacCreator = Creator #endif End If End If end if wend b.Position=n Return f End Function

Function ExtractPicture(b as binaryStream, index as integer) As picture dim n,count as integer dim s,Name,Type,Creator,Content as string dim l,c as integer n=b.Position b.Position=0 // start at start count=0 while not b.eof s=b.Read(4) if s="FILE" then count=count+1 l=b.ReadInt32 Name=b.Read(l) l=b.ReadInt32 Creator=b.Read(l) l=b.ReadInt32 Type=b.Read(l) l=b.ReadInt32 c=b.ReadInt32 Content=b.Read(c) if index=count then if l<>c then // decompress if needed Content=DecompressZLibMBS(Content,l) end if b.Position=n Return picture.FromData(content) end if end if wend b.Position=n End Function

End Module