Platforms to show: All Mac Windows Linux Cross-Platform

Required plugins for this example: MBS Compression Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Compression/Archive/archive
This example is the version from Mon, 16th Dec 2018.
Project "archive.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open() CreateTestFiles CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child("test.tar"), ArchiveWriterMBS.kFilterNone, ArchiveWriterMBS.kFormatTar CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child("test.tbz"), ArchiveWriterMBS.kFilterBZip2, ArchiveWriterMBS.kFormatTar CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child("test.tgz"), ArchiveWriterMBS.kFilterGZip, ArchiveWriterMBS.kFormatTar CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child(""), ArchiveWriterMBS.kFilterNone, ArchiveWriterMBS.kFormatZip, 1 CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child(""), ArchiveWriterMBS.kFilterNone, ArchiveWriterMBS.kFormatZip, 2 CreateArchive SpecialFolder.Desktop.Child("test"), SpecialFolder.Desktop.child("test.7z"), ArchiveWriterMBS.kFilterNone, ArchiveWriterMBS.kFormat7Zip log "done" End EventHandler
Sub CreateArchive(item as FolderItem, destFile as FolderItem, Filter as integer, Format as integer, ZipLevel as integer = 0) dim flags as integer = 0 flags = BitwiseOr(flags, ArchiveReaderMBS.kExtractTime) flags = BitwiseOr(flags, ArchiveReaderMBS.kExtractPermission) flags = BitwiseOr(flags, ArchiveReaderMBS.kExtractACL) flags = BitwiseOr(flags, ArchiveReaderMBS.kExtractFileFlags) dim aw as new ArchiveWriterMBS aw.AddFilter filter if aw.Lasterror <> aw.kArchiveOK then log "Failed to set filter with error "+str(aw.Lasterror)+": "+aw.ErrorString exit end if aw.SetFormat Format if aw.Lasterror <> aw.kArchiveOK then log "Failed to set format with error "+str(aw.Lasterror)+": "+aw.ErrorString exit end if Select case ZipLevel case 1 aw.ZipSetCompressionStore case 2 aw.ZipSetCompressionDeflate end Select log "Create " if not aw.CreateFile(destFile) then log "Failed to create file: "+aw.ErrorString return end if if not aw.SetCurrentWorkingDirectory(item.parent) then log "Failed to set working directory." return end if dim disk as new ArchiveReadDiskMBS if not disk.Open( then log "Failed to set item for compress." return end if do dim entry as ArchiveEntryMBS = disk.NextHeader if disk.Lasterror = disk.kArchiveEOF then exit end if if disk.Lasterror <> disk.kArchiveOK then log "Failed to get next item with error "+str(disk.Lasterror)+": "+disk.ErrorString exit end if if entry = nil then break exit end if dim PathName as string = entry.PathName dim FileName as string = NthField(PathName, "/", CountFields(PathName,"/")) if left(FileName,1) = "." then Continue // skip disk.Descend log "add "+PathName // make flat archive 'entry.PathName = filename aw.WriteHeader entry if aw.Lasterror <> aw.kArchiveOK then log "Failed to write header with error "+str(aw.Lasterror)+": "+aw.ErrorString exit end if dim size as int64 = aw.WriteData(disk) log str(size)+" bytes" // optional close each item. 'aw.FinishEntry if aw.Lasterror <> aw.kArchiveOK then log "Failed to finish entry with error "+str(aw.Lasterror)+": "+disk.ErrorString exit end if loop aw.Close disk.Close End Sub
Sub CreateTestFiles() dim f as FolderItem = SpecialFolder.Desktop.Child("test") f.CreateAsFolder // write test file dim t as TextOutputStream = TextOutputStream.Create(f.Child("test.txt")) t.WriteLine "Hello World" // write two files with logos dim p as Picture = LogoMBS(500) p.Save(f.Child("mbs.jpg"), p.SaveAsJPEG) p.Save(f.Child("logo.jpg"), p.SaveAsJPEG) // write second text file t = TextOutputStream.Create(f.Child("other.txt")) t.WriteLine "Just a test" // write 10 MB file with all zeros, good to compress dim b as BinaryStream = BinaryStream.Create(f.Child("zeros.txt"), true) dim m as new MemoryBlock(1024*1024*10) b.Write m dim subfolder as FolderItem = f.Child("sub folder") subfolder.CreateAsFolder p.Save(subfolder.Child("logo2.jpg"), p.SaveAsJPEG) End Sub
Sub ExtractArchive(ArchiveFile as FolderItem, Dest as FolderItem) End Sub
End Class
Class LogWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Module LogModule
Sub log(s as string) LogWindow.list.addrow s End Sub
End Module
End Project

Feedback, Comments & Corrections

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

The biggest plugin in space...

MBS FileMaker blog