1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
| Module IO_Object
Const Separator As String = "="
Const iObjSeparator As String = "{" 'In object separator
Const oObjSeparator As String = "}" 'Out object separator
Const sElSeparator As String = ">" 'Start element separator
Const eElSeparator As String = "<" 'End element separator
'----------------------------------------------------------------------------------------------------
'CONVERTION D'UN OBJET EN STRING
'----------------------------------------------------------------------------------------------------
''' <summary>
''' Conversion d'une structure en chaîne de caractère.
''' </summary>
''' <param name="obj">Structure à convertir.</param>
''' <returns></returns>
''' <remarks>Utilisez la méthode StringToStruct de la même classe pour convertir votre chaîne en structure.</remarks>
Function ToString(obj As Object) As String
Dim TmpStr As String = ""
Dim AddStr As String
Dim SubObj As Object
For Each Field As System.Reflection.FieldInfo In obj.GetType().GetFields
TmpStr += Field.Name & Separator
Try
If GetType(IList).IsAssignableFrom(Field.FieldType) AndAlso Field.FieldType.IsGenericType Then 'Contrôle si l'objet est une liste
Dim item As IList = DirectCast(Field.GetValue(obj), IList)
TmpStr += iObjSeparator & vbCrLf
If Not IsNothing(item) Then
For Each o As Object In item
TmpStr += sElSeparator & vbCrLf
TmpStr += ToString(o)
TmpStr += eElSeparator & vbCrLf
Next
End If
TmpStr += oObjSeparator & vbCrLf
Else
AddStr = Field.GetValue(obj) & vbCrLf
TmpStr += AddStr
End If
Catch ex As Exception
'Imbrication d'objet
SubObj = Field.GetValue(obj)
TmpStr += iObjSeparator & vbCrLf
TmpStr += ToString(SubObj) & oObjSeparator & vbCrLf
End Try
Next
Return TmpStr
End Function
'----------------------------------------------------------------------------------------------------
'CONVERTION D'UNE STRING EN OBJET
'----------------------------------------------------------------------------------------------------
''' <summary>
''' Conversion d'une chaîne de caractère en objet.
''' </summary>
''' <param name="Expression">Chaîne de caractère à convertir</param>
''' <param name="Obj">Structure à retourner</param>
''' <remarks>La chaîne de caractère doit contenir autant de ligne que de champ. La valeur des champs est identifiée par "=".</remarks>
Function ToObject(ByVal Expression As String, ByRef Obj As Object) As Object
Dim TmpStr As String = ""
Dim Hash() As String, SubStr() As String, Str As String, GetExpression As String
Dim fields() As System.Reflection.FieldInfo = Obj.GetType().GetFields(System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.Public)
Dim NewObj As Integer, NewElement As Integer
Dim SubObj As Object, NameObj As String
Hash = Strings.Split(Expression, vbCrLf)
GetExpression = ""
SubObj = Nothing
NameObj = ""
For Each Str In Hash
SubStr = Strings.Split(Str, Separator)
If SubStr.Length < 1 Then
Continue For
End If
'---------------------------------------------------
'Evaluation d'imbrication d'objet
'---------------------------------------------------
Select Case SubStr.Last
Case iObjSeparator 'Imbrication d'objet
If NewElement > 0 Then Exit Select
NewObj += 1
If NewObj = 1 Then
GetExpression = ""
For Each Field As System.Reflection.FieldInfo In fields
If Field.Name = SubStr(0) Then
SubObj = Field.GetValue(Obj)
NameObj = Field.Name
Exit For
End If
Next
Continue For
End If
Case oObjSeparator 'Fin de l'objet imbriquer
NewObj -= 1
If NewObj = 0 Then
NewElement = 0
If Not IsNothing(SubObj) Then SubObj = ToObject(GetExpression, SubObj)
End If
Case sElSeparator 'Element d'une liste
NewElement += 1
If NewElement = 1 Then
GetExpression = ""
Continue For
End If
Case eElSeparator 'Fin de l'élément
SubObj.Add(Nothing)
If Not IsNothing(SubObj) Then SubObj.Item(NewElement - 1) = ToObject(GetExpression, SubObj.Item(NewElement - 1))
GetExpression = ""
Continue For
Case Else
If NewObj = 0 And NewElement = 0 Then
NameObj = SubStr(0)
If NameObj = "" Then Continue For
SubObj = SubStr.Last
End If
End Select
'---------------------------------------------------
'Récupération et affectation des champs de l'objet
'---------------------------------------------------
If NewObj > 0 Or NewElement > 0 Then
GetExpression += Str & vbCrLf
Else
For Each Field As System.Reflection.FieldInfo In fields
If Field.Name = NameObj Then
If Field.FieldType.BaseType.Name <> "Enum" Then
Try
Field.SetValue(Obj, Convert.ChangeType(SubObj, Field.FieldType))
Catch ex As Exception
MsgBox("Des données n'ont pas pu être restauré", MsgBoxStyle.OkOnly)
End Try
Else
Field.SetValue(Obj, CInt(SubStr(1)))
End If
Exit For
End If
Next
End If
Next
Return Obj
End Function
End Module |
System.Reflection SetValue dans un élément List(Of)
Répondre avec citation
Partager