Platforms to show: All Mac Windows Linux Cross-Platform

/Compression/zlib/Compress test


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/zlib/Compress test

This example is the version from Sat, 9th Nov 2018.

Project "Compress test.xojo_binary_project"
FileTypes
Filetype application/x-compress
Filetype special/any
End FileTypes
Class Window1 Inherits Window
Control ProgressBar1 Inherits ProgressBar
ControlInstance ProgressBar1 Inherits ProgressBar
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() Compress_func End EventHandler
End Control
Control ProgressBar2 Inherits ProgressBar
ControlInstance ProgressBar2 Inherits ProgressBar
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() Compress_class End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action() decompress_func End EventHandler
End Control
Control PushButton4 Inherits PushButton
ControlInstance PushButton4 Inherits PushButton
EventHandler Sub Action() decompress_class End EventHandler
End Control
EventHandler Sub Open() compare End EventHandler
Sub Compress_class() // Compress using the ZipCompressMBS class dim z as new ZLibcompressMBS dim o as String dim fo,fi as FolderItem dim bo,bi as BinaryStream fi=GetOpenFolderItem("special/any") if fi=nil then Return end if fo=GetSaveFolderItem("application/x-compress",fi.name+".zlib") if fo=nil then Return end if 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(30000)) then ProgressBar1.Value=bi.Position/1024 ProgressBar1.Refresh UpdateNow else MsgBox "SetInput failed!" Return end if end if z.ProcessZip o=z.GetOutput if o<>"" then bo.Write o end if loop until (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 MsgBox "Compression finished. (message: """+z.ErrorMessage+""", CRC is "+hex(z.crc)+")" End Sub
Sub Compress_func() // Compress using the Compress function dim o,q as String dim fo,fi as FolderItem dim bo,bi as BinaryStream dim l as integer fi=GetOpenFolderItem("special/any") if fi=nil then Return end if fo=GetSaveFolderItem("application/x-compress",fi.name+".zlib") if fo=nil then Return end if 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 l=bi.Length q=bi.Read(l) o=CompressZLibMBS(q,9) bo.LittleEndian=false bo.Write o bi.Close bo.Close MsgBox "Compression finished." End Sub
Sub compare() 'dim f as FolderItem 'dim bi,bo as BinaryStream 'dim li,lo as integer ' 'f=SpecialFolder.Desktop.Child("IMG_3625.jpg.zlib") 'bi=f.OpenAsBinaryFile(false) ' 'f=SpecialFolder.Desktop.Child("IMG_3625.jpg copy.zlib") 'bo=f.OpenAsBinaryFile(false) ' 'while not bi.eof and not bo.eof 'li=bi.ReadLong 'lo=bo.ReadLong ' 'if li<>lo then 'bi.Position=bi.Position-4 'bo.Position=bo.Position-4 ' 'DebugMessageMBS str(bi.Position)+" "+hex(li)+" "+hex(lo)+" "+bi.Read(4)+" "+bo.Read(4) 'end if 'if bi.Position>1000 then 'exit 'end if 'wend ' 'DebugMessageMBS "fertig" End Sub
Sub crc() dim b as BinaryStream dim f as FolderItem dim i,j as integer dim s as String dim o as String f=SpecialFolder.Desktop.Child("IMG_3625.jpg") b=f.OpenAsBinaryFile(false) s=b.Read(b.Length) b.Close o=CompressZLibMBS(s,9) j=CRC_32OfStrMBS(o) i=CRC_32OfStrMBS(s) System.DebugLog "len "+str(lenb(S)) System.DebugLog "crc "+hex(i) System.DebugLog "len "+str(lenb(o)) System.DebugLog "crc "+hex(j) End Sub
Sub decompress_class() // Decompress using the ZipCompressMBS class dim z as new ZLibDecompressMBS dim o as String dim fo,fi as FolderItem dim bo,bi as BinaryStream dim s as String fi=GetOpenFolderItem("application/x-compress") if fi=nil then Return end if s=fi.Name s=Replaceall(s,".zlib","") fo=GetSaveFolderItem("special/any",s) if fo=nil then Return end if 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 if o<>"" then bo.Write o end if loop until (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 MsgBox "Decompression finished. (message: """+z.ErrorMessage+""")" End Sub
Sub decompress_func() // Decompress using the Uncompress function dim o as String dim fi,fo as FolderItem dim bo,bi as BinaryStream dim s as String fi=GetOpenFolderItem("application/x-compress") if fi=nil then Return end if s=fi.Name s=Replaceall(s,".zlib","") fo=GetSaveFolderItem("special/any",s) if fo=nil then Return end if 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 o=bi.Read(bi.Length) o=DecompressZLibMBS(o) if o="" then MsgBox "Decompression failed." Return end if bo.Write o bi.Close bo.Close MsgBox "Decompression finished." End Sub
End Class
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu7 = ""
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
MenuItem UntitledMenu6 = ""
MenuItem UntitledMenu5 = ""
MenuItem UntitledMenu4 = ""
End MenuBar
Class App Inherits Application
End Class
End Project

See also:

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


The biggest plugin in space...