Imports System
Imports System.Collections.Generic
Imports System.Globalization
Imports System.IO
Imports System.Linq
Imports System.Text
Imports ICSharpCode.SharpZipLib.Zip.Compression.Streams
Namespace WpfApplication1
Public Class B4XSerializator
Private Const T_NULL As Byte = 0, T_STRING As Byte = 1, T_SHORT As Byte = 2, T_INT As Byte = 3, T_LONG As Byte = 4, T_FLOAT As Byte = 5, T_DOUBLE As Byte = 6, T_BOOLEAN As Byte = 7, T_BYTE As Byte = 10, T_CHAR As Byte = 14, T_MAP As Byte = 20, T_LIST As Byte = 21, T_NSARRAY As Byte = 22, T_NSDATA As Byte = 23, T_TYPE As Byte = 24
Private br As BinaryReader
Private bw As BinaryWriter
Private ReadOnly utf8 As UTF8Encoding
Public Sub New()
utf8 = New UTF8Encoding(False)
End Sub
Public Function ConvertBytesToObject(ByVal Bytes As Byte()) As Object
Using inf As InflaterInputStream = New InflaterInputStream(New MemoryStream(Bytes))
br = New BinaryReader(inf)
Dim ret As Object = readObject()
Return ret
End Using
End Function
Public Function ConvertObjectToBytes(ByVal Object As Object) As Byte()
Dim ms As MemoryStream = New MemoryStream()
Using def As DeflaterOutputStream = New DeflaterOutputStream(ms)
bw = New BinaryWriter(def)
writeObject(Object)
End Using
Return ms.ToArray()
End Function
Private Sub writeObject(ByVal o As Object)
If o Is Nothing Then
writeByte(T_NULL)
ElseIf TypeOf o Is Integer Then
writeByte(T_INT)
writeInt(CInt(o))
ElseIf TypeOf o Is Double Then
writeByte(T_DOUBLE)
bw.Write(CDbl(o))
ElseIf TypeOf o Is Single Then
writeByte(T_FLOAT)
bw.Write(CSng(o))
ElseIf TypeOf o Is Long Then
writeByte(T_LONG)
bw.Write(CLng(o))
ElseIf TypeOf o Is Byte Then
writeByte(T_BYTE)
bw.Write(CByte(o))
ElseIf TypeOf o Is Short Then
writeByte(T_SHORT)
bw.Write(CShort(o))
ElseIf TypeOf o Is Char Then
writeByte(T_CHAR)
bw.Write(CShort(CChar(o)))
ElseIf TypeOf o Is Boolean Then
writeByte(T_BOOLEAN)
writeByte(CByte((If(CBool(o), 1, 0))))
ElseIf TypeOf o Is String Then
Dim temp As Byte() = utf8.GetBytes(CStr(o))
writeByte(T_STRING)
writeInt(temp.Length)
bw.Write(temp, 0, temp.Length)
ElseIf TypeOf o Is List(Of Object) Then
writeByte(T_LIST)
writeList(CType(o, List(Of Object)))
ElseIf TypeOf o Is Dictionary(Of Object, Object) Then
writeByte(T_MAP)
writeMap(CType(o, Dictionary(Of Object, Object)))
ElseIf o.[GetType]().IsArray Then
If TypeOf o Is Byte() Then
writeByte(T_NSDATA)
Dim b As Byte() = CType(o, Byte())
writeInt(b.Length)
bw.Write(b, 0, b.Length)
ElseIf TypeOf o Is Object() Then
writeByte(T_NSARRAY)
writeList(New List(Of Object)(CType(o, Object())))
Else
Throw New Exception("Only arrays of bytes or objects are supported.")
End If
ElseIf TypeOf o Is B4XType Then
writeByte(T_TYPE)
writeType(CType(o, B4XType))
Else
Throw New Exception("Type not supported: " & o.[GetType]())
End If
End Sub
Private Sub writeMap(ByVal m As Dictionary(Of Object, Object))
writeInt(m.Count)
For Each kvp As KeyValuePair(Of Object, Object) In m
writeObject(kvp.Key)
writeObject(kvp.Value)
Next
End Sub
Private Sub writeList(ByVal list As List(Of Object))
writeInt(list.Count)
For Each o As Object In list
writeObject(o)
Next
End Sub
Private Function readObject() As Object
Dim t As Byte = br.ReadByte()
Dim len As Integer
Dim b As Byte()
Select Case t
Case T_NULL
Return Nothing
Case T_INT
Return readInt()
Case T_SHORT
Return readShort()
Case T_LONG
Return br.ReadInt64()
Case T_FLOAT
Return br.ReadSingle()
Case T_DOUBLE
Return br.ReadDouble()
Case T_BOOLEAN
Return br.ReadByte() = 1
Case T_BYTE
Return br.ReadByte()
Case T_STRING
len = readInt()
b = br.ReadBytes(len)
Return utf8.GetString(b)
Case T_CHAR
Return CChar(readShort())
Case T_LIST
Return readList()
Case T_MAP
Return readMap()
Case T_NSDATA
len = readInt()
Return br.ReadBytes(len)
Case T_NSARRAY
Dim list As List(Of Object) = readList()
Return list.ToArray()
Case T_TYPE
Return readType()
Case Else
Throw New Exception("Unsupported type: " & t)
End Select
End Function
Private Sub writeByte(ByVal b As Byte)
bw.Write(b)
End Sub
Private Sub writeInt(ByVal i As Integer)
bw.Write(i)
End Sub
Private Function readList() As List(Of Object)
Dim len As Integer = readInt()
Dim arr As List(Of Object) = New List(Of Object)(len)
For i As Integer = 0 To len - 1
arr.Add(readObject())
Next
Return arr
End Function
Private Function readMap() As Dictionary(Of Object, Object)
Dim len As Integer = readInt()
Dim mm As Dictionary(Of Object, Object) = New Dictionary(Of Object, Object)()
For i As Integer = 0 To len - 1
mm(readObject()) = readObject()
Next
Return mm
End Function
Private Function readInt() As Integer
Return br.ReadInt32()
End Function
Private Function readShort() As Short
Return br.ReadInt16()
End Function
Private Function readType() As Object
Dim cls As String = CStr(readObject())
Dim data = readMap()
Return New B4XType(cls, data)
End Function
Private Sub writeType(ByVal t As B4XType)
writeObject("_" & t.ClassName)
writeMap(t.Fields)
End Sub
End Class
Public Class B4XType
Public ReadOnly ClassName As String
Public ReadOnly Fields As Dictionary(Of Object, Object)
Public Sub New(ByVal className As String, ByVal data As Dictionary(Of Object, Object))
Dim i As Integer = className.LastIndexOf("$")
If i > -1 Then
className = className.Substring(i + 2)
ElseIf className.StartsWith("_") Then
className = className.Substring(1)
Else
className = className.ToLower(New CultureInfo("en-US", False))
End If
Me.ClassName = className
Me.Fields = data
End Sub
End Class
End Namespace
'=======================================================
'Service provided by Telerik (www.telerik.com)
'Conversion powered by Refactoring Essentials.
'Twitter: @telerik
'Facebook: facebook.com/telerik
'=======================================================
, search for it, to know what is it 
