Class App Inherits Application

Const kEditClear = "&Löschen"

Const kFileQuit = "Beenden"

Const kFileQuitShortcut = ""

End Class

Class Window1 Inherits Window

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 ZLibcompressMBS dim o,i as String dim bo,bi as BinaryStream z=new ZLibcompressMBS(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 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(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 ZLibDecompressMBS dim o,i as String dim bo,bi as BinaryStream dim s as String dim l as Int64 z=new ZLibDecompressMBS(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 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(False) 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(true) 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() // 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 = CompressZLibMBS(input,9) Listbox1.AddRow " Compressed "+str(lenb(compressed))+" bytes" dim Decompressed as string = DecompressZLibMBS(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