FileTypes

Filetype text

End FileTypes

Class Window1 Inherits Window

End Class

MenuBar MenuBar1

MenuItem UntitledMenu1 = ""

MenuItem FileMenu = "&File"

MenuItem FileQuit = "Quit"

MenuItem UntitledMenu5 = ""

MenuItem EditMenu = "&Edit"

MenuItem EditUndo = "&Undo"

MenuItem UntitledMenu0 = "-"

MenuItem EditCut = "Cu&t"

MenuItem EditCopy = "&Copy"

MenuItem EditPaste = "&Paste"

MenuItem EditClear = "Clear"

MenuItem UntitledMenu4 = ""

MenuItem UntitledMenu3 = ""

MenuItem UntitledMenu2 = ""

End MenuBar

Class App Inherits Application

Sub CreateFiles() dim f as FolderItem dim t as TextOutputStream dim i as integer dim folder as FolderItem f=SpecialFolder.Desktop.Child("Test Inputfile.txt") t=f.CreateTextFile t.WriteLine Window1.StaticText1.text t.Close folder=SpecialFolder.Desktop.Child("Testinputfolder") folder.CreateAsFolder for i=1 to 10 f=folder.Child("test "+str(i)) t=f.CreateTextFile t.WriteLine Window1.StaticText1.text t.Close next End Sub

Sub TestArchive() dim b as LargeBinaryStreamMBS dim f as FolderItem dim bs as MBSStream // Creates an archive with one file. // needs "Vancouver_Night_Panorama.tif" file on desktop // creates "test.pack" on desktop // Create f=SpecialFolder.Desktop.Child("test.pack") b=f.CreateLargeBinaryStreamMBS("TEXT","????") bs=new MBSLargeBinaryStream(b) bs.ArchiveFile SpecialFolder.Desktop.Child("Test Inputfile.txt") End Sub

Sub TestArchiveFolder() dim b as LargeBinaryStreamMBS dim f as FolderItem dim OutBinary, OutZip, OutAES, OutXOR as MBSStream // Creates an archive with files. // needs "picts" folder on desktop // creates "testfolder.pack" on desktop // Create f=SpecialFolder.Desktop.Child("testfolder.pack") b=f.CreateLargeBinaryStreamMBS("TEXT","????") OutBinary=new MBSLargeBinaryStream(b) // xor before writing to file OutXOR=new MBSXORStream(OutBinary,"Hello World") // xor, so nobody sees header data // and AES before OutAES=new MBSAESstream(OutXOR,"1234567890123456") // and Zip it before! OutZip=new MBSBufferedZipStream(OutAES) OutZip.ArchiveFolder SpecialFolder.Desktop.Child("Testinputfolder") End Sub

Sub TestRead() dim b as BinaryStream dim f as FolderItem dim OutBinary, InBinary, InXOR, InAES, InZip as MBSStream f=SpecialFolder.Desktop.Child("Test Processfile.txt") b=f.OpenAsBinaryFile(False) if b=nil then Return end if InBinary=new MBSBinaryStream(b) // xor it InXOR=new MBSXORStream(InBinary,"Hello World") // xor, so nobody sees header data // decrypt it InAES=new MBSAESstream(InXOR,"1234567890123456") // Unzip it InZip=new MBSZipStream(InAES) // find dest file f=SpecialFolder.Desktop.Child("Test Outputfile.txt") b=f.CreateBinaryFile("text") // Write it to a binary stream OutBinary=new MBSBinaryStream(b) InZip.CopyStreamTo OutBinary,10000 End Sub

Sub TestUnarchive() dim b as LargeBinaryStreamMBS dim f as FolderItem Dim bs As MBSStream // Opens an archive with one file. // needs "test.pack" on desktop // creates "output" folder on desktop // Create f=SpecialFolder.Desktop.Child("test.pack") b=f.OpenAsLargeBinaryStreamMBS(false) f=SpecialFolder.Desktop.Child("output") f.CreateAsFolder bs=new MBSLargeBinaryStream(b) bs.UnarchiveFile f End Sub

Sub TestUnarchiveFolder() dim b as LargeBinaryStreamMBS dim f as FolderItem dim InZip, InBinary, InXOR, InAES as MBSStream // Opens an archive with files. // needs "testfolder.pack" file on desktop // creates "outputfolder" folder on desktop // Create f=SpecialFolder.Desktop.Child("testfolder.pack") b=f.OpenAsLargeBinaryStreamMBS(false) f=SpecialFolder.Desktop.Child("Testoutputfolder") f.CreateAsFolder InBinary=new MBSLargeBinaryStream(b) // xor it InXOR=new MBSXORStream(InBinary,"Hello World") // xor, so nobody sees header data // decrypt it InAES=new MBSAESstream(InXOR,"1234567890123456") // Unzip it InZip=new MBSZipStream(InAES) InZip.UnarchiveFolder f End Sub

