Platforms to show: All Mac Windows Linux Cross-Platform

/Compression/bzip2/ZipTests


Required plugins for this example: MBS Util Plugin, MBS Compression Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Compression/bzip2/ZipTests

This example is the version from Sat, 1st Jun 2018.

Project "ZipTests.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control Listbox1 Inherits Listbox
ControlInstance Listbox1 Inherits Listbox
End Control
Control ProgressBar1 Inherits ProgressBar
ControlInstance ProgressBar1 Inherits ProgressBar
End Control
Control ProgressBar2 Inherits ProgressBar
ControlInstance ProgressBar2 Inherits ProgressBar
End Control
EventHandler Sub Open() w=new work w.run End EventHandler
Private Function CompareFiles(fi as FolderItem, fo as FolderItem) As integer dim bi,bo as BinaryStream bi=fi.OpenAsBinaryFile(false) bo=fo.OpenAsBinaryFile(false) dim si,so as string si=bi.Read(bi.Length) so=bo.Read(bo.Length) return StrCompBytesMBS(si,so) End Function
Private Sub CompressFile(fi as folderitem, fo as folderitem, chunk as integer) dim z as BZip2compressMBS dim o,i as String dim bo,bi as BinaryStream z=new BZip2compressMBS(chunk) bi=fi.OpenAsBinaryFile(false) if bi=nil then MsgBox "Can't open source file." Return end if bo=fo.CreateBinaryFile("application/x-compress") if bo=nil then MsgBox "Can't open destination file." Return end if bo.LittleEndian=false z.InitZip(9) ProgressBar1.Maximum=bi.Length/1024 do if z.InputAvail=0 and not bi.eof then if z.SetInput(bi.Read(chunk)) then ProgressBar1.Value=bi.Position/1024 ProgressBar1.Refresh UpdateNow else MsgBox "SetInput failed!" Return end if end if z.ProcessZip(False) o=z.GetOutput bo.Write o loop until (lenb(o)=0 and z.OutputSize=0 and z.InputAvail=0 and bi.eof) or UserCancelled // maybe flush is needed? do z.ProcessZip(true) o=z.GetOutput bo.Write o loop until (lenb(o)=0 and z.OutputSize=0 and z.InputAvail=0 and bi.eof) or UserCancelled // finish z.EndZip o=z.GetOutput if o<>"" then bo.Write o end if bi.Close bo.Close End Sub
Private Sub DecompressFile(fi as FolderItem, fo as FolderItem, chunk as integer) // Decompress using the ZipCompressMBS class dim z as BZip2DecompressMBS dim o,i as String dim bo,bi as BinaryStream dim s as String z=new BZip2DecompressMBS(chunk) bi=fi.OpenAsBinaryFile(false) if bi=nil then MsgBox "Can't open source file." Return end if bo=fo.CreateBinaryFile("special/any") if bo=nil then MsgBox "Can't open destination file." Return end if bi.LittleEndian=false z.InitZip ProgressBar2.Maximum = bi.Length/1024 do if z.InputAvail=0 and not bi.eof then if z.SetInput(bi.Read(30000)) then ProgressBar2.Value=bi.Position/1024 ProgressBar2.Refresh UpdateNow else MsgBox "SetInput failed!" Return end if end if z.ProcessZip o=z.GetOutput bo.Write o // end when no data was created, no output is pending and no input is waiting and the file ended loop until (lenb(o)=0 and z.OutputSize=0 and z.InputAvail=0 and bi.eof) or UserCancelled do z.ProcessZip o=z.GetOutput bo.Write o // end when no data was created, no output is pending and no input is waiting and the file ended loop until (lenb(o)=0 and z.OutputSize=0 and z.InputAvail=0 and bi.eof) or UserCancelled z.EndZip o=z.getOutput if o<>"" then bo.Write o end if bi.Close bo.Close End Sub
Private Sub MakeTestData() // and some random data dim m as MemoryBlock=New MemoryBlock(1024) dim i,c as integer dim r as new Random c=m.Size-1 for i=0 to c m.Byte(i)=r.InRange(0,255) next dim t as string = m.StringValue(0,m.Size) dim a(-1) as string for i=0 to 300 a.Append t next data=join(a) Listbox1.AddRow "Created test data: "+str(lenb(data))+" bytes" End Sub
Private Sub PrepareFile(f as FolderItem, len as integer) dim stream as BinaryStream=f.CreateBinaryFile("") dim d as string = leftb(data,len) stream.Write d stream.Close End Sub
Sub Test() MakeTestData TestFunction TestClass 1024 TestClass 10240 TestClass 102400 TestClass 1024000 TestClass 10240000 End Sub
Private Sub TestClass(chunk as integer) for i as integer=1 to 10 Listbox1.AddRow "Test Compress class" ProgressBar2.Value=0 ProgressBar1.Value=0 dim len as integer=rnd*len(data)+1 dim uncompressedfile as FolderItem=SpecialFolder.Desktop.Child("ZipTests uncompressed file") dim compressedfile as FolderItem=SpecialFolder.Desktop.Child("ZipTests compressed file") dim decompressedfile as FolderItem=SpecialFolder.Desktop.Child("ZipTests decompressed file") PrepareFile uncompressedfile,len Listbox1.AddRow " Uncompressed "+str(uncompressedfile.Length)+" bytes" CompressFile uncompressedfile,compressedfile,chunk Listbox1.AddRow " Compressed "+str(compressedfile.Length)+" bytes" DeCompressFile compressedfile,decompressedfile,chunk Listbox1.AddRow " Decompressed "+str(decompressedfile.Length)+" bytes" if uncompressedfile.Length<>decompressedfile.Length then Listbox1.AddRow " Error! files do not match in length." listbox1.CellBold(listbox1.LastIndex,0)=true end if if CompareFiles(uncompressedfile, decompressedfile)<>0 then Listbox1.AddRow " Error! Strings do not match in content." listbox1.CellBold(listbox1.LastIndex,0)=true end if uncompressedfile.Delete compressedfile.Delete decompressedfile.Delete next End Sub
Private Sub TestFunction() for i as integer=1 to 10 dim len as integer=rnd*len(data)+1 dim input as string = leftb(data,len) Listbox1.AddRow "Test Compress function" Listbox1.AddRow " Uncompressed "+str(lenb(input))+" bytes" dim compressed as string = CompressBZip2MBS(input,9) Listbox1.AddRow " Compressed "+str(lenb(compressed))+" bytes" dim Decompressed as string = DecompressBZip2MBS(compressed, len+1000) Listbox1.AddRow " Decompressed "+str(lenb(decompressed))+" bytes" if lenb(input)<>lenb(Decompressed) then Listbox1.AddRow " Error! Strings do not match in length." listbox1.CellBold(listbox1.LastIndex,0)=true end if if StrCompBytesMBS(Decompressed,input)<>0 then Listbox1.AddRow " Error! Strings do not match in content." listbox1.CellBold(listbox1.LastIndex,0)=true end if next End Sub
Property Private data As string
Property w As work
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
Class Work Inherits thread
EventHandler Sub Run() window1.test End EventHandler
End Class
End Project

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


The biggest plugin in space...