Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Util/Streams
Function:
Required plugins for this example: MBS Compression Plugin, MBS Encryption Plugin, MBS MacCF Plugin, MBS MacClassic Plugin, MBS MacOSX Plugin, MBS Main Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Util/Streams
This example is the version from Sun, 20th Jun 2015.
Project "Streams.rbp"
FileTypes
Filetype text
End FileTypes
Class Window1 Inherits Window
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() app.CreateFiles End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() app.TestWrite End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action() app.TestRead End EventHandler
End Control
Control PushButton4 Inherits PushButton
ControlInstance PushButton4 Inherits PushButton
EventHandler Sub Action() app.TestArchive End EventHandler
End Control
Control PushButton5 Inherits PushButton
ControlInstance PushButton5 Inherits PushButton
EventHandler Sub Action() app.TestUnarchive End EventHandler
End Control
Control PushButton6 Inherits PushButton
ControlInstance PushButton6 Inherits PushButton
EventHandler Sub Action() app.TestArchiveFolder End EventHandler
End Control
Control PushButton7 Inherits PushButton
ControlInstance PushButton7 Inherits PushButton
EventHandler Sub Action() app.TestUnarchiveFolder End EventHandler
End Control
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
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 s as string 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 s as string 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 s as string 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 s as string 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 s as string 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 s as string dim InBinary, OutBinary, OutXOR, OutAES, OutZip, OutBuffer 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
Note "About"
Streams to and from a Realbasic Binary Stream
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
Note "About"
A stream which compresses all stuff going through Please do not use with small blocks as it'll be inefficient Better e.g. 100KB blocks Use MBSBufferStream for better results
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
Note "About"
XORs every byte in the stream written or read. Doesn't care for buffer size
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 s as string dim rs as ResStreamMBS dim ls as LargeBinaryStreamMBS dim mrs as MBSResStream dim mls as MBSLargeBinaryStream dim l as integer dim n as integer dim d as date 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 b.Write "MTYP" b.WriteString file.MacType // Write MacCreator b.Write "MCRE" b.WriteString file.MacCreator // 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 s as string dim l as integer dim n as integer dim d as date 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 b.Write "MTYP" b.WriteString folder.MacType // Write MacCreator b.Write "MCRE" b.WriteString folder.MacCreator 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.AbsolutePath 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.AbsolutePath 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 file.MacType=st.ReadString tag=st.Read(4) // MCRE file.MacCreator=st.ReadString tag=st.Read(4) // PERM 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 rsize, dsize as Double 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 folder.MacType=st.ReadString tag=st.Read(4) // MCRE folder.MacCreator=st.ReadString tag=st.Read(4) 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
Note "About"
Zip Compression stream with Buffering
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
Note "About"
For streams above 2 GB of content
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
End Project

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Util Plugin.





Links
MBS Xojo Plugins