1 #Region "Microsoft.VisualBasic::17fb9b3d17c8919d3b11a0521564013d, Microsoft.VisualBasic.Core\Extensions\CodeDOM\References.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 ReferenceSolver
35     
36     '         Properties: ExecutingReferences, RunTimeDirectory
37     
38     '         Constructor: (+1 OverloadsSub New
39     
40     '         Function: getReferences, (+2 OverloadsGetReferences, IsSystemAssembly
41     
42     '         Sub: __getReferences
43     
44     
45     ' /********************************************************************************/
46
47 #End Region
48
49 Imports System.Reflection
50 Imports System.Runtime.CompilerServices
51 Imports Microsoft.VisualBasic.Language
52
53 Namespace Emit.CodeDOM_VBC
54
55     ''' <summary>
56     ''' Assembly references solver
57     ''' </summary>
58     Public Module ReferenceSolver
59
60         ''' <summary>
61         ''' 获取当前所执行的应用程序的所有引用dll模块的文件路径列表
62         ''' </summary>
63         ''' <returns></returns>
64         Public ReadOnly Property ExecutingReferences As String()
65
66         Sub New()
67             Dim assm As Assembly = Assembly.GetEntryAssembly
68             Dim main As MethodInfo = assm.EntryPoint
69
70             With main.DeclaringType
71                 ReferenceSolver.ExecutingReferences = .GetReferences
72             End With
73         End Sub
74
75         ''' <summary>
76         ''' 递归的获取该类型所处的模块的所有的依赖关系,返回来的是全路径
77         ''' </summary>
78         ''' <param name="Type"></param>
79         ''' <returns></returns>
80         ''' 
81         <Extension>
82         Public Function GetReferences(Type As Type) As String()
83             Dim assembly = Type.Assembly
84             Return GetReferences(assembly, False)
85         End Function
86
87         ''' <summary>
88         ''' 有一些会出现循环引用的情况?????
89         ''' </summary>
90         ''' <param name="assembly"></param>
91         ''' <param name="i"></param>
92         ''' <param name="refList"></param>
93         ''' <param name="fullNames">防止重复加载</param>
94         <Extension>
95         Private Sub __getReferences(assembly As Assembly, i As IntegerByRef refList As List(Of String), fullNames As List(Of String))
96             Dim myRefs As AssemblyName() = assembly _
97                 .GetReferencedAssemblies _
98                 .Where(Function(a) Not String.IsNullOrEmpty(a.FullName) AndAlso
99                     fullNames.IndexOf(a.FullName) = -1) _
100                 .ToArray
101             Dim tmp As List(Of String) = refList
102
103             Call fullNames.AddRange(myRefs.Select(Function(a) a.FullName))
104             Call refList.Add(assembly.Location)
105
106             i += 1
107
108             Dim LQuery = LinqAPI.MakeList(Of String) <=
109  _
110                 From ref As AssemblyName
111                 In myRefs
112                 Let entry = ref.FullName
113                 Select refListValue =
114                     getReferences(
115                         url:=entry,
116                         i:=i,
117                         refList:=tmp,
118                         fullNames:=fullNames)
119
120             Call refList.AddRange(LQuery.AsEnumerable)
121         End Sub
122
123         ''' <summary>
124         '''
125         ''' </summary>
126         ''' <param name="assembly"></param>
127         ''' <param name="removeSystem">是否移除系统引用</param>
128         ''' <returns></returns>
129         Public Function GetReferences(assembly As Assembly, removeSystem As BooleanOptional strict As Boolean = TrueAs String()
130             Dim refList As New List(Of String)
131
132             assembly.__getReferences(0, refList, fullNames:=New List(Of String))
133             refList += From ref As AssemblyName
134                        In GetType(App).Assembly.GetReferencedAssemblies   ' 添加VB_Framework的引用
135                        Let ass As Assembly =
136                            Assembly.Load(ref.FullName)
137                        Select ass.Location
138             refList = refList.Distinct.AsList
139
140             If removeSystem Then
141                 refList = LinqAPI.MakeList(Of String) <=
142  _
143                     From path As String
144                     In refList
145                     Where Not IsSystemAssembly(path, strict)
146                     Select path
147
148             End If
149
150             Return refList.ToArray
151         End Function
152
153         ''' <summary>
154         ''' 放在C:\WINDOWS\Microsoft.Net\这个文件夹下面的所有的引用都是本地编译的,哈希值已经不对了
155         ''' </summary>
156         ''' <param name="url"></param>
157         ''' <param name="strict"></param>
158         ''' <returns></returns>
159         Public Function IsSystemAssembly(url As String, strict As BooleanAs Boolean
160             Dim assemblyDir As String = FileIO.FileSystem.GetDirectoryInfo(FileIO.FileSystem.GetParentPath(url)).FullName.Replace("/""\")
161
162             If Not assemblyDir.Last = "\" Then
163                 assemblyDir &= "\"
164             End If
165
166             If String.Equals(RunTimeDirectory, assemblyDir) OrElse
167                assemblyDir.StartsWith("C:\WINDOWS\Microsoft.Net\assembly\GAC_"StringComparison.OrdinalIgnoreCase) OrElse
168                assemblyDir.StartsWith("C:\Windows\Microsoft.NET\Framework64"StringComparison.OrdinalIgnoreCase) OrElse
169                assemblyDir.StartsWith("C:\Windows\Microsoft.NET\Framework"StringComparison.OrdinalIgnoreCase) Then
170
171                 If strict Then
172                     Return True
173                 Else
174                     Dim Name As String = basename(url)
175                     If String.Equals(Name, "mscorlib"OrElse String.Equals(Name, "System"OrElse Name.StartsWith("System."Then
176                         Return True
177                     End If
178                 End If
179             End If
180
181             Return False
182         End Function
183
184         ''' <summary>
185         '''
186         ''' </summary>
187         ''' <param name="url">+特殊符号存在于这个字符串之中的话,函数会出错</param>
188         ''' <param name="i"></param>
189         ''' <returns></returns>
190         Private Function getReferences(url As String, i As IntegerByRef refList As List(Of String), fullNames As List(Of String)) As String()
191             Dim assembly = System.Reflection.Assembly.Load(url)
192
193             If IsSystemAssembly(assembly.Location, TrueOrElse refList.IndexOf(assembly.Location) > -1 Then
194                 Return New String() {}
195             Else
196 #If DEBUG Then
197                 Call $"{New String(" "c, i)}{assembly.Location}".__DEBUG_ECHO
198 #End If
199                 Call refList.Add(assembly.Location)
200             End If
201
202             Call __getReferences(assembly, i:=i + 1, refList:=refList, fullNames:=fullNames)
203
204             Return refList.ToArray
205         End Function
206
207         Public ReadOnly Property RunTimeDirectory As String = App.RunTimeDirectory
208     End Module
209 End Namespace