Class App Inherits Application

Const kEditClear = "&Delete"

Const kFileQuit = "&Quit"

Const kFileQuitShortcut = ""

End Class

Class winMain Inherits Window

Private Sub refreshList() lstArchive.DeleteAllRows if archive = nil then return dim children() as ZipItem = archive.getChildren for i as integer = 0 to ubound(children) if children(i).isDirectory then lstArchive.AddFolder children(i).getName else lstArchive.AddRow children(i).getName end lstArchive.CellTag(lstArchive.LastIndex,0) = children(i) next End Sub

Sub update(complete as double) // Part of the ProgressMonitor interface. prgProgress.maximum = 1000 prgProgress.Value = prgProgress.Maximum * complete End Sub

Property Private archive As ZipArchive

Property Private destination As FolderItem

Property Private source As FolderItem

End Class

MenuBar MenuBar1

MenuItem FileMenu = "&File"

MenuItem FileQuit = "#App.kFileQuit"

MenuItem EditMenu = "&Edit"

MenuItem EditUndo = "&Undo"

MenuItem UntitledMenu1 = "-"

MenuItem EditCut = "Cu&t"

MenuItem EditCopy = "&Copy"

MenuItem EditPaste = "&Paste"

MenuItem EditClear = "#App.kEditClear"

MenuItem UntitledMenu0 = "-"

MenuItem EditSelectAll = "Select &All"

End MenuBar

Interface StreamReader

Function eof() As boolean

Function getPosition() As uint64

Function readAll(encoding as TextEncoding = nil) As String

Function readCString(encoding as TextEncoding = nil) As String

Function readInt16() As int16

Function readInt32() As int32

Function readInt64() As int64

Function readInt8() As int8

Function readPString(encoding as TextEncoding = nil) As String

Function readString(bytes as uint64, encoding as TextEncoding = nil) As String

Function readUInt16() As Uint16

Function readUInt32() As Uint32

Function readUInt64() As Uint64

Function readUInt8() As Uint8

Sub skip(bytes as uint64)

End Interface

Interface StreamWriter

Sub flush()

Function getPosition() As uint64

Sub rewind(bytes as uint64)

Sub skip(bytes as uint64)

Sub writeCString(text as string)

Sub writeInt16(value as int16)

Sub writeInt32(value as int32)

Sub writeInt64(value as Int64)

Sub writeInt8(value as int8)

Sub writePString(text as string)

Sub writeString(text as string)

Sub writeUInt16(value as Uint16)

Sub writeUInt32(value as Uint32)

Sub writeUInt64(value as Uint64)

Sub writeUInt8(value as Uint8)

End Interface

Class FileStream

Function EndOfFile() As Boolean // Part of the StreamReader interface. // Part of the Readable interface. return stream.EOF End Function

Function Read(Count As Integer, encoding As TextEncoding = Nil) As String // Part of the Readable interface. return stream.read(count,encoding) End Function

Function ReadError() As Boolean // Part of the Readable interface. return stream.ReadError End Function

Sub Rewind(bytes as Uint64) stream.Position = stream.Position - bytes End Sub

Sub Write(text As String) // Part of the Writeable interface. stream.Write(text) End Sub

Function WriteError() As Boolean // Part of the Writeable interface. return stream.WriteError End Function

Sub constructor(b as binaryStream) stream = b End Sub

Sub constructor(file as folderItem, type as filetype = nil) if not file.Exists then if type = nil then stream = file.CreateBinaryFile("") else stream = file.CreateBinaryFile(type) end else stream = file.OpenAsBinaryFile(true) end End Sub

Sub constructor(file as folderItem, type as filetype = nil, littleEndian as boolean) constructor (file, type) stream.LittleEndian = littleEndian End Sub

Function eof() As boolean // Part of the StreamReader interface. // Part of the Readable interface. return stream.EOF End Function

Sub flush() // Part of the StreamWriter interface. stream.Flush End Sub

Function getLength() As uint64 return stream.Length End Function

Function getPosition() As uint64 // Part of the StreamReader interface. // Part of the StreamWriter interface. return stream.Position End Function

Function getString() As String // Part of the StringProvider interface. dim pos as uint64 = stream.Position stream.Position = 0 dim text as string = stream.Read(stream.Length) stream.Position = pos return text End Function

Function readAll(encoding as textEncoding = nil) As string return readString(stream.Length-stream.Position,encoding) End Function

Function readCString(encoding as TextEncoding = nil) As String // Part of the StreamReader interface. End Function

Function readInt16() As int16 // Part of the StreamReader interface. return stream.ReadInt16 End Function

Function readInt32() As int32 // Part of the StreamReader interface. return stream.ReadInt32 End Function

Function readInt64() As int64 // Part of the StreamReader interface. return stream.ReadInt64 End Function

Function readInt8() As int8 // Part of the StreamReader interface. return stream.ReadInt8 End Function

Function readPString(encoding as TextEncoding = nil) As String // Part of the StreamReader interface. dim len as uint8 = readUInt8 return readString(len,encoding) End Function

