1	#Region "Microsoft.VisualBasic::047f3e6ce86c0dbb480007a88dd9406d, Microsoft.VisualBasic.Core\Serialization\DumpData\DumpData.vb"
2
3	' Author:
4	'
5	'       asuka (amethyst.asuka@gcmodeller.org)
6	'       xie (genetics@smrucc.org)
7	'       xieguigang (xie.guigang@live.com)
8	'
9	' Copyright (c) 2018 GPL3 Licensed
10	'
11	'
12	' GNU GENERAL PUBLIC LICENSE (GPL3)
13	'
14	'
15	' This program is free software: you can redistribute it and/or modify
16	' it under the terms of the GNU General Public License as published by
17	' the Free Software Foundation, either version 3 of the License, or
18	' (at your option) any later version.
19	'
20	' This program is distributed in the hope that it will be useful,
21	' but WITHOUT ANY WARRANTY; without even the implied warranty of
22	' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23	' GNU General Public License for more details.
24	'
25	' You should have received a copy of the GNU General Public License
26	' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30	' /********************************************************************************/
31
32	' Summaries:
33
34	'     Module MemoryDump
35	'
36	'         Function: __dumpInvoke, DumpArray, DumpFieldCollection, DumpPropertyCollection, DumpPropertyOrField
37	'                   GetArray, I_CreateDump, IsGenericEnumerable
38	'
39	'
40	' /********************************************************************************/
41
42	#End Region
43
44	Imports System.Text
45	Imports System.Runtime.CompilerServices
46
47	Namespace Serialization
48
49	Public Module MemoryDump
50
51	<Extension> Public Function I_CreateDump(Of T As Class)(obj As T, Optional DumpLevel As UInteger = 0) As String
52	Dim DumpBuilder As StringBuilder = New StringBuilder(1024)
53
54	Call Console.WriteLine("Create memory dump for {0}.", obj.GetType.FullName)
55
56	Call DumpBuilder.AppendLine("//                                                                ")
57	Call DumpBuilder.AppendLine(String.Format("//  Microsoft (R) VisualBasic.NET Memory Dump Creator.  Version {0}", Application.ProductVersion))
58	Call DumpBuilder.AppendLine("//  Copyright (c) Microsoft Corporation.  All rights reserved.")
59	Call DumpBuilder.AppendLine("//                                                                ")
60	Call DumpBuilder.AppendLine(String.Format("//  Dump Time {0}  ", Now.ToString))
61	Call DumpBuilder.AppendLine("//                                                                ")
62
63	Call DumpBuilder.AppendLine(__dumpInvoke(obj, DumpLevel))
64	Return DumpBuilder.ToString
65	End Function
66
67	''' <summary>
68	''' Create memory dump for a class object instance
69	''' </summary>
70	''' <param name="obj"></param>
71	''' <param name="DumpLevel"></param>
72	''' <returns></returns>
73	''' <remarks></remarks>
74	Private Function __dumpInvoke(obj As Object, DumpLevel As Integer) As String
75	Dim DumpBuilder As StringBuilder = New StringBuilder(1024)
76	Dim Type As System.Type = obj.GetType
77	Dim LevelBlanks As String = New String(vbTab, DumpLevel)
78	Dim PropertyCollection As System.Reflection.PropertyInfo() = (From [property] As System.Reflection.PropertyInfo
79	In Type.GetProperties(System.Reflection.BindingFlags.NonPublic Or System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.Public)
80	Let attrs As Object() = [property].GetCustomAttributes(attributeType:=DumpNode.GetTypeId, inherit:=True)
81	Where Not attrs.IsNullOrEmpty
82	Select [property]).ToArray
83	Dim FieldsCollection As System.Reflection.FieldInfo() = (From Field As System.Reflection.FieldInfo
84	In Type.GetFields(System.Reflection.BindingFlags.NonPublic Or System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.Public)
85	Let attrs As Object() = Field.GetCustomAttributes(attributeType:=DumpNode.GetTypeId, inherit:=True)
86	Where Not attrs.IsNullOrEmpty
87	Select Field).ToArray
88
89	If PropertyCollection.IsNullOrEmpty AndAlso FieldsCollection.IsNullOrEmpty Then
90	Return ""
91	End If
92
93	Call DumpBuilder.AppendLine()
94	Call DumpBuilder.AppendLine(String.Format("{0}/* =============== DUMP_CLASS_TYPE {1} =================== */" & vbCrLf, LevelBlanks, Type.FullName))
95	Call DumpBuilder.AppendLine(String.Format("{0}{1}", LevelBlanks, Type.FullName))
96	Call DumpBuilder.AppendLine(LevelBlanks & "{")
97
98	Call DumpBuilder.AppendLine(DumpFieldCollection(obj, FieldsCollection, DumpLevel))
99	Call DumpBuilder.AppendLine(DumpPropertyCollection(obj, PropertyCollection, DumpLevel))
100
101	Call DumpBuilder.AppendLine(String.Format("{0}! // end of dump {1}", LevelBlanks, Type.FullName).Replace("!", "}"))
102
103	Return DumpBuilder.ToString
104	End Function
105
106	Private Function DumpFieldCollection(obj As Object, FieldCollection As System.Reflection.FieldInfo(), DumpLevel As UInteger) As String
107	Dim DumpBuilder As StringBuilder = New StringBuilder(1024)
108	Dim LevelBlanks As String = New String(vbTab, DumpLevel + 1)
109
110	If Not FieldCollection.IsNullOrEmpty Then Call DumpBuilder.AppendLine(LevelBlanks & "// class type fields" & vbCrLf)
111
112	For Each Field As System.Reflection.FieldInfo In FieldCollection
113	Call DumpBuilder.AppendLine(DumpPropertyOrField(Field.GetValue(obj), Field.FieldType, Field.Name, DumpLevel, "field"))
114	Next
115
116	Return DumpBuilder.ToString
117	End Function
118
119	Private Function DumpPropertyCollection(obj As Object, PropertyCollection As System.Reflection.PropertyInfo(), DumpLevel As UInteger) As String
120	Dim DumpBuilder As StringBuilder = New StringBuilder(1024)
121	Dim LevelBlanks As String = New String(vbTab, DumpLevel + 1)
122
123	If Not PropertyCollection.IsNullOrEmpty Then Call DumpBuilder.AppendLine(LevelBlanks & "// class type properties" & vbCrLf)
124
125	For Each [property] As System.Reflection.PropertyInfo In PropertyCollection
126	Call DumpBuilder.AppendLine(DumpPropertyOrField([property].GetValue(obj, Nothing), [property].PropertyType, [property].Name, DumpLevel, "property"))
127	Next
128
129	Return DumpBuilder.ToString
130	End Function
131
132	Private Function DumpArray(ElementType As System.Type, ArrayTitle As String, ArrayData As Object(), DumpLevel As Integer) As String
133	Dim DumpBuilder As StringBuilder = New StringBuilder(1024) : DumpLevel += 1
134	Dim LevelBlanks As String = New String(vbTab, DumpLevel)
135	Dim ElementIsArrayType As Boolean = ElementType.IsArray
136
137	If ElementIsArrayType Then
138	For i As Integer = 0 To ArrayData.Length - 1
139	Dim ArrayItem As Object() = GetArray(DirectCast(ArrayData(i), IEnumerable))
140	Dim ItemTitle As String = String.Format("{0}{1}[{2},] -->" & vbCrLf, LevelBlanks, ArrayTitle, i)
141
142	Call DumpBuilder.AppendLine(ItemTitle)
143
144	If ArrayItem.IsNullOrEmpty Then
145	Call DumpBuilder.AppendLine(New String(vbTab, DumpLevel + 1) & "null inner array")
146	Else
147	ElementType = ArrayItem.First.GetType
148	Call DumpBuilder.AppendLine(DumpArray(ElementType, ItemTitle, ArrayItem, DumpLevel))
149	End If
150	Next
151	ElseIf ElementType.IsClass AndAlso ElementType IsNot GetType(String) Then
152	For i As Integer = 0 To ArrayData.Length - 1
153	Dim item = ArrayData(i)
154	Call DumpBuilder.AppendFormat("{0}[{1}] --> {2} ", LevelBlanks, i, ElementType.Name)
155	Call DumpBuilder.AppendLine("{")
156	Call DumpBuilder.AppendLine(vbCrLf & __dumpInvoke(item, DumpLevel + 1))
157	Call DumpBuilder.AppendLine(LevelBlanks & "}")
158	Next
159	Else
160	For i As Integer = 0 To ArrayData.Length - 1
161	Dim strData As String = ArrayData(i).ToString
162	Call DumpBuilder.AppendLine(String.Format("{0}[{1}] --> {2}", LevelBlanks, i, strData))
163	Next
164	End If
165
166	Return DumpBuilder.ToString
167	End Function
168
169	Private Function IsGenericEnumerable(Type As Type) As Boolean
170	Dim IsGenericType = Type.IsGenericType
171	Dim p = Array.IndexOf(Type.GetInterfaces, GetType(IEnumerable))
172	Dim f = IsGenericType AndAlso p > -1
173	Return f
174	End Function
175
176	Private Function GetArray(en As IEnumerable) As Object()
177	Dim LQuery As Object() = (From obj As Object In en Select obj).ToArray
178	Return LQuery
179	End Function
180
181	Private Function DumpPropertyOrField(value As Object, TypeInfo As Type, Name As String, DumpLevel As UInteger, def As String) As String
182	Dim LevelBlanks As String = New String(vbTab, DumpLevel + 1)
183	Dim DumpBuilder As StringBuilder = New StringBuilder(1024)
184
185	Dim IsArrayType As Boolean = TypeInfo.IsArray
186	Dim IsEnumerableType As Boolean = IsGenericEnumerable(TypeInfo)
187
188	If value Is Nothing Then
189	Return ""
190	End If
191
192	If TypeInfo.IsArray OrElse IsEnumerableType Then
193	Dim ArrayData As Object() = GetArray(DirectCast(value, IEnumerable))
194
195	If ArrayData.IsNullOrEmpty Then
196	Return ""
197	End If
198
199	Dim ElementType = ArrayData.First.GetType()
200
201	Call DumpBuilder.AppendLine(String.Format("{0}.{1} {2} ({3}) =>", LevelBlanks, def, Name, TypeInfo.FullName))
202	Call DumpBuilder.AppendLine(LevelBlanks & "{")
203	Call DumpBuilder.AppendLine(DumpArray(ElementType, Name, ArrayData, DumpLevel + 1))
204	Call DumpBuilder.AppendLine(LevelBlanks & "}" & String.Format(" // end of array {0} {1}", def, Name))
205	ElseIf TypeInfo.IsClass AndAlso Not TypeInfo Is GetType(String) Then
206	Call DumpBuilder.AppendLine(String.Format("{0}.{1} {2} {3} =>", LevelBlanks, def, Name, TypeInfo.FullName))
207	Call DumpBuilder.AppendLine(LevelBlanks & "{")
208	Call DumpBuilder.AppendLine(__dumpInvoke(value, DumpLevel + 2))
209	Call DumpBuilder.AppendLine(LevelBlanks & "} // end of " & Name)
210	Else
211	Return String.Format("{0}.{1} {2} ({3}) = {4}", LevelBlanks, def, Name, TypeInfo.FullName, value.ToString)
212	End If
213
214	Return DumpBuilder.ToString
215	End Function
216	End Module
217	End Namespace