ModEvent.vb 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423
  1. #Region "附加属性"
  2. ''' <summary>
  3. ''' 用于在 XAML 中初始化列表对象。
  4. ''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象,因此需要一个包装类,然后在 XAML 中显式初始化。
  5. ''' </summary>
  6. <Markup.ContentProperty("Events")>
  7. Public Class CustomEventCollection
  8. Implements IEnumerable(Of CustomEvent)
  9. Dim _Events As New List(Of CustomEvent)
  10. Public ReadOnly Property Events As List(Of CustomEvent)
  11. Get
  12. Return _Events
  13. End Get
  14. End Property
  15. Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
  16. Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
  17. End Function
  18. Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
  19. Return DirectCast(Events, IEnumerable).GetEnumerator()
  20. End Function
  21. End Class
  22. ''' <summary>
  23. ''' 提供自定义事件的附加属性。
  24. ''' </summary>
  25. Public Class CustomEventService
  26. 'Events
  27. Public Shared ReadOnly EventsProperty As DependencyProperty =
  28. DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
  29. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  30. Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
  31. d.SetValue(EventsProperty, value)
  32. End Sub
  33. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  34. Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
  35. If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
  36. Return d.GetValue(EventsProperty)
  37. End Function
  38. 'EventType
  39. Public Shared ReadOnly EventTypeProperty As DependencyProperty =
  40. DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
  41. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  42. Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
  43. d.SetValue(EventTypeProperty, value)
  44. End Sub
  45. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  46. Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
  47. Return d.GetValue(EventTypeProperty)
  48. End Function
  49. 'EventData
  50. Public Shared ReadOnly EventDataProperty As DependencyProperty =
  51. DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
  52. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  53. Public Shared Sub SetEventData(d As DependencyObject, value As String)
  54. d.SetValue(EventDataProperty, value)
  55. End Sub
  56. <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
  57. Public Shared Function GetEventData(d As DependencyObject) As String
  58. Return d.GetValue(EventDataProperty)
  59. End Function
  60. End Class
  61. Partial Public Module ModMain
  62. ''' <summary>
  63. ''' 触发该控件上的自定义事件。
  64. ''' 事件会在新线程中执行。
  65. ''' </summary>
  66. <Runtime.CompilerServices.Extension>
  67. Public Sub RaiseCustomEvent(Control As DependencyObject)
  68. '收集事件列表
  69. Dim Events = CustomEventService.GetEvents(Control).ToList
  70. Dim EventType = CustomEventService.GetEventType(Control)
  71. If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
  72. '执行事件
  73. If Not Events.Any Then Return
  74. RunInNewThread(
  75. Sub()
  76. For Each e In Events
  77. e.Raise()
  78. Next
  79. End Sub, "执行自定义事件 " & GetUuid())
  80. End Sub
  81. End Module
  82. #End Region
  83. ''' <summary>
  84. ''' 自定义事件。
  85. ''' </summary>
  86. Public Class CustomEvent
  87. Inherits DependencyObject
  88. #Region "属性与触发"
  89. Public Property Type As EventType
  90. Get
  91. Dim Value As EventType = EventType.None
  92. RunInUiWait(Sub() Value = GetValue(TypeProperty))
  93. Return Value
  94. End Get
  95. Set(value As EventType)
  96. SetValue(TypeProperty, value)
  97. End Set
  98. End Property
  99. Public Shared ReadOnly TypeProperty As DependencyProperty =
  100. DependencyProperty.Register("Type", GetType(EventType), GetType(CustomEvent), New PropertyMetadata(EventType.None))
  101. Public Property Data As String
  102. Get
  103. Dim Value As String = Nothing
  104. RunInUiWait(Sub() Value = GetValue(DataProperty))
  105. Return Value
  106. End Get
  107. Set(value As String)
  108. SetValue(DataProperty, value)
  109. End Set
  110. End Property
  111. Public Shared ReadOnly DataProperty As DependencyProperty =
  112. DependencyProperty.Register("Data", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
  113. Public Sub New()
  114. End Sub
  115. Public Sub New(Type As EventType, Data As String)
  116. Me.Type = Type
  117. Me.Data = Data
  118. End Sub
  119. ''' <summary>
  120. ''' 在当前线程中触发该自定义事件。
  121. ''' </summary>
  122. Public Sub Raise()
  123. Raise(Type, Data)
  124. End Sub
  125. #End Region
  126. Public Enum EventType
  127. None = 0
  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. End Enum
  153. ''' <summary>
  154. ''' 在当前线程中触发一个自定义事件。
  155. ''' </summary>
  156. Public Shared Sub Raise(Type As EventType, Arg As String)
  157. If Type = EventType.None Then Return
  158. Logger.Info($"执行自定义事件:{Type}, {Arg}")
  159. If Arg Is Nothing Then Arg = ""
  160. Dim Args As String() = Arg.Split("|")
  161. Try
  162. Select Case Type
  163. Case EventType.打开网页
  164. Arg = Arg.Replace("\", "/")
  165. If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
  166. MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
  167. Return
  168. End If
  169. Hint("正在开启,请稍候:" & Arg)
  170. RunInThread(Sub() OpenWebsite(Arg))
  171. Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
  172. RunInThread(
  173. Sub()
  174. Try
  175. '确认实际路径
  176. Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
  177. Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
  178. Logger.Info($"打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
  179. '执行
  180. If Type = EventType.打开帮助 Then
  181. PageOtherHelp.EnterHelpPage(Location)
  182. Else
  183. If Not EventSafetyConfirm("即将执行:" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
  184. Dim Info As New ProcessStartInfo With {
  185. .Arguments = If(Args.Length >= 2, Args(1), ""),
  186. .FileName = Location,
  187. .WorkingDirectory = WorkingDir
  188. }
  189. StartProcess(Info)
  190. End If
  191. Catch ex As Exception
  192. Logger.Error(ex, "执行打开类自定义事件失败", LogBehavior.Alert)
  193. End Try
  194. End Sub)
  195. Case EventType.启动游戏
  196. If Args(0) = "\current" Then
  197. If McInstanceSelected Is Nothing Then
  198. Hint("请先选择一个 Minecraft 版本!", HintType.Red)
  199. Return
  200. Else
  201. Args(0) = McInstanceSelected.Name
  202. End If
  203. End If
  204. RunInUi(
  205. Sub()
  206. If McLaunchStart(New McLaunchOptions With
  207. {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
  208. Hint($"正在启动 {Args(0)}……")
  209. End If
  210. End Sub)
  211. Case EventType.复制文本
  212. ClipboardSet(Arg)
  213. Case EventType.刷新主页
  214. RunInUi(
  215. Sub()
  216. FrmLaunchRight.ForceRefresh()
  217. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  218. End Sub)
  219. Case EventType.刷新页面
  220. If TypeOf FrmMain.PageRight Is IRefreshable Then
  221. RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
  222. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  223. Else
  224. Hint("当前页面不支持刷新操作!", HintType.Red)
  225. End If
  226. Case EventType.刷新帮助
  227. RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
  228. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  229. Case EventType.今日人品
  230. PageOtherTest.Jrrp()
  231. Case EventType.内存优化
  232. RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
  233. Case EventType.清理垃圾
  234. RunInThread(Sub() PageOtherTest.RubbishClear())
  235. Case EventType.弹出窗口
  236. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 弹窗标题|弹窗内容")
  237. MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
  238. Case EventType.弹出提示
  239. Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Args(1))))
  240. Case EventType.切换页面
  241. RunInUi(Sub() FrmMain.PageChange(
  242. EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
  243. If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
  244. Case EventType.导入整合包, EventType.安装整合包
  245. RunInUi(Sub() ModpackInstall())
  246. Case EventType.下载文件
  247. Args(0) = Args(0).Replace("\", "/")
  248. If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
  249. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
  250. Return
  251. End If
  252. If Not EventSafetyConfirm("即将从该网址下载文件:" & vbCrLf & Args(0)) Then Return
  253. RunInUi(
  254. Sub()
  255. Try
  256. Select Case Args.Length
  257. Case 1
  258. PageOtherTest.StartCustomDownload(Args(0), PathUtils.GetLastPart(Args(0)))
  259. Case 2
  260. PageOtherTest.StartCustomDownload(Args(0), Args(1))
  261. Case Else
  262. PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
  263. End Select
  264. Catch
  265. PageOtherTest.StartCustomDownload(Args(0), "未知")
  266. End Try
  267. End Sub)
  268. Case EventType.修改设置, EventType.写入设置
  269. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
  270. Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
  271. If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
  272. Case EventType.修改变量, EventType.写入变量
  273. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
  274. WriteReg("CustomEvent" & Args(0), Args(1))
  275. If Args.Length = 2 Then Hint($"已写入变量:{Args(0)} → {Args(1)}", HintType.Green)
  276. Case EventType.加入房间
  277. RunInUi(
  278. Sub()
  279. If String.IsNullOrWhiteSpace(Arg) Then
  280. PageLinkMain.Join()
  281. Else
  282. If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
  283. PageLinkMain.Join(Arg)
  284. End If
  285. End Sub)
  286. Case EventType.检查更新
  287. UpdateCheckByButton()
  288. Case Else
  289. MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
  290. End Select
  291. Catch ex As Exception
  292. Logger.Error(ex, $"事件执行失败({Type}, {Arg})", LogBehavior.Alert)
  293. End Try
  294. End Sub
  295. ''' <summary>
  296. ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
  297. ''' 失败会抛出异常。
  298. ''' </summary>
  299. Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
  300. '网页确认
  301. If RelativeUrl.StartsWithF("http", True) Then
  302. If RunInUi() Then
  303. Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性!")
  304. End If
  305. '获取文件名
  306. Dim RawFileName As String
  307. Try
  308. RawFileName = PathUtils.GetLastPart(RelativeUrl)
  309. If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
  310. Catch ex As Exception
  311. Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  312. "例如:" & vbCrLf &
  313. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  314. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  315. End Try
  316. '下载文件
  317. Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
  318. Logger.Info($"转换网络资源:{RelativeUrl} -> {LocalTemp}")
  319. Try
  320. NetDownloadByClient(RelativeUrl, LocalTemp)
  321. NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
  322. Catch ex As Exception
  323. Throw New Exception("下载指定的文件失败!" & vbCrLf &
  324. "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  325. "例如:" & vbCrLf &
  326. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  327. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  328. End Try
  329. RelativeUrl = LocalTemp
  330. End If
  331. RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
  332. '确认实际路径
  333. Dim Location As String, WorkingDir As String = Paths.Base & "PCL"
  334. HelpTryExtract()
  335. If RelativeUrl.Contains(":\") Then
  336. '绝对路径
  337. Location = RelativeUrl
  338. Logger.Info($"自定义事件中由绝对路径{Type}:{Location}")
  339. ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
  340. '相对 PCL 文件夹的路径
  341. Location = Paths.Base & "PCL\" & RelativeUrl
  342. Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}:{Location}")
  343. ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
  344. '相对 PCL 本地帮助文件夹的路径
  345. Location = Paths.Base & "PCL\Help\" & RelativeUrl
  346. WorkingDir = Paths.Base & "PCL\Help\"
  347. Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}:{Location}")
  348. ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
  349. '相对 PCL 自带帮助文件夹的路径
  350. Location = PathTemp & "Help\" & RelativeUrl
  351. WorkingDir = PathTemp & "Help\"
  352. Logger.Info($"自定义事件中由相对 PCL 自带帮助文件夹的路径{Type}:{Location}")
  353. ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
  354. '直接使用原有路径启动程序
  355. Location = RelativeUrl
  356. Logger.Info($"自定义事件中直接{Type}:{Location}")
  357. Else
  358. '打开帮助,但是格式不对劲
  359. Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
  360. End If
  361. Return {Location, WorkingDir}
  362. End Function
  363. ''' <summary>
  364. ''' 弹出安全确认弹窗。返回是否继续执行。
  365. ''' </summary>
  366. Private Shared Function EventSafetyConfirm(Message As String) As Boolean
  367. If Settings.Get(Of Boolean)("HintCustomCommand") Then Return True
  368. Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
  369. Case 1
  370. Return True
  371. Case 2
  372. Settings.Set("HintCustomCommand", True)
  373. Return True
  374. Case Else
  375. Return False
  376. End Select
  377. End Function
  378. End Class