Function readString(bytes as uint64, encoding as TextEncoding = nil) As String // Part of the StreamReader interface. return stream.Read(bytes,encoding) End Function

Function readUInt16() As Uint16 // Part of the StreamReader interface. return stream.ReadUInt16 End Function

Function readUInt32() As Uint32 // Part of the StreamReader interface. return stream.ReadUInt32 End Function

Function readUInt64() As Uint64 // Part of the StreamReader interface. return stream.ReadUInt64 End Function

Function readUInt8() As Uint8 // Part of the StreamReader interface. return stream.ReadUInt8 End Function

Sub setPosition(pos as uInt64) stream.Position = pos End Sub

Sub setString(Str As String) // Part of the StringInterface interface. stream.Position = 0 stream.Write str stream.Length = stream.Position End Sub

Sub skip(bytes as uint64) // Part of the StreamReader interface. // Part of the StreamWriter interface. stream.Position = stream.Position + bytes End Sub

Sub truncate() //truncate the file to the current position stream.Length = stream.Position End Sub

Sub writeCString(text as string) // Part of the StreamWriter interface. stream.Write(text) stream.WriteUInt8 0 End Sub

Sub writeInt16(value as int16) // Part of the StreamWriter interface. stream.WriteInt16 value End Sub

Sub writeInt32(value as int32) // Part of the StreamWriter interface. stream.WriteInt32 value End Sub

Sub writeInt64(value as Int64) // Part of the StreamWriter interface. stream.WriteInt64 value End Sub

Sub writeInt8(value as int8) // Part of the StreamWriter interface. stream.WriteInt8 value End Sub

Sub writePString(text as string) // Part of the StreamWriter interface. dim ln as UInt8 = min(text.lenb,255) stream.WriteInt8 ln stream.Write text.LeftB(ln) End Sub

Sub writeString(text as string) // Part of the StreamWriter interface. stream.Write text End Sub

Sub writeUInt16(value as Uint16) // Part of the StreamWriter interface. stream.WriteUInt16 value End Sub

Sub writeUInt32(value as Uint32) // Part of the StreamWriter interface. stream.WriteUInt32 value End Sub

Sub writeUInt64(value as Uint64) // Part of the StreamWriter interface. stream.WriteUInt64 value End Sub

Sub writeUInt8(value as Uint8) // Part of the StreamWriter interface. stream.WriteUInt8 value End Sub

Property Private stream As binaryStream

End Class

Module RBZ

Const FilesystemAcornRISCOS = 13

Const FilesystemAlternateMVS = 15

Const FilesystemAmiga = 1

Const FilesystemAtari = 5

Const FilesystemBeOS = 16

Const FilesystemCP_M = 9

Const FilesystemFAT = 0

Const FilesystemHPFS = 6

Const FilesystemMVS = 11

Const FilesystemMacintosh = 7

Const FilesystemNTFS = 10

Const FilesystemOSX = 19

Const FilesystemOS_400 = 18

Const FilesystemTandem = 17

Const FilesystemUnix = 3

Const FilesystemVFAT = 14

Const FilesystemVM = 4

Const FilesystemVMS = 2

Const FilesystemVSE = 12

Const FilesystemZSystem = 8

Const Version = 1.1

Enum CompressionMethod none deflate unsupported End Enum

Enum DeflateLevel maximum normal fast fastest End Enum

Function createAsZipArchive(extends archive as folderItem) As ZipArchive if archive.Exists then archive.Delete return new ZipArchive(archive) End Function

Function openAsZipArchive(extends archive as folderItem) As ZipArchive return new ZipArchive(archive) End Function

Sub unzip(extends archive as folderitem, destination as folderitem) dim z as new ZipArchive(archive) z.expand destination End Sub

Sub unzip(extends archive as folderitem, destination as folderitem, options as expansionOptions) dim z as new ZipArchive(archive) z.expand destination, options End Sub

Sub zip(extends source as folderitem, archive as folderitem, comment as string = "") dim z as new ZipArchive(archive) z.addChild source, comment End Sub

Sub zip(extends source as folderitem, archive as folderitem, comment as string = "", options as compressionOptions) dim z as new ZipArchive(archive) z.addChild source, comment, options End Sub

Structure CompressionOptions method as CompressionMethod deflateLevel as DeflateLevel deflateWindow as uint16 End Structure

Structure ExpansionOptions ignoreChecksum as boolean replaceFiles as boolean ignoreErrors as boolean End Structure

End Module

Class ZipItem

Sub addChild(item as folderitem, progress as ProgressMonitor) addChild item, "", progress End Sub

Sub addChild(item as folderitem, comment as string = "", options as CompressionOptions, progress as ProgressMonitor = nil) //set compression options compressionOptions = options //add child addChild item, comment, progress End Sub

Sub addChild(item as folderitem, comment as string = "", progress as ProgressMonitor = nil) //add an item to directory if not isDirectory then return // does nothing if item is not a directory if item.name = ".DS_Store" then return // don't store system files if item.Alias then return // don't store aliases dim zp as ZipProgress if progress <> nil then zp = new ZipProgress(z_precalculateSizes(item) + 1,progress) end z_addChild item, comment, zp //add to internal structure and write file record to archive z_writeFileHeaders //write central directory records if progress <> nil then zp.increment 1 //notify completion End Sub

