You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Compression/Old
Class Window1 Inherits Window
Control bar Inherits ProgressBar
ControlInstance bar Inherits ProgressBar
End Control
Control Thread1 Inherits Thread
ControlInstance Thread1 Inherits Thread
EventHandler Sub Run()
DoWork
End EventHandler
End Control
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
while NewListRows.Ubound >= 0
dim s as string = NewListRows(0)
NewListRows.Remove 0
List.AddRow s
wend
if NewProgressValue <> bar.Value then
bar.Value = NewProgressValue
end if
if NewProgressMaximum <> bar.Maximum then
bar.Maximum = NewProgressMaximum
end if
End EventHandler
End Control
EventHandler Sub Open()
Thread1.run
End EventHandler
Sub DoWork()
dim f as FolderItem
dim z as UnZipMBS
dim lines(-1) as string
dim s as string
dim info as UnZipFileInfoMBS
dim totalsize as Int64
f=SpecialFolder.Desktop.Child("test.zip")
if f=nil or f.Exists=False then
MsgBox "You need a test.zip file on your desktop folder."
Return
end if
totalsize = f.Length
NewProgressValue = 0
z=new UnZipMBS(f)
NewProgressMaximum = z.Count
dim destfolder as FolderItem = f.Parent.Child("test.zip folder")
NewListRows.Append "FileCount: "+str(z.Count)
z.GoToFirstFile
do
dim isFolder as Boolean=false
dim path as string = z.FileName
// we need to know text encoding, so we guess ASCII here
path = DefineEncoding(path, encodings.ASCII)
NewListRows.Append "CurrentFileName: "+path
if Right(path,1)="/" then
isFOlder=true
end if
if encodings.UTF8.IsValidData(path) then
path = DefineEncoding(path, encodings.UTF8)
end if
f = getpath(destfolder, path)
info=z.FileInfo
NewListRows.Append "uncompressedSize: "+str(info.uncompressedSize)
NewListRows.Append "compressedSize: "+str(info.compressedSize)
NewListRows.Append "date: "+info.date.ShortDate+" "+info.date.ShortTime
if isfolder then
f.CreateAsFolder
else
dim b as BinaryStream=f.CreateBinaryFile("")
if b<>nil then
z.OpenCurrentFile
if z.Lasterror=0 then
while z.eof=0
s=z.ReadCurrentFile(1000000)
b.Write s
wend
z.CloseCurrentFile
b.Close
end if
else
NewListRows.Append "Failed to create binary stream for "+f.NativePath
end if
end if
f.ModificationDate=info.Date
#if not TargetLinux then
f.CreationDate=info.date
#endif
NewProgressValue = NewProgressValue + 1
z.GoToNextFile
loop until z.Lasterror<>0
End Sub
Function getpath(parent as FolderItem, path as string) As FolderItem
dim i,c as integer
c=CountFields(path,"/")
dim f as FolderItem = parent
for i=1 to c
dim s as string = NthField(path,"/",i)
if s<>"" then
if f.Exists=False then
f.CreateAsFolder
end if
f=f.Child(s)
end if
next
Return f
End Function
Protected Function str(b as boolean) As string
if b then
Return "true"
else
Return "false"
end if
End Function
Property NewListRows() As string
Property NewProgressMaximum As Integer
Property NewProgressValue As Integer
End Class
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
End Class