Sub TestWrite() dim b as BinaryStream dim f as FolderItem dim InBinary, OutBinary, OutXOR, OutAES, OutZip as MBSStream f=SpecialFolder.Desktop.Child("Test Inputfile.txt") b=f.OpenAsBinaryFile(False) if b=nil then Return end if // Read from BinaryStream InBinary=new MBSBinaryStream(b) f=SpecialFolder.Desktop.Child("Test Processfile.txt") b=f.CreateBinaryFile("text") // send data to binary stream OutBinary=new MBSBinaryStream(b) // xor before OutXOR=new MBSXORStream(OutBinary,"Hello World") // xor, so nobody sees header data // and AES before OutAES=new MBSAESstream(OutXOR,"1234567890123456") // and Zip it before! OutZip=new MBSBufferedZipStream(OutAES) InBinary.CopyStreamTo OutZip,100000 End Sub

End Class

Class MBSBinaryStream

Sub Constructor(dest as BinaryStream) theDestination=Dest End Sub

Function Read(n as integer) As string Return theDestination.Read(n) End Function

Sub Write(data as string) theDestination.Write data End Sub

Property Private theDestination As binaryStream

End Class

Interface MBSStream

Function Read(n as integer) As string

Sub Write(data as string)

End Interface

Class MBSZipStream

Sub Constructor(d as MBSStream, Level as integer=9) theDestination=d theLevel=Level End Sub

Function Read(n as integer) As string dim s as string dim m as MemoryBlock dim OrigLen, BlockLen as integer do if n=lenb(ReadBuf) then s=ReadBuf ReadBuf="" Return s elseif n<lenb(ReadBuf) then s=leftb(ReadBuf,n) ReadBuf=mid(ReadBuf,n+1) Return s end if s=theDestination.Read(8) if s="" then s=readbuf // no more data, return what we have readbuf="" Return s end if m=s m.LittleEndian=false OrigLen=m.Long(0) BlockLen=m.Long(4) s=theDestination.Read(BlockLen) if s="" then s=readbuf // no more data, return what we have readbuf="" Return s end if ReadBuf=ReadBuf+DecompressZLibMBS(s,OrigLen) loop Exception End Function

Sub Write(data as string) dim s as string dim m as MemoryBlock if data<>"" then s=CompressZLibMBS(data,theLevel) // needs Compression Plugin m=NewMemoryBlock(8) m.LittleEndian=false m.long(0)=lenb(data) m.long(4)=lenb(s) theDestination.Write m theDestination.Write s end if End Sub

Property Private ReadBuf As string

Property Private theDestination As MBSStream

Property theLevel As integer

End Class

Class MBSXORStream

Sub Constructor(dest as MBSStream, xcode as string) d=Dest code=xcode End Sub

Function Read(n as integer) As string dim s as string s=d.Read(n) return StringXORMBS(s,code) End Function

Sub Write(data as string) dim s as string s=StringXORMBS(data,code) d.Write s End Sub

Property code As string

Property d As MBSStream

End Class

Class MBSAESstream

Sub Constructor(dest as MBSStream, key as string) dim m as MemoryBlock d=Dest aes=new AESMBS m=key if not aes.SetKey(m,128) then Raise new RuntimeException end if End Sub

Function Read(n as integer) As string dim s as string dim i,c as integer dim m as MemoryBlock dim ms as MemoryBlock dim offset as integer dim OrigLen as integer dim BlockLen as integer do if n=lenb(ReadBuf) then s=ReadBuf ReadBuf="" Return s elseif n<lenb(ReadBuf) then s=leftb(ReadBuf,n) ReadBuf=mid(ReadBuf,n+1) Return s end if s=d.Read(8) if s="" then s=readbuf // no more data, return what we have readbuf="" Return s end if m=s m.LittleEndian=false OrigLen=m.Long(0) BlockLen=m.Long(4) s=d.Read(BlockLen) if s="" then Return "" end if c=BlockLen\16 offset=0 ms=s for i=1 to c m=ms.StringValue(offset,16) aes.Decrypt m ms.StringValue(offset,16)=m.StringValue(0,16) offset=offset+16 next ReadBuf=ReadBuf+ms.StringValue(0,OrigLen) loop Exception End Function