Protected Sub constructor(parent as ZipItem = nil) if parent <> nil then //set parent z_setParent parent //set defaults compressionOptions = parent.compressionOptions expansionOptions = parent.expansionOptions end End Sub

Sub delete(progress as ProgressMonitor = nil) dim zp as ZipProgress if progress <> nil then zp = new ZipProgress(1,progress) end z_tagForDeletion //recursively mark self and children for deletion z_compact zp //compact the file z_delete //recursively delete self and children from archive z_writeFileHeaders //write central directory records if progress <> nil then zp.increment 1 //notify completion End Sub

Sub expand(destinationDirectory as folderItem, options as ExpansionOptions, progress as ProgressMonitor = nil) dim zp as ZipProgress if progress <> nil then zp = new ZipProgress(getCompressedSize + 1,progress) end z_expand destinationDirectory, zp, options if progress <> nil then zp.increment 1 //notify completion End Sub

Sub expand(destinationDirectory as folderItem, progress as ProgressMonitor = nil) //neccessary to duplicate this code due to a strange crash which //occurs if we attempt tp call other expand function dim zp as ZipProgress if progress <> nil then zp = new ZipProgress(getCompressedSize + 1,progress) end z_expand destinationDirectory, zp, expansionOptions if progress <> nil then zp.increment 1 //notify completion End Sub

Function getArchive() As zipArchive return archive End Function

Function getChildren() As ZipItem() //return clone of children array dim c() as ZipItem for i as integer = 0 to ubound(children) c.Append children(i) next return c End Function

Function getComment() As string return comment End Function

Function getCompressedSize() As uint64 if isDirectory and compressedSize = 0 then for i as integer = 0 to UBound(children) compressedSize = compressedSize + children(i).getCompressedSize next end return compressedSize End Function

Sub getCompressionOptions(byref options as CompressionOptions) options = compressionOptions End Sub

Sub getExpansionOptions(byref options as ExpansionOptions) options = expansionOptions End Sub

Function getModified() As date return modified End Function

Function getName() As string return name End Function

Function getParent() As ZipItem return parent End Function

Function getPath() As string dim path as string = me.path if path.leftb(1) = "/" then path = path.midb(2) if path <> "" and directory and path.rightb(1) <> "/" then path = path + "/" return path End Function

Function getUncompressedSize() As uint64 if isDirectory and uncompressedSize = 0 then for i as integer = 0 to UBound(children) uncompressedSize = uncompressedSize + children(i).getUncompressedSize next end return uncompressedSize End Function

Function isDirectory() As boolean return directory End Function

Sub setExpansionOptions(options as ExpansionOptions) expansionOptions = options End Sub

Protected Sub z_addChild(item as ZipItem) if not isDirectory then return //not permitted //compare paths dim mypath as string = getPath dim childPath as string = item.getPath if childPath.lenb <= myPath.lenb then return //something's gone wrong end if childPath.leftb(mypath.lenb) <> mypath then return //something's gone wrong end dim relativePath as string = childPath.midb(mypath.lenb) if relativePath.LeftB(1) = "/" then relativePath = relativePath.midb(2) //removing leading slash if relativePath.rightb(1) = "/" then relativePath = relativePath.leftb(relativePath.lenb-1) //removing trailing slash if relativePath = item.name then //place item directly into this directory children.Append item item.z_setParent me //set defaults item.compressionOptions.deflateWindow = me.compressionOptions.deflateWindow item.expansionOptions = me.expansionOptions else dim nextDirectory as string = nthfield(relativePath,"/",1) //name of next directory in the path for i as integer = 0 to ubound(children) if children(i).name = nextDirectory then //add to existing directory children(i).z_addChild(item) return end next //create a new directory item dim dir as new ZipItem(me) children.Append dir dir.name = nextDirectory //set directory name dir.directory = true //is a directory (obviously) dir.path = getPath + dir.name //add child to new item dir.z_addChild(item) end End Sub

Private Sub z_addChild(item as folderitem, comment as string = "", progress as ZipProgress) if not isDirectory then return //not permitted dim child as new ZipItem(me) child.name = z_cleanFileName(item.Name) //set file name child.path = path +"/" + child.name //set file path child.comment = comment.ConvertEncoding(Encodings.DOSLatinUS) //set file comment child.modified = item.ModificationDate //set modification date child.directory = item.Directory //set directory status child.uncompressedSize = item.Length //set uncompressed file size children.Append child // add to internal children array //handle children (do this before writing file records so we can tell if directories are empty) for i as integer = 1 to item.Count if item.item(i).name <> ".DS_Store" then child.z_addChild item.Item(i), progress //repeat for item contents next //write the file record if child.directory then child.z_writeFileRecord nil, progress // write the directory record else child.z_writeFileRecord new FileStream(item), progress // write the file record end End Sub

