1 #Region "Microsoft.VisualBasic::9004d0f648faadf51b3390b67a180512, 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 IntegerAs 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 UIntegerAs 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 ObjectPropertyCollection As System.Reflection.PropertyInfo(), DumpLevel As UIntegerAs 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 IntegerAs 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 StringAs 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