Sub Write(data as string) dim s as string dim i,c as integer dim m as MemoryBlock dim ms as MemoryBlock dim offset as integer s=data+" " // to pad to a 16 byte len c=lenb(s)\16 offset=0 ms=s for i=1 to c m=ms.StringValue(offset,16) aes.Encrypt m ms.StringValue(offset,16)=m.StringValue(0,16) offset=offset+16 next m=NewMemoryBlock(8) m.LittleEndian=false m.long(0)=lenb(data) m.long(4)=c*16 d.Write m d.Write ms.StringValue(0,c*16) End Sub

Property Private ReadBuf As string

Property aes As AESMBS

Property d As MBSStream

End Class

Class MBSDummyStream

Sub DummyStream(dest as MBSStream) theDestination=Dest End Sub

Function Read(n as integer) As string return theDestination.read(n) End Function

Sub Write(data as string) theDestination.write data End Sub

Property Private theDestination As MBSStream

End Class

Module GlobalStreamFunctions

Sub ArchiveFile(extends destStream as MBSStream, file as folderitem) dim b as MBSBufferStream Dim rs As ResStreamMBS dim ls as LargeBinaryStreamMBS dim mrs as MBSResStream dim mls as MBSLargeBinaryStream dim l as integer dim DatLen,ResLen as Double // Buffer output b=new MBSBufferStream(destStream, 100000) // Write Name b.Write "NAME" b.WriteString file.Name DatLen=file.LogicalFileDataLengthMBS ResLen=file.LogicalFileResLengthMBS // Write Resourcefork size b.Write "RSIZ" b.WriteDouble ResLen // Write Datafork size b.Write "DSIZ" b.WriteDouble DatLen // Write Resourcefork b.Write "RDAT" if ResLen>0 then rs=file.OpenAsResStreamMBS(False) if rs<>nil then mrs=new MBSResStream(rs) mrs.CopyStreamTo b,100000 mrs=nil // close it end if end if // Write Datafork b.Write "DATA" if DatLen>0 then ls=file.OpenAsLargeBinaryStreamMBS(false) if ls<>nil then mls=new MBSLargeBinaryStream(ls) mls.CopyStreamTo b,100000 mls=nil // close it end if end if // Write Comment b.Write "COMM" b.WriteString file.CommentMBS // Write modification date b.Write "MDAT" b.WriteDouble file.ModificationDate.TotalSeconds // Write modification date b.Write "CDAT" b.WriteDouble file.CreationDate.TotalSeconds // Write Finder flags b.Write "FLAG" l=file.GetFileFlagsMBS if l<0 then // error l=0 end if b.WriteInteger l // Write MacType #If RBVersion < 2019 b.Write "MTYP" b.WriteString file.MacType // Write MacCreator b.Write "MCRE" b.WriteString file.MacCreator #EndIf // Write access rights b.Write "PERM" b.WriteInteger GetFilePermission(file) End Sub

Sub ArchiveFolder(extends destStream as MBSStream, folder as folderitem) dim b as MBSBufferStream Dim l As Integer dim i,c as integer dim f as FolderItem c=folder.Count // Buffer output b=new MBSBufferStream(destStream, 100000) // Write Name b.Write "NAME" b.WriteString folder.Name // Write Datafork size b.Write "COUN" b.WriteInteger c // Write Comment b.Write "COMM" b.WriteString folder.CommentMBS // Write modification date b.Write "MDAT" b.WriteDouble folder.ModificationDate.TotalSeconds // Write modification date b.Write "CDAT" b.WriteDouble folder.CreationDate.TotalSeconds // Write Finder flags b.Write "FLAG" l=folder.GetFolderFlagsMBS if l<0 then // error l=0 end if b.WriteInteger l // Write MacType #If RBVersion < 2019 b.Write "MTYP" b.WriteString folder.MacType // Write MacCreator b.Write "MCRE" b.WriteString folder.MacCreator #EndIf for i=1 to c f=folder.TrueItem(i) if f<>nil then if f.Directory then b.Write "FOLD" b.ArchiveFolder f else b.Write "FILE" b.ArchiveFile f end if end if next b.Write "FEND" // Write access rights b.Write "PERM" b.WriteInteger GetFilePermission(folder) End Sub

Sub CopyBytesTo(extends source As MBSStream, dest as MBSStream, bufsize as integer, bytes as integer) dim s as string dim c as integer // bytes left dim n as integer // Bytes to copy now c=bytes n=c if n>bufsize then n=bufsize end if s=source.read(n) while s<>"" dest.Write s c=c-lenb(s) n=c if n>bufsize then n=bufsize end if s=source.read(n) wend End Sub