Private Function z_cleanFileName(name as string) As string //encode filename for dos compatibility dim cleaned as string = name.ConvertEncoding(Encodings.DOSLatinUS) cleaned = cleaned.ReplaceAllB("/",":") //avoid name clashes with siblings for i as integer = 0 to ubound(children) while children(i).name = cleaned cleaned = z_incrementName(cleaned) wend next return cleaned End Function

Protected Sub z_collateItems(offsets() as uint64, items() as ZipItem) if isDirectory and ubound(children) > -1 then //non-empty directories aren't stored in archive, so skip and deal with children for i as integer = 0 to ubound(children) children(i).z_collateItems offsets, items next else //insert in order of offset //binary insertion sort would be faster but speed of this function is unlikely to be a bottleneck if ubound(offsets) = -1 or relativeOffset > offsets(ubound(offsets)) then offsets.Append relativeOffset items.Append me else for i as integer = ubound(offsets) downto 0 if offsets(i) > relativeOffset then offsets.Insert i, relativeOffset items.Insert i, me return end next end end End Sub

Protected Sub z_compact(progress as ZipProgress) //write file data ZipItem(archive).z_compact progress End Sub

Protected Sub z_delete() //delete children //work on a duplicate of children array as //array is manipulated by deletion process dim children() as ZipItem = getChildren for i as integer = 0 to ubound(children) children(i).z_delete next //remove self from parent for i as integer = 0 to ubound(ZipItem(parent).children) if ZipItem(parent).children(i) = me then ZipItem(parent).children.Remove i exit end next End Sub

Protected Sub z_expand(destinationDirectory as folderItem, progress as ZipProgress, options as ExpansionOptions) //must be a valid destination directory if destinationDirectory = nil or not destinationDirectory.exists then return if not destinationDirectory.directory then return //handle name clashes dim name as string = me.name #if TargetMacOS name = name.ReplaceAllB(":","/") #endif if not options.replaceFiles then for i as integer = 1 to destinationDirectory.Count while destinationDirectory.item(i).name = name //rename file to avoid clash name = z_incrementName(name) wend next end if directory then //create directory dim dir as FolderItem = destinationDirectory.Child(name) dir.CreateAsFolder //handle children for i as integer = 0 to ubound(children) children(i).z_expand dir, progress, options next else //create file dim file as FolderItem = destinationDirectory.Child(name) z_writeFile new FileStream(file), options, progress //set file modification date if modified <> nil then file.ModificationDate = modified end End Sub

Protected Function z_incrementName(name as string) As string //increment a file name number to prevent name clashes //for example foo.txt becomes foo 1.txt, foo 1.txt becomes foo 2.txt, etc dim extension as string dim theName as string if CountFields(name,".") > 1 then extension = "." + NthField(name,".",CountFields(name,".")) theName = NthField(name,".",CountFields(name,".") - 1) else theName = name end dim number as string for i as integer = theName.LenB downto 1 dim char as string = theName.MidB(i,1) if AscB(char) < 48 or AscB(char) > 57 then if char <> " " then number = "" exit else number = char + number end next if number <> "" then return theName.LeftB(theName.LenB - number.LenB) + str(val(number) + 1) + extension else return theName + " 1" + extension end End Function

Private Function z_precalculateSizes(item as folderitem) As uint64 dim total as uint64 if item.Directory then //handle children for i as integer = 1 to item.Count if item.item(i).name <> ".DS_Store" then total = total + z_precalculateSizes(item.Item(i)) //repeat for item contents end next return total end return total + item.Length End Function

Protected Sub z_setParent(parent as ZipItem) //set parent and archive properties me.parent = parent if parent isa ZipArchive then archive = ZipArchive(parent) else archive = parent.archive end End Sub

Protected Sub z_tagForDeletion() //delete children for i as integer = 0 to ubound(children) children(i).z_tagForDeletion next //tag deleted = true End Sub

Protected Sub z_writeFile(sw as StreamWriter, item as ZipItem = nil, options as ExpansionOptions, progress as ZipProgress) //write file data ZipItem(archive).z_writeFile sw, me, options, progress End Sub

Protected Sub z_writeFileHeader(sw as StreamWriter, item as Zipitem = nil) //write file header for this item ZipItem(archive).z_writeFileHeader sw, me //handle children for i as integer = 0 to ubound(children) children(i).z_writeFileHeader sw next End Sub

Protected Sub z_writeFileHeaders() ZipItem(archive).z_writeFileHeaders End Sub

Protected Sub z_writeFileRecord(item as ZipItem = nil, data as FileStream, progress as ZipProgress) ZipItem(archive).z_writeFileRecord me, data, progress End Sub

Property Protected archive As ZipArchive

Property Protected children() As ZipItem

Property Protected comment As String

Property Protected compressedSize As uint64

Property Protected compressionOptions As CompressionOptions

Property Protected crc As uint32

Property Protected deleted As boolean

Property Protected directory As boolean

Property Protected expansionOptions As ExpansionOptions

Property Protected extraData As string

Property Protected modified As Date

Property Protected name As string

Property Protected parent As ZipItem

Property Protected path As string

Property Protected relativeOffset As uint64

