Platforms to show: All Mac Windows Linux Cross-Platform
/Compression/bzip2/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/bzip2/Compress test
This example is the version from Sat, 1st Jun 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 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:
The items on this page are in the following plugins: MBS Compression Plugin.