1 |
#Region "Microsoft.VisualBasic::125a6d44d8c1671566edd5ee1a66651c, Microsoft.VisualBasic.Core\CommandLine\InteropService\SharedORM\VisualBasic.vb"
|
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 |
#End Region
|
47 |
|
48 |
Imports System.Runtime.CompilerServices
|
49 |
Imports System.Text
|
50 |
Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel
|
51 |
Imports Microsoft.VisualBasic.Language
|
52 |
Imports Microsoft.VisualBasic.Scripting.SymbolBuilder.VBLanguage
|
53 |
Imports Microsoft.VisualBasic.Text
|
54 |
Imports Microsoft.VisualBasic.Text.Xml
|
55 |
|
56 |
Namespace CommandLine.InteropService.SharedORM
|
57 |
|
58 |
Public Class VisualBasic : Inherits CodeGenerator
|
59 |
|
60 |
Dim namespace$
|
61 |
|
62 |
<MethodImpl(MethodImplOptions.AggressiveInlining)>
|
63 |
Public Sub New(CLI As Type, namespace$)
|
64 |
Me.New(New Interpreter(type:=CLI), [namespace])
|
65 |
End Sub
|
66 |
|
67 |
Sub New(App As Interpreter, Optional namespace$ = Nothing)
|
68 |
Call MyBase.New(App)
|
69 |
Me.namespace = [namespace] Or App.Type.Name.AsDefault
|
70 |
End Sub
|
71 |
|
72 |
Public Overrides Function GetSourceCode() As String
|
73 |
Dim vb As New StringBuilder
|
74 |
Dim className$ = MyBase.exe _
|
75 |
.NormalizePathString(OnlyASCII:=True) _
|
76 |
.Replace(" ", "_")
|
77 |
Dim rel$ = PathExtensions.RelativePath(App.Type.Assembly.Location.GetFullPath)
|
78 |
Dim info$ = App.Type.NamespaceEntry.Description
|
79 |
Dim appName$ = KeywordProcessor.AutoEscapeVBKeyword(className)
|
80 |
|
81 |
Call vb.AppendLine("Imports System.Runtime.CompilerServices")
|
82 |
Call vb.AppendLine("Imports " & GetType(StringBuilder).Namespace)
|
83 |
Call vb.AppendLine("Imports " & GetType(IIORedirectAbstract).Namespace)
|
84 |
Call vb.AppendLine("Imports " & GetType(InteropService).Namespace)
|
85 |
Call vb.AppendLine("Imports Microsoft.VisualBasic.ApplicationServices")
|
86 |
Call vb.AppendLine()
|
87 |
Call vb.AppendLine("' Microsoft VisualBasic CommandLine Code AutoGenerator")
|
88 |
Call vb.AppendLine("' assembly: " & rel)
|
89 |
Call vb.AppendLine()
|
90 |
Call vb.AppendLine(GetManualPage.LineTokens.Select(Function(l) "' " & l).JoinBy(vbCrLf))
|
91 |
Call vb.AppendLine()
|
92 |
Call vb.AppendLine("Namespace " & [namespace])
|
93 |
Call vb.AppendLine()
|
94 |
Call vb.AppendLine(__xmlComments(XmlEntity.EscapingXmlEntity(info)))
|
95 |
Call vb.AppendLine($"Public Class {appName} : Inherits {GetType(InteropService).Name}")
|
96 |
Call vb.AppendLine()
|
97 |
Call vb.AppendLine($" Public Const App$ = ""{exe}.exe""")
|
98 |
Call vb.AppendLine()
|
99 |
Call vb.AppendLine(" Sub New(App$)")
|
100 |
Call vb.AppendLine($" MyBase.{NameOf(InteropService._executableAssembly)} = App$")
|
101 |
Call vb.AppendLine(" End Sub")
|
102 |
Call vb.AppendLine()
|
103 |
Call vb.AppendLine(" <MethodImpl(MethodImplOptions.AggressiveInlining)>")
|
104 |
Call vb.AppendLine($" Public Shared Function FromEnvironment(directory As String) As {appName}")
|
105 |
Call vb.AppendLine($" Return New {appName}(App:=directory & ""/"" & {appName}.App)")
|
106 |
Call vb.AppendLine(" End Function")
|
107 |
|
108 |
For Each API In Me.EnumeratesAPI
|
109 |
Call __calls(vb, API.CLI, incompatible:=Not InCompatibleAttribute.CLRProcessCompatible(API.API))
|
110 |
Next
|
111 |
|
112 |
Call vb.AppendLine("End Class")
|
113 |
Call vb.AppendLine("End Namespace")
|
114 |
|
115 |
Return vb.ToString
|
116 |
End Function
|
117 |
|
118 |
Private Shared Function __xmlComments(description$) As String
|
119 |
If description.StringEmpty Then
|
120 |
description = "<span class="xml_comment">'''"</span>
|
121 |
Else
|
122 |
description = description _
|
123 |
.LineTokens _
|
124 |
.Select(Function(s) "
|
125 |
.JoinBy(vbCrLf)
|
126 |
End If
|
127 |
|
128 |
Return $"
|
129 |
<span class="xml_comment">''' <summary></span>
|
130 |
{description}
|
131 |
<span class="xml_comment">''' </summary></span>
|
132 |
<span class="xml_comment">'''"</span>
|
133 |
End Function
|
134 |
|
135 |
<span class="xml_comment">''' <summary></span>
|
136 |
<span class="xml_comment">''' </span>
|
137 |
<span class="xml_comment">''' </summary></span>
|
138 |
<span class="xml_comment">''' <param name="vb"></param></span>
|
139 |
<span class="xml_comment">''' <param name="API"></param></span>
|
140 |
<span class="xml_comment">''' <remarks></span>
|
141 |
<span class="xml_comment">''' </remarks></span>
|
142 |
Private Sub __calls(vb As StringBuilder, API As NamedValue(Of CommandLine), incompatible As Boolean)
|
143 |
|
144 |
#Region "Code template"
|
145 |
|
146 |
|
147 |
' Dim CLI$ = "commandname arguments"
|
148 |
|
149 |
'
|
150 |
|
151 |
|
152 |
#End Region
|
153 |
|
154 |
|
155 |
Dim func$ = API.Name
|
156 |
|
157 |
Dim xmlComments$ = __xmlComments(API.Description)
|
158 |
Dim params$()
|
159 |
|
160 |
Try
|
161 |
If func.First <= "9" AndAlso func.First >= "0"c Then
|
162 |
func = "_" & func
|
163 |
Else
|
164 |
|
165 |
func = KeywordProcessor.AutoEscapeVBKeyword(func)
|
166 |
End If
|
167 |
params = __vbParameters(API.Value)
|
168 |
Catch ex As Exception
|
169 |
ex = New Exception("Check for your CLI Usage definition: " & API.Value.ToString, ex)
|
170 |
Throw ex
|
171 |
End Try
|
172 |
|
173 |
Call vb.AppendLine(xmlComments)
|
174 |
|
175 |
Call vb.AppendLine($"Public Function {func}({params.JoinBy(", ")}) As Integer")
|
176 |
Call vb.AppendLine($" Dim CLI As New StringBuilder(""{API.Value.Name}"")")
|
177 |
Call vb.AppendLine(" Call CLI.Append("" "")")
|
178 |
Call vb.AppendLine(__CLI(+API))
|
179 |
Call vb.AppendLine()
|
180 |
|
181 |
If incompatible Then
|
182 |
|
183 |
Call vb.AppendLine($" Dim proc As {NameOf(IIORedirectAbstract)} = {NameOf(InteropService.RunProgram)}(CLI.ToString(), Nothing)")
|
184 |
Else
|
185 |
|
186 |
Call vb.AppendLine($" Dim proc As {NameOf(IIORedirectAbstract)} = {NameOf(InteropService.RunDotNetApp)}(CLI.ToString())")
|
187 |
End If
|
188 |
|
189 |
Call vb.AppendLine($" Return proc.{NameOf(IIORedirectAbstract.Run)}()")
|
190 |
Call vb.AppendLine("End Function")
|
191 |
End Sub
|
192 |
|
193 |
|
194 |
<span class="xml_comment">''' <summary></span>
|
195 |
<span class="xml_comment">''' 在这个函数之中会生成函数的参数列表</span>
|
196 |
<span class="xml_comment">''' </summary></span>
|
197 |
<span class="xml_comment">''' <param name="API"></param></span>
|
198 |
<span class="xml_comment">''' <returns></returns></span>
|
199 |
Private Shared Function __vbParameters(API As CommandLine) As String()
|
200 |
Dim out As New List(Of String)
|
201 |
Dim param$
|
202 |
|
203 |
For Each arg As NamedValue(Of String) In API.ParameterList
|
204 |
param = $"{VisualBasic.__normalizedAsIdentifier(arg.Name)} As String"
|
205 |
|
206 |
If Not arg.Description.StringEmpty Then
|
207 |
|
208 |
param = $"Optional {param} = ""{__defaultValue(arg.Value)}"""
|
209 |
End If
|
210 |
|
211 |
out += param
|
212 |
Next
|
213 |
For Each bool In API.BoolFlags
|
214 |
out += $"Optional {VisualBasic.__normalizedAsIdentifier(bool)} As Boolean = False"
|
215 |
Next
|
216 |
|
217 |
Return out
|
218 |
End Function
|
219 |
|
220 |
|
221 |
|
222 |
|
223 |
|
224 |
|
225 |
Private Shared Function __defaultValue(value$) As String
|
226 |
If value.First = """"c AndAlso value.Last = """"c Then
|
227 |
|
228 |
value = value.GetStackValue(ASCII.Quot, ASCII.Quot)
|
229 |
ElseIf value.First = "<"c AndAlso value.Last = ">"c Then
|
230 |
|
231 |
value = value.GetStackValue("<", ">")
|
232 |
|
233 |
If InStr(value, "default=") > 0 Then
|
234 |
value = Strings.Split(value, "default=").Last.Trim(""""c)
|
235 |
Else
|
236 |
value = ""
|
237 |
End If
|
238 |
Else
|
239 |
|
240 |
value = ""
|
241 |
End If
|
242 |
|
243 |
value = value.Replace(""""c, New String(ASCII.Quot, 2))
|
244 |
|
245 |
Return value
|
246 |
End Function
|
247 |
|
248 |
Private Shared Function __CLI(API As CommandLine) As String
|
249 |
Dim CLI As New StringBuilder
|
250 |
Dim vbcode$
|
251 |
|
252 |
For Each param In API.ParameterList
|
253 |
Dim var$ = __normalizedAsIdentifier(param.Name)
|
254 |
|
255 |
|
256 |
vbcode = $" Call CLI.Append(""{param.Name} "" & """""""" & {var} & """""" "")"
|
257 |
|
258 |
If param.Description.StringEmpty Then
|
259 |
|
260 |
Call CLI.AppendLine(vbcode)
|
261 |
Else
|
262 |
|
263 |
Call CLI.AppendLine($" If Not {var}.{NameOf(StringEmpty)} Then")
|
264 |
Call CLI.AppendLine(" " & vbcode)
|
265 |
Call CLI.AppendLine(" End If")
|
266 |
End If
|
267 |
Next
|
268 |
|
269 |
For Each b In API.BoolFlags
|
270 |
Dim var$ = __normalizedAsIdentifier(b)
|
271 |
|
272 |
Call CLI.AppendLine($" If {var} Then")
|
273 |
Call CLI.AppendLine($" Call CLI.Append(""{b} "")")
|
274 |
Call CLI.AppendLine(" End If")
|
275 |
Next
|
276 |
|
277 |
Return CLI.ToString
|
278 |
End Function
|
279 |
|
280 |
Const SyntaxError$ = "
|
281 |
|
282 |
|
283 |
|
284 |
|
285 |
|
286 |
|
287 |
Private Shared Function __normalizedAsIdentifier(arg$) As String
|
288 |
|
289 |
Dim name$ = arg.Trim("/"c, "\"c, "-"c)
|
290 |
Dim s As Char() = name.ToArray
|
291 |
Dim upper As Char() = name.ToUpper.ToArray
|
292 |
Dim c As Char
|
293 |
|
294 |
If s.First = "<"c OrElse s.Last = ">"c Then
|
295 |
Throw New SyntaxErrorException(SyntaxError)
|
296 |
End If
|
297 |
|
298 |
For i As Integer = 0 To s.Length - 1
|
299 |
c = upper(i)
|
300 |
|
301 |
If (c >= "A"c AndAlso c <= "Z"c) OrElse (c >= "0"c AndAlso c <= "9"c) OrElse (c = "_") Then
|
302 |
|
303 |
Else
|
304 |
|
305 |
s(i) = "_"c
|
306 |
End If
|
307 |
Next
|
308 |
|
309 |
If s.First >= "0"c AndAlso s.First <= "9"c Then
|
310 |
Return "_" & New String(s)
|
311 |
Else
|
312 |
|
313 |
Return KeywordProcessor.AutoEscapeVBKeyword(New String(s))
|
314 |
End If
|
315 |
End Function
|
316 |
End Class
|
317 |
End Namespace
|