Property Protected uncompressedSize As uint64

End Class

Class ZipArchive Inherits ZipItem

Const useMBS = true

Sub constructor(archive as folderitem) //only call once if archiveFile <> nil then return //get default settings z_setDefaultOptions archiveFile = archive //set archive file directory = true //archive is always a directory if archive.Exists then //open the archive dim sr as new FileStream(archive,true) //find end of central directory record //work backwards to find signature for i as integer = sr.getLength - 4 downto 0 sr.setPosition i dim signature as UInt32 = sr.readUInt32 if signature = &h06054b50 then exit next if sr.getPosition = 4 then //failed to find central directory - file may be corrupt or not a zip file at all return else sr.skip 6 //get number of directory entries dim entries as uint16 = sr.readUInt16 //find and go to start of central directory sr.skip 4 centralDirectoryStart = sr.readUInt32 sr.setPosition centralDirectoryStart //parse central directory file headers for i as integer = 1 to entries z_addChild z_readFileHeader(sr) next end end End Sub

Sub delete(progress as ProgressMonitor = nil) dim zp as ZipProgress if progress <> nil then zp = new ZipProgress(1,progress) end //tag children for deletion dim children() as ZipItem = getChildren for i as integer = 0 to ubound(children) children(i).z_tagForDeletion next //compact file z_compact zp //delete children for i as integer = 0 to ubound(children) children(i).z_delete next //write central directory records z_writeFileHeaders if progress <> nil then zp.increment 1 //notify completion End Sub

Function getArchive() As ZipArchive return me End Function

Function getFileCount() As uint32 return files End Function

Shared Function getFileType() As FileType dim f as new FileType f.Name = "zip" f.Extensions = ".zip" return f End Function

Function getName() As string return archiveFile.Name End Function

Function getParent() As ZipItem return nil End Function

Sub setCompressionOptions(options as CompressionOptions) compressionOptions = options End Sub

Protected Sub z_compact(progress as ZipProgress) //sort all items in archive by offset dim offsets() as uint64 dim items() as ZipItem z_collateItems offsets, items offsets.Append centralDirectoryStart if progress <> nil then //calculate amount of data that must be moved dim counterStarted as Boolean = false for i as integer = 0 to ubound(items) if items(i).deleted then counterStarted = true elseif counterStarted then progress.total = progress.total + offsets(i+1) - offsets(i) end next end dim shift as uint64 = offsets(0) // would normally be zero, but just in case... //open archive input stream and skip to data location dim fs as FileStream = new FileStream(archiveFile,true) for i as integer = 0 to ubound(items) dim offset as uint64 = offsets(i) dim length as UInt64 = offsets(i+1) - offset dim item as ZipItem = items(i) if item.deleted then //adjust shift shift = shift + length elseif shift > 0 then //shift offset item.relativeOffset = item.relativeOffset - shift //move data fs.setPosition offset dim total as uint64 = length while total > 0 dim chunk as uint16 = min(total,compressionOptions.deflateWindow) dim data as string = fs.readString(chunk) fs.setPosition offset - shift fs.writeString data total = total - chunk if progress <> nil then progress.increment chunk wend end next centralDirectoryStart = fs.getPosition fs.truncate End Sub

Private Function z_getCRC(previous as uint32 = 0, data as string) As uint32 #pragma BoundsChecking false #pragma NilObjectChecking false #pragma BackgroundTasks false #if useMBS static z as new ZLibCompressMBS //use mbs zlib crc function return z.CRC32(previous, data) #else //create crc table if crc32Table(0) = 0 then 'this is the official polynomial used by CRC32 in PKZip. 'often the polynomial is shown reversed (04C11DB7). dim dwPolynomial As Int32 = &hEDB88320 dim i as Integer, j as Integer dim dwCrc As int32 for i = 0 to 255 dwCrc = i for j = 8 downto 1 If ((dwCrc and 1) > 0) Then dwCrc = ((dwCrc and &hFFFFFFFE) \ 2) and &h7FFFFFFF dwCrc = dwCrc xor dwPolynomial Else dwCrc = (((dwCrc and &hFFFFFFFE) \ 2) and &h7FFFFFFF) End If next crc32Table(i) = dwCrc next end //get crc dim crc as uint32 = Bitwise.OnesComplement(previous) dim iLookup as uint64 dim size as uint32 = data.LenB for i as uint32 = 1 to size iLookup = (crc and &hFF) Xor data.MidB(i,1).Asc crc = ((crc and &hFFFFFF00) \ &h100) and 16777215 crc = crc or crc32Table(iLookup) next return Bitwise.OnesComplement(crc) #endif End Function

Private Function z_getCompressionBits(options as CompressionOptions) As uint16 if options.method <> CompressionMethod.deflate then //leave bits empty return &b0000000000000000 end select case options.deflateLevel case DeflateLevel.normal return &b0000000000000000 case DeflateLevel.maximum return &b0000000000000010 case DeflateLevel.fast return &b0000000000000100 case DeflateLevel.fastest return &b0000000000000110 else Raise new UnsupportedFormatException end End Function

