Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Compression/bzip2/Compress test
Function:
Required plugins for this example: MBS Compression Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Compression/bzip2/Compress test
This example is the version from Sat, 1st Jun 2018.
Project "Compress test.rbp"
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 Bzip2compressMBS dim o,i as String dim fo,fi as FolderItem dim bo,bi as BinaryStream z=new Bzip2compressMBS fi=GetOpenFolderItem("special/any") if fi=nil then Return end if fo=GetSaveFolderItem("application/x-compress",fi.name+".bz2") 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 bo.WriteInt64 bi.Length 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." End Sub
Sub Compress_func() // Compress using the Compress function dim o,i,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+".bz2") 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=CompressBZip2MBS(q,9) bo.LittleEndian=false bo.WriteInt64 l 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 Int64 ' 'f=SpecialFolder.Desktop.Child("ServiceDemo2.sit.zlib") 'bi=f.OpenAsBinaryFile(false) ' 'f=SpecialFolder.Desktop.Child("ServiceDemo3.sit.zlib") 'bo=f.OpenAsBinaryFile(false) ' 'while not bi.eof and not bo.eof 'li=bi.ReadInt64 'lo=bo.ReadInt64 ' 'if li<>lo then 'bi.Position=bi.Position-8 'bo.Position=bo.Position-8 ' 'DebugMessageMBS str(bi.Position)+" "+hex(li)+" "+hex(lo)+" "+bi.Read(8)+" "+bo.Read(8) '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("TTsZipPackage.sit") 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 Bzip2DecompressMBS dim o,i as String dim fo,fi as FolderItem dim bo,bi as BinaryStream dim s as String dim l as integer z=new Bzip2DecompressMBS fi=GetOpenFolderItem("application/x-compress") if fi=nil then Return end if s=fi.Name s=Replaceall(s,".bz2","") 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 l=bi.ReadInt64 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." End Sub
Sub decompress_func() // Decompress using the Uncompress function dim o,i as String dim fo,fi,fc as FolderItem dim bo,bi as BinaryStream dim ulen as integer dim s as String dim l as integer fi=GetOpenFolderItem("application/x-compress") if fi=nil then Return end if s=fi.Name s=Replaceall(s,".bz2","") 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 ulen=bi.ReadInt64 o=bi.Read(bi.Length-4) o=DecompressBZip2MBS(o,ulen) if o="" then MsgBox "Decompression failed." Return end if if len(o)<>ulen then MsgBox "Warning: Decompressed data is too short." 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 UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
End Class
End Project

See also:

Feedback, Comments & Corrections

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




Links
MBS Xojo Plugins