Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Compression/Archive Files Example
Function:
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Compression/Archive Files Example
This example is the version from Mon, 24th Sep 2017.
Project "Archive Files Example.rbp"
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 EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "Clear"
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.WriteLong l b.Write n // creator n=file.MacCreator l=lenb(n) b.WriteLong l b.Write n // type n=file.MacCreator l=lenb(n) b.WriteLong 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.WriteLong 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.WriteLong ll b.Write ss else b.WriteLong 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.ReadLong s=b.Read(l) l=b.ReadLong s=b.Read(l) l=b.ReadLong s=b.Read(l) l=b.ReadLong c=b.ReadLong 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.ReadLong Name=b.Read(l) l=b.ReadLong Creator=b.Read(l) l=b.ReadLong Type=b.Read(l) l=b.ReadLong c=b.ReadLong 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 f.MacType=type f.MacCreator=Creator end if end if end if wend b.Position=n Return f End Function
Function ExtractPicture(b as binaryStream, index as integer, dest as folderitem) 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.ReadLong Name=b.Read(l) l=b.ReadLong Creator=b.Read(l) l=b.ReadLong Type=b.Read(l) l=b.ReadLong c=b.ReadLong 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
End Project

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Compression Plugin.




Links
MBS Xojo PDF Plugins