Private Function z_getDeflateLevel(flags as uint16) As DeflateLevel flags = Bitwise.BitAnd(flags,&b0000000000000110) select case flags case 0 return DeflateLevel.normal case 1 return DeflateLevel.maximum case 2 return DeflateLevel.fast case 3 return DeflateLevel.fastest end End Function

Private Function z_getMBSCompressionLevel(level as DeflateLevel) As uint8 select case level case DeflateLevel.maximum return 9 case DeflateLevel.normal return 6 case DeflateLevel.fast return 3 case DeflateLevel.fastest return 0 else Raise new UnsupportedFormatException end End Function

Private Function z_getZLibHeader(item as ZipItem) As string #if useMBS //get zlib header return CompressZLibMBS("foo",z_getMBSCompressionLevel(item.compressionOptions.deflateLevel)).leftb(2) #endif End Function

Private Function z_readCompressionMethod(sr as StreamReader) As CompressionMethod select case sr.readUInt16 case 8 return CompressionMethod.deflate case 0 return CompressionMethod.none else return CompressionMethod.unsupported end End Function

Private Function z_readFileHeader(sr as StreamReader) As ZipItem dim item as new ZipItem //file header signature if sr.readUInt32<> &h02014b50 then return nil //possibly corrupt? //version call sr.readUInt8 //file system call sr.readUInt8 //required version if sr.readUInt16/10 > 2 then return nil //can't read it //general purpose bit flags dim flags as UInt16 = sr.readUInt16 'flags = flags + &b0000000000000001 //file is encrypted 'flags = flags + &b0000000000000110 //compression bits 'flags = flags + &b0000000000001000 //crc32 field blank 'flags = flags + &b0000000000010000 //reserved for method 8 'flags = flags + &b0000000000100000 //patch data 'flags = flags + &b0000000001000000 //strong encryption item.compressionOptions.deflateLevel = z_getDeflateLevel(flags) //compression method item.compressionOptions.method = z_readCompressionMethod(sr) //time and date item.modified = z_readTimeStamp(sr) //crc 32 item.crc = sr.readUInt32 //compressed size item.compressedSize = sr.readUInt32 //uncompressed size item.uncompressedSize = sr.readUInt32 //file name length dim pathLength as uint16= sr.readUInt16 //extra field length dim extraFieldLength as uint16= sr.readUInt16 //file comment length dim commentLength as uint16= sr.readUInt16 //disk number start call sr.readUInt16 //internal file attributes call sr.readUInt16 //external file attibutes call sr.readUInt32 //relative offset of local header item.relativeOffset = sr.readUInt32 //file name item.path = sr.readString(pathLength,encodings.DOSLatinUS) item.name = NthField(item.path,"/",CountFields(item.path,"/")) if item.name = "" then item.name = NthField(item.path,"/",CountFields(item.path,"/")-1) item.directory = true end //extra data call sr.readString(extraFieldLength) //file comment item.comment = sr.readString(commentLength) return item End Function

Private Function z_readTimeStamp(sr as StreamReader) As Date dim d as new Date // get time dim time as UInt16 = sr.readUInt16 d.Hour = Bitwise.BitAnd(time,63488) \ 2048 d.Minute = Bitwise.BitAnd(time,2016) \ 32 d.Second = Bitwise.BitAnd(time,31) * 2 // get date dim date as UInt16 = sr.readUInt16 d.Year = Bitwise.BitAnd(date,65024) \ 512 + 1980 d.Month = Bitwise.BitAnd(date,480) \ 32 d.Day = Bitwise.BitAnd(date,31) return d End Function

Private Sub z_setDefaultOptions() //compression options #if useMBS then compressionOptions.method = CompressionMethod.deflate #else compressionOptions.method = CompressionMethod.none #endif compressionOptions.deflateLevel = DeflateLevel.normal compressionOptions.deflateWindow = 32768 //decompression options expansionOptions.ignoreChecksum = false expansionOptions.ignoreErrors = false expansionOptions.replaceFiles = false End Sub

Private Sub z_writeCompressionMethod(sw as StreamWriter, method as CompressionMethod) select case method case CompressionMethod.deflate sw.writeUInt16 8 else sw.writeUInt16 0 end End Sub