Sub CopyStreamTo(extends source As MBSStream, dest as MBSStream, bufsize as integer) dim s as string s=source.read(bufsize) while s<>"" dest.Write s s=source.read(bufsize) wend End Sub

Private Function FindRandomName(dest as folderitem, name as string) As folderitem dim s as string dim f as FolderItem dim i as integer i=1 s=left(name,20)+"."+str(i) f=Dest.TrueChild(s) while f.exists i=i+1 s=left(name,20)+"."+str(i) f=Dest.TrueChild(s) wend Return f End Function

Private Function GetFilePermission(file as folderitem) As integer dim d as DarwinChmodMBS d=new DarwinChmodMBS if d.stat(file.UnixpathMBS)=0 then Return d.mode else Return -1 // for error end if End Function

Function ReadDouble(extends b as mbsStream) As double dim m as MemoryBlock m=b.Read(8) m.LittleEndian=false Return m.DoubleValue(0) End Function

Function ReadInteger(extends b as MBSStream) As integer dim m as MemoryBlock m=b.Read(4) m.LittleEndian=false Return m.Long(0) End Function

Function ReadString(extends s as MBSStream) As string dim m as MemoryBlock dim e,l as integer dim t as string m=s.Read(8) m.LittleEndian=false l=m.Long(0) e=m.Long(4) t=s.Read(l) SetEncodingOfStringMBS t,e Return t End Function

Private Sub SetFilePermission(file as folderitem, p as integer) dim d as DarwinChmodMBS if p>=0 then // no error on GetFilePermission d=new DarwinChmodMBS if d.chmod(file.UnixpathMBS, p)=0 then if d.stat(file.UnixpathMBS)=0 then if p=d.mode then 'ok else MsgBox "Failed to set permissions for "+file.UnixpathMBS+" to "+oct(p) end if end if end if end if End Sub

Sub UnarchiveFile(extends st as MBSStream, folder as folderitem) dim tag as string dim Comment,Name as string dim rsize, dsize as Double dim file as FolderItem dim rs as ResStreamMBS dim ls as LargeBinaryStreamMBS dim mrs as MBSResStream dim mls as MBSLargeBinaryStream dim e as integer dim d as date tag=st.Read(4) // NAME name=st.ReadString tag=st.Read(4) // RSIZ RSIZE=st.ReadDouble tag=st.Read(4) // DSIZ DSIZE=st.ReadDouble file=FindRandomName(folder,name) tag=st.Read(4) // RDAT if rsize>0 then rs=file.CreateResStreamMBS("????","????") if rs<>nil then mrs=new MBSResStream(rs) st.CopyBytesTo mrs,100000,rsize mrs=nil rs=nil else MsgBox "Failed to create ResStream on "+file.name Return end if end if tag=st.Read(4) // DATA if dsize>0 then if file.Exists then ls=file.OpenAsLargeBinaryStreamMBS(true) else ls=file.CreateLargeBinaryStreamMBS("????","????") end if if ls<>nil then mls=new MBSLargeBinaryStream(ls) st.CopyBytesTo mls,100000,dsize mls=nil ls=nil else MsgBox "Failed to create LargeBinaryStream on "+file.name Return end if end if tag=st.Read(4) // COMM Comment=st.ReadString file.CommentMBS=Comment tag=st.Read(4) // MDAT d=new date d.totalseconds=st.ReadDouble file.ModificationDate=d tag=st.Read(4) // CDAT d=new date d.totalseconds=st.ReadDouble #if not TargetLinux then file.CreationDate=d #endif tag=st.Read(4) // MTYP If tag = "MTYP" Then #If RBVersion < 2019 file.MacType=st.ReadString #EndIf tag=st.Read(4) // MCRE End If If tag = "MCRE" then #If RBVersion < 2019 file.MacCreator=st.ReadString #endif tag=st.Read(4) // PERM End If SetFilePermission file,st.ReadInteger file.Name=name // rename later so Finder will recognize the file changes tag=st.Read(4) // FLAG e=file.SetFileFlagsMBS(st.ReadInteger) End Sub

