1	#Region "Microsoft.VisualBasic::bd34f1a0370dc85c30639f68189dada4, Microsoft.VisualBasic.Core\Serialization\ShadowsCopy.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 ShadowsCopy
35	'
36	'         Function: __shadowsCopy, DeepCopy, (+2 Overloads) ShadowCopy, (+2 Overloads) ShadowsCopy
37	'
38	'     Class ShadowsCopyOpr
39	'
40	'         Constructor: (+1 Overloads) Sub New
41	'         Function: (+2 Overloads) ShadowCopy, ToString
42	'
43	'     Class ShadowsCopyOpr
44	'
45	'         Constructor: (+1 Overloads) Sub New
46	'         Function: ShadowCopy, ToString
47	'
48	'
49	' /********************************************************************************/
50
51	#End Region
52
53	Imports System.IO
54	Imports System.Reflection
55	Imports System.Runtime.CompilerServices
56	Imports System.Runtime.Serialization
57	Imports System.Runtime.Serialization.Formatters.Binary
58
59	#If NET_40 = 0 Then
60
61	Namespace Serialization
62
63	Public Module ShadowsCopy
64
65	''' <summary>
66	''' Perform a deep Copy of the object.
67	''' </summary>
68	''' <typeparam name="T">The type of object being copied.</typeparam>
69	''' <param name="source">The object instance to copy.</param>
70	''' <returns>The copied object.</returns>
71	<Extension> Public Function DeepCopy(Of T)(source As T) As T
72	If (Not GetType(T).IsSerializable) Then
73	Throw New ArgumentException("The type must be serializable.", NameOf(source))
74	End If
75
76	' Don't serialize a null object, simply return the default for that object
77	If (Object.ReferenceEquals(source, null)) Then
78	Return Nothing
79	End If
80
81	Using stream As New MemoryStream()
82	With New BinaryFormatter()
83	Call .Serialize(stream, source)
84	Call stream.Seek(0, SeekOrigin.Begin)
85	Return DirectCast(.Deserialize(stream), T)
86	End With
87	End Using
88	End Function
89
90	''' <summary>
91	''' 将目标对象之中的属性按值复制
92	''' </summary>
93	''' <typeparam name="T"></typeparam>
94	''' <param name="obj"></param>
95	''' <returns></returns>
96	''' <remarks>对外函数接口，为了防止无限递归的出现</remarks>
97	<Extension> Public Function ShadowsCopy(Of T As Class)(obj As T) As T
98	Dim CopiedToTarget As T = DirectCast(__shadowsCopy(GetType(T), obj), T)
99	Return CopiedToTarget
100	End Function
101
102	''' <summary>
103	''' 将目标对象之中的属性按值复制
104	''' </summary>
105	''' <param name="obj"></param>
106	''' <returns></returns>
107	''' <remarks>对外函数接口，为了防止无限递归的出现</remarks>
108	<Extension> Public Function ShadowsCopy(obj As Object) As Object
109	Dim CopiedToTarget As Object = __shadowsCopy(obj.GetType, obj)
110	Return CopiedToTarget
111	End Function
112
113	''' <summary>
114	''' 递归使用的，基本数据类型直接复制，引用类型则首先创建一个新的对象，在对该对象进行递归复制，假若目标对象没有可用的无参数的构造函数，则直接赋值
115	''' </summary>
116	''' <param name="obj"></param>
117	''' <returns></returns>
118	''' <remarks></remarks>
119	Private Function __shadowsCopy(typeinfo As Type, obj As Object) As Object
120	If ComponentModel.DataSourceModel.DataFramework.StringParsers.ContainsKey(typeinfo) Then
121	Return obj    '首先查看是否为基本类型，是的话则直接返回值，否在使用反射进行递归复制
122	End If
123
124	Dim OptParameter As System.Reflection.ParameterInfo = Nothing
125	Dim NonParamCtor = (From ctor As System.Reflection.ConstructorInfo
126	In typeinfo.GetConstructors
127	Where ctor.GetParameters.IsNullOrEmpty
128	Select ctor).FirstOrDefault
129
130	If NonParamCtor Is Nothing Then
131	NonParamCtor = (From ctor As System.Reflection.ConstructorInfo
132	In typeinfo.GetConstructors
133	Let p = ctor.GetParameters
134	Where p.Length = 1 AndAlso p.First.IsOptional
135	Select ctor).FirstOrDefault
136
137	If NonParamCtor Is Nothing Then
138	Return obj '目标类型没有无参数的构造函数，则直接返回目标对象
139	Else
140	OptParameter = NonParamCtor.GetParameters.First     '有一个可选的默认参数，则直接使用默认值进行构造
141	End If
142	End If
143
144	Dim Target As Object = If(OptParameter Is Nothing, Activator.CreateInstance(typeinfo), Activator.CreateInstance(typeinfo, OptParameter.DefaultValue))
145
146	For Each [Property] In (From p In typeinfo.GetProperties Where p.CanRead AndAlso p.CanWrite Select p).ToArray
147	Dim CopiedValue = __shadowsCopy([Property].PropertyType, [Property].GetValue(obj))
148	Call [Property].SetValue(Target, CopiedValue)
149	Next
150
151	Return Target
152	End Function
153
154	''' <summary>
155	''' 请使用这个函数来对CSV序列化的对象进行浅拷贝。将<paramref name="source"/>之中的第一层的属性值拷贝到<paramref name="target"/>对应的属性值之中，然后返回<paramref name="target"/>
156	''' </summary>
157	''' <typeparam name="T"></typeparam>
158	''' <param name="source"></param>
159	''' <param name="Target"></param>
160	''' <returns></returns>
161	Public Function ShadowCopy(Of T As Class)(source As T, ByRef Target As T) As T
162	Dim opr As New ShadowsCopyOpr(Of T)
163	Return opr.ShadowCopy(source, Target)
164	End Function
165
166	''' <summary>
167	''' 将第一层的属性值从基本类复制给继承类
168	''' </summary>
169	''' <typeparam name="Tbase"></typeparam>
170	''' <typeparam name="TInherits"></typeparam>
171	''' <param name="source"></param>
172	''' <returns></returns>
173	Public Function ShadowCopy(Of Tbase As Class, TInherits As Tbase)(source As Tbase) As TInherits
174	Dim opr As New ShadowsCopyOpr(Of Tbase, TInherits)
175	Dim value As TInherits = opr.ShadowCopy(source)
176	Return value
177	End Function
178	End Module
179
180	''' <summary>
181	''' 批量拷贝需要使用这个模块来执行
182	''' </summary>
183	''' <typeparam name="T"></typeparam>
184	Public Class ShadowsCopyOpr(Of T As Class)
185
186	ReadOnly prop As PropertyInfo()
187
188	Sub New()
189	Me.prop = (From [Property] As PropertyInfo
190	In GetType(T).GetProperties(System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Instance)
191	Where [Property].CanRead AndAlso [Property].CanWrite
192	Select [Property]).ToArray
193	End Sub
194
195	Public Function ShadowCopy(source As T) As T
196	Dim copyTo As T = Activator.CreateInstance(Of T)
197	Return ShadowCopy(source, copyTo)
198	End Function
199
200	Public Function ShadowCopy(source As T, copyTo As T) As T
201	For Each [property] As PropertyInfo In prop
202	Dim value As Object = [property].GetValue(source)
203	Call [property].SetValue(obj:=copyTo, value:=value)
204	Next
205
206	Return copyTo
207	End Function
208
209	Public Overrides Function ToString() As String
210	Return $"[{NameOf(ShadowsCopy)}] -->> {GetType(T).FullName}"
211	End Function
212	End Class
213
214	''' <summary>
215	''' 批量拷贝需要使用这个模块来执行
216	''' </summary>
217	''' <typeparam name="Tbase"></typeparam>
218	''' <typeparam name="TInherits"></typeparam>
219	Public Class ShadowsCopyOpr(Of Tbase As Class, TInherits As Tbase)
220
221	ReadOnly baseProp As PropertyInfo()
222	ReadOnly inheritsHash As Dictionary(Of String, PropertyInfo)
223
224	Sub New()
225	Dim baseProp = GetType(Tbase).GetProperties(BindingFlags.Public Or BindingFlags.Instance)
226	Dim inheritsProp = GetType(TInherits).GetProperties(BindingFlags.Public Or BindingFlags.Instance)
227	Dim inheritsHash = (From prop As PropertyInfo In inheritsProp Where prop.CanWrite Select prop).ToDictionary(Function(x) x.Name)
228
229	Me.baseProp = (From prop As PropertyInfo In baseProp Where prop.CanRead Select prop).ToArray
230	Me.inheritsHash = inheritsHash
231	End Sub
232
233	Public Function ShadowCopy(source As Tbase) As TInherits
234	Dim copyTo As TInherits = Activator.CreateInstance(GetType(TInherits))  ' 需要Object类型进行复制
235
236	For Each prop As PropertyInfo In baseProp
237	Dim value As Object = prop.GetValue(source)
238	Call prop.SetValue(obj:=copyTo, value:=value)
239	Next
240
241	Return DirectCast(copyTo, TInherits)
242	End Function
243
244	Public Overrides Function ToString() As String
245	Return $"{GetType(Tbase).FullName} -->> {GetType(TInherits).FullName}"
246	End Function
247	End Class
248	End Namespace
249	#End If