Protected Sub z_writeFile(sw as StreamWriter, item as ZipItem = nil, options as ExpansionOptions, progress as ZipProgress) //open archive input stream and skip to data location dim sr as FileStream = new FileStream(archiveFile,true) sr.setPosition item.relativeOffset //local file header signature if sr.readUInt32 <> &h04034b50 then return //not a valid file record //required version dim version as single = sr.readUInt16/10 if version > 2 then return //incompatible version //general purpose bit flags call sr.readUInt16 //compression method call sr.readUInt16 //last modified time call sr.readUInt16 //last modified date call sr.readUInt16 //crc 32 call sr.readUInt32 //compressed size call sr.readUInt32 //uncompressed size call sr.readUInt32 //file name length dim pathLength as uint16= sr.readUInt16 //extra field length dim extraFieldLength as uint16= sr.readUInt16 //file name call sr.readString(pathLength,encodings.DOSLatinUS) //extra data call sr.readString(extraFieldLength) //file data if useMBS and item.compressionOptions.method = CompressionMethod.deflate then #if useMBS //deflate (requires mbs) dim total as uint64 = item.getCompressedSize dim z as new ZLibDecompressMBS z.InitZip call z.setInput z_getZLibHeader(item) do if z.OutputSize = 0 and z.InputAvail = 0 then dim chunk as UInt16 = min(total,compressionOptions.deflateWindow) call z.setInput sr.readString(chunk) total = total - chunk if progress <> nil then progress.increment chunk end z.ProcessZip sw.writeString z.GetOutput loop until z.OutputSize = 0 and z.InputAvail = 0 and total = 0 z.EndZip #endif else //no compression dim total as uint64 = item.getCompressedSize while total > 0 dim chunk as UInt16 = min(total,compressionOptions.deflateWindow) sw.writeString sr.readString(chunk) total = total - chunk if progress <> nil then progress.increment chunk wend end End Sub

Protected Sub z_writeFileHeader(sw as StreamWriter, item as Zipitem = nil) //get compression options dim compressionOptions as CompressionOptions = item.compressionOptions #if not useMBS compressionOptions.method = CompressionMethod.none #endif //only write files or empty directories if item.isDirectory then directories = directories + 1 if ubound(item.getChildren) > -1 then return compressionOptions.method = CompressionMethod.none emptyDirectories = emptyDirectories + 1 else files = files + 1 end //file header signature sw.writeUInt32 &h02014b50 //version sw.writeUInt8 2*10 + 1 //file system #if TargetWin32 //should check for other windows filesystem types sw.writeUInt8 FilesystemFAT #elseif TargetMacOS sw.writeUInt8 FilesystemOSX #elseif TargetLinux sw.writeUInt8 FilesystemUnix #endif //required version sw.writeUInt16 2*10 + 0 //general purpose bit flags dim flags as UInt16 'flags = flags + &b0000000000000001 //file is encrypted flags = flags + z_getCompressionBits(compressionOptions) //compression bits if compressionOptions.method = CompressionMethod.deflate then flags = flags + &b0000000000001000 //crc32 field blank end 'flags = flags + &b0000000000010000 //reserved for method 8 'flags = flags + &b0000000000100000 //patch data 'flags = flags + &b0000000001000000 //strong encryption sw.writeUInt16 flags //compression method z_writeCompressionMethod sw,compressionOptions.method //time and date z_writeTimeStamp sw,item.modified //crc 32 sw.writeUInt32 item.crc //compressed size sw.writeUInt32 item.getCompressedSize //uncompressed size sw.writeUInt32 item.getUncompressedSize //file name length sw.writeUInt16 item.getPath.LenB //extra field length sw.writeUInt16 item.extraData.LenB //file comment length sw.writeUInt16 item.getComment.LenB //disk number start sw.writeUInt16 0 //internal file attributes sw.writeUInt16 0 //external file attibutes sw.writeUInt32 &h81a44000 //temporary //relative offset of local header sw.writeUInt32 item.relativeOffset //file path sw.writeString item.getPath //extra field sw.writeString item.extraData //file comment sw.writeString item.getComment End Sub

Protected Sub z_writeFileHeaders() //reset counters files = 0 directories = 0 emptyDirectories = 0 //get output file stream dim sw as new FileStream(archiveFile,true) sw.skip centralDirectoryStart dim items() as ZipItem = getChildren for i as integer = 0 to ubound(items) items(i).z_writeFileHeader sw next //digital signature ------------ 'sw.writeUInt32 &h05054b50 //header signature 'sw.writeUInt16 0 //data size 'no data dim cdLength as uint32 = sw.getLength - centralDirectoryStart dim cdItems as uint32 = files + emptyDirectories //end of central directory record sw.writeUInt32 &h06054b50 // signature sw.writeUInt16 0 // disk number sw.writeUInt16 0 // number of disk with start of central directory sw.writeUInt16 cdItems // total number of file entries on this disk sw.writeUInt16 cdItems // total number of file entries in the central directory sw.writeUInt32 cdLength // central directory size sw.writeUInt32 centralDirectoryStart // central directory offset sw.writeUInt16 0 //comment length 'no comment //truncate file to this length sw.truncate End Sub