Sub UnarchiveFolder(extends st as MBSStream, destfolder as folderitem) dim tag as string dim Comment,Name as string dim folder as FolderItem dim e,count as integer dim d as date tag=st.Read(4) // NAME name=st.ReadString tag=st.Read(4) // COUN Count=st.ReadInteger folder=FindRandomName(destfolder,name) folder.CreateAsFolder tag=st.Read(4) // COMM Comment=st.ReadString folder.CommentMBS=Comment tag=st.Read(4) // MDAT d=new date d.totalseconds=st.ReadDouble folder.ModificationDate=d tag=st.Read(4) // CDAT d=new date d.totalseconds=st.ReadDouble #if not TargetLinux then folder.CreationDate=d #endif tag=st.Read(4) // FLAG e=folder.SetFolderFlagsMBS(st.ReadInteger) tag=st.Read(4) // MTYP If tag = "MTYP" Then #If RBVersion < 2019 Then folder.MacType=st.ReadString #EndIf tag=st.Read(4) // MCRE End If If tag = "MCRE" Then #if RBVersion < 2020 then folder.MacCreator=st.ReadString #EndIf tag=st.Read(4) // MCRE End If while tag<>"FEND" if tag="FILE" then st.UnarchiveFile folder elseif tag="FOLD" then st.UnarchiveFolder folder end if tag=st.Read(4) wend // on End, tag is FEND folder.Name=name tag=st.Read(4) // PERM SetFilePermission folder,st.ReadInteger End Sub

Sub WriteDouble(extends b as mbsstream, value as double) dim m as MemoryBlock m=NewMemoryBlock(8) m.LittleEndian=false m.DoubleValue(0)=value b.Write m End Sub

Sub WriteInteger(extends b as MBSStream, value as integer) dim m as MemoryBlock m=NewMemoryBlock(4) m.LittleEndian=false m.Long(0)=value b.Write m End Sub

Sub WriteString(extends s as MBSStream, data as string) dim m as MemoryBlock dim l as integer l=lenb(data) m=NewMemoryBlock(l+8) m.LittleEndian=false m.Long(0)=l m.Long(4)=GetEncodingOfStringMBS(data) m.StringValue(8,l)=data s.Write m End Sub

End Module

Class MBSBufferStream

Sub Constructor(dest as MBSStream, BufferSize as integer) theDestination=dest theBufferSize=BufferSize theBuffer=NewMemoryBlock(BufferSize) End Sub

Sub Destructor() if thePosition>0 then // write buffer to output theDestination.Write theBuffer.StringValue(0,thePosition) thePosition=0 theBuffer=nil end if End Sub

Function Read(count as integer) As string Return theDestination.Read(count) // do nothing like dummy End Function

Sub Write(buffer as string) dim l,c,w as integer dim p as integer l=lenb(buffer) // bytes to write if l>theBufferSize and thePosition=0 then // if nothing in buffer and big block, just send through theDestination.Write buffer else p=0 // position in source buffer while l>0 c=theBufferSize-thePosition // c=free space w=l // bytes to write if w>c then // limit to free space w=c end if theBuffer.StringValue(thePosition,w)=midb(buffer,p+1,w) p=p+w l=l-w thePosition=thePosition+w if thePosition=theBufferSize then // flush buffer theDestination.Write theBuffer.StringValue(0,thePosition) thePosition=0 end if wend end if End Sub

Property Private theBuffer As memoryBlock

Property Private theBufferSize As integer

Property Private theDestination As MBSStream

Property Private thePosition As integer

End Class

Class MBSBufferedZipStream

Sub Constructor(dest as MBSStream, Level as integer=9, BufferSize as integer=100000) // first collect stuff in a buffer stream, than zip it and collect results ob=new MBSBufferStream(dest,BufferSize) z=new MBSZipStream(ob,Level) ib=new MBSBufferStream(z,BufferSize) End Sub

Function Read(n as integer) As string Return ib.Read(n) End Function

Sub Write(data as string) ib.Write data End Sub

Property ib As MBSBufferStream

Property ob As MBSBufferStream

Property theDestination As MBSStream

Property z As MBSZipStream

End Class

Class MBSLargeBinaryStream

Sub Constructor(dest as LargeBinaryStreamMBS) theDestination=dest End Sub

Function Read(n as integer) As string Return theDestination.Read(n) Exception End Function

Sub Write(data as string) theDestination.Write data Exception End Sub

Property theDestination As LargeBinaryStreamMBS

End Class

Class MBSResStream

Sub Constructor(dest as ResstreamMBS) theDestination=Dest End Sub

Function Read(n as integer) As string if theDestination<>nil then Return theDestination.Read(n) end if Exception End Function

Sub Write(data as string) if theDestination<>nil then theDestination.Write data end if Exception End Sub

Property theDestination As ResstreamMBS

End Class