Protected Sub z_writeFileRecord(item as ZipItem = nil, data as FileStream, progress as ZipProgress) #pragma NilObjectChecking false #pragma BoundsChecking false //get compression options dim compressionOptions as CompressionOptions = item.compressionOptions #if not useMBS compressionOptions.method = CompressionMethod.none #endif if item.isDirectory then //only write files or empty directories if ubound(item.getChildren) > -1 then return //don't compress directories compressionOptions.method = CompressionMethod.none end if item.uncompressedSize = 0 then //don't compress empty files compressionOptions.method = CompressionMethod.none end //size of buffer used for copying data const bufferSize = 1048576 //1 megabyte //file type dim f as new FileType f.Name = "zip" f.Extensions = ".zip" //get output file stream dim sw as new FileStream(archiveFile,f,true) //skip to end of existing file records sw.skip centralDirectoryStart //set relative offset of file record item.relativeOffset = sw.getPosition sw.writeUInt32 &h04034b50 //local file header signature //required version sw.writeUInt16 2*10 + 0 //general purpose bit flags dim flags as UInt16 'flags = flags + &b0000000000000001 //file is encrypted flags = flags + z_getCompressionBits(compressionOptions) //compression bits if compressionOptions.method = CompressionMethod.deflate then flags = flags + &b0000000000001000 //crc32 field blank end 'flags = flags + &b0000000000010000 //reserved for method 8 'flags = flags + &b0000000000100000 //patch data 'flags = flags + &b0000000001000000 //strong encryption sw.writeUInt16 flags //compression method z_writeCompressionMethod sw,compressionOptions.method //time and date z_writeTimeStamp sw,item.modified //get crc for uncompressed data if data <> nil then if compressionOptions.method <> CompressionMethod.deflate then dim total as uint64 = item.uncompressedSize while total > 0 dim chunk as UInt16 = min(total,compressionOptions.deflateWindow) item.crc = z_getCRC(item.crc,data.readString(chunk)) total = total - chunk #if not useMBS if progress <> nil then progress.increment chunk*0.75 #endif wend data.setPosition 0 item.compressedSize = item.uncompressedSize end else item.crc = 0 item.compressedSize = 0 end if Bitwise.BitAnd(flags,&b0000000000001000) > 0 then //crc 32 sw.writeUInt32 0 //compressed size sw.writeUInt32 0 //uncompressed size sw.writeUInt32 0 else //crc 32 sw.writeUInt32 item.crc //compressed size sw.writeUInt32 item.getCompressedSize //uncompressed size sw.writeUInt32 item.getUncompressedSize end //file name length sw.writeUInt16 item.getPath.LenB //extra field length sw.writeUInt16 item.extraData.LenB //file name sw.writeString item.getPath //extra data sw.writeString item.extraData //output 'dim output as string if data <> nil then if useMBS and compressionOptions.method = CompressionMethod.deflate then //deflate (requires mbs) #if useMBS dim total as uint64 = item.uncompressedSize dim z as new ZLibCompressMBS dim stripHeader as boolean = true z.InitZip z_getMBSCompressionLevel(compressionOptions.deflateLevel) do if z.InputAvail = 0 then //add data to compression buffer dim chunk as UInt16 = min(total,compressionOptions.deflateWindow) dim block as string = data.readString(chunk) if not z.setInput(block) then beep end total = total - chunk if progress <> nil then progress.increment chunk end z.ProcessZip //process data if stripHeader then //remove 2 byte zlib header if z.OutputSize >= 2 then item.compressedSize = item.compressedSize + z.OutputSize - 2 sw.writeString z.GetOutput.midb(3) //write all except first 2 bytes stripHeader = false end else //write data chunk item.compressedSize = item.compressedSize + z.OutputSize sw.writeString z.GetOutput end loop until z.InputAvail = 0 and total = 0 z.EndZip item.compressedSize = item.compressedSize + z.OutputSize sw.writeString z.GetOutput sw.Rewind 4 //skip the last 4 bytes item.compressedSize = item.compressedSize - 4 sw.writeString "PK" + chrb(7) + chrb(8) //bomarchiver puts pkzip footer here, but seems to be optional #endif else //no compression dim total as uint64 = item.uncompressedSize while total > 0 dim chunk as UInt16 = min(total,compressionOptions.deflateWindow) sw.writeString data.readString(chunk) total = total - chunk #if useMBS if progress <> nil then progress.increment chunk #else if progress <> nil then progress.increment chunk*0.25 #endif wend end end if Bitwise.BitAnd(flags,&b0000000000001000) > 0 then //crc 32 sw.writeUInt32 item.crc //compressed size sw.writeUInt32 item.getCompressedSize //uncompressed size sw.writeUInt32 item.getUncompressedSize end //truncate file to this length centralDirectoryStart = sw.getPosition sw.truncate End Sub

Private Sub z_writeTimeStamp(sw as StreamWriter, date as Date) //if date not known, set to current time if date = nil then date = new date //time sw.writeUInt16 date.Hour * 2048 + date.Minute * 32 + date.Second \ 2 //date sw.writeUInt16 (max(date.Year,1980) - 1980) * 512 + date.Month * 32 + date.Day End Sub

Property Private archiveFile As folderitem

Property Private centralDirectoryStart As uint64

Property Private Shared crc32Table(255) As int32

Property Private directories As uint32

Property Private emptyDirectories As uint32

Property Private files As uint32

End Class

Class ZipProgress

Sub constructor(total as uint64, monitor as ProgressMonitor) me.total = total me.monitor = monitor End Sub

Sub increment(amount as uint64) complete = complete + amount monitor.update complete / total End Sub

Property Private complete As uint64

Property Private monitor As ProgressMonitor

Property total As uint64

End Class

Interface ProgressMonitor

Sub update(complete as double)

End Interface