ModEvent.vb 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429
  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. Dim Arg0 As String = Arg.BeforeFirst("|")
  162. Dim Arg1 As String = Arg.AfterFirst("|")
  163. Try
  164. Select Case Type
  165. Case EventType.打开网页
  166. Arg = Arg.Replace("\", "/")
  167. If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
  168. MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
  169. Return
  170. End If
  171. Hint("正在开启,请稍候:" & Arg)
  172. RunInThread(Sub() OpenWebsite(Arg))
  173. Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
  174. RunInThread(
  175. Sub()
  176. Try
  177. '确认实际路径
  178. Dim ActualPaths = GetAbsoluteUrls(Arg0, Type)
  179. Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
  180. Logger.Info($"打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
  181. '执行
  182. If Type = EventType.打开帮助 Then
  183. PageOtherHelp.EnterHelpPage(Location)
  184. Else
  185. If Not EventSafetyConfirm("即将执行:" & Location & If(Args.Length >= 2, " " & Arg1, "")) Then Return
  186. Dim Info As New ProcessStartInfo With {
  187. .Arguments = If(Args.Length >= 2, Arg1, ""),
  188. .FileName = Location,
  189. .WorkingDirectory = WorkingDir
  190. }
  191. StartProcess(Info)
  192. End If
  193. Catch ex As Exception
  194. Logger.Error(ex, "执行打开类自定义事件失败", LogBehavior.Alert)
  195. End Try
  196. End Sub)
  197. Case EventType.启动游戏
  198. If Arg0 = "\current" Then
  199. If McInstanceSelected Is Nothing Then
  200. Hint("请先选择一个 Minecraft 版本!", HintType.Red)
  201. Return
  202. Else
  203. Arg0 = McInstanceSelected.Name
  204. End If
  205. End If
  206. RunInUi(
  207. Sub()
  208. If McLaunchStart(New McLaunchOptions With
  209. {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Arg0)}) Then
  210. Hint($"正在启动 {Arg0}……")
  211. End If
  212. End Sub)
  213. Case EventType.复制文本
  214. ClipboardSet(Arg)
  215. Case EventType.刷新主页
  216. RunInUi(
  217. Sub()
  218. FrmLaunchRight.ForceRefresh()
  219. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  220. End Sub)
  221. Case EventType.刷新页面
  222. If TypeOf FrmMain.PageRight Is IRefreshable Then
  223. RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
  224. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  225. Else
  226. Hint("当前页面不支持刷新操作!", HintType.Red)
  227. End If
  228. Case EventType.刷新帮助
  229. RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
  230. If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
  231. Case EventType.今日人品
  232. PageOtherTest.Jrrp()
  233. Case EventType.内存优化
  234. RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
  235. Case EventType.清理垃圾
  236. RunInThread(Sub() PageOtherTest.RubbishClear())
  237. Case EventType.弹出窗口
  238. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 弹窗标题|弹窗内容")
  239. MyMsgBox(Arg1.BeforeLast("|").Replace("\n", vbCrLf), Arg0.Replace("\n", vbCrLf), If(Args.Length > 2, Arg1.AfterLast("|"), "确定"))
  240. Case EventType.弹出提示
  241. Hint(Arg0.Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Arg1)))
  242. Case EventType.切换页面
  243. RunInUi(Sub() FrmMain.PageChange(
  244. EnumUtils.FromString(Of FormMain.PageType)(Arg0),
  245. If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Arg1))))
  246. Case EventType.导入整合包, EventType.安装整合包
  247. RunInUi(Sub() ModpackInstall())
  248. Case EventType.下载文件
  249. Arg0 = Arg0.Replace("\", "/")
  250. If Not (Arg0.StartsWithF("http://", True) OrElse Arg0.StartsWithF("https://", True)) Then
  251. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
  252. Return
  253. End If
  254. If Not EventSafetyConfirm("即将从该网址下载文件:" & vbCrLf & Arg0) Then Return
  255. RunInUi(
  256. Sub()
  257. Try
  258. Select Case Args.Length
  259. Case 1
  260. PageOtherTest.StartCustomDownload(Arg0, PathUtils.GetLastPart(Arg0))
  261. Case 2
  262. PageOtherTest.StartCustomDownload(Arg0, Arg1)
  263. Case Else
  264. PageOtherTest.StartCustomDownload(Arg0, Arg(1), Args(2))
  265. End Select
  266. Catch
  267. PageOtherTest.StartCustomDownload(Arg0, "未知")
  268. End Try
  269. End Sub)
  270. Case EventType.修改设置, EventType.写入设置
  271. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
  272. Settings.SetSafe(Arg0, Arg1, Instance:=McInstanceSelected)
  273. If Args.Length = 2 Then Hint($"已写入设置:{Arg0} → {Arg1}", HintType.Green)
  274. Case EventType.修改变量, EventType.写入变量
  275. If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
  276. Try
  277. RegistryUtils.Write($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{Arg0}", Arg1)
  278. If Args.Length = 2 Then Hint($"已写入变量:{Arg0} → {Arg1}", HintType.Green)
  279. Catch ex As Exception
  280. Logger.Warn(ex, $"写入变量失败:{Arg0} → {Arg1}", LogBehavior.Toast)
  281. End Try
  282. Case EventType.加入房间
  283. RunInUi(
  284. Sub()
  285. If String.IsNullOrWhiteSpace(Arg) Then
  286. PageLinkMain.Join()
  287. Else
  288. If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
  289. PageLinkMain.Join(Arg)
  290. End If
  291. End Sub)
  292. Case EventType.检查更新
  293. UpdateCheckByButton()
  294. Case Else
  295. MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
  296. End Select
  297. Catch ex As Exception
  298. Logger.Error(ex, $"事件执行失败({Type}, {Arg})", LogBehavior.Alert)
  299. End Try
  300. End Sub
  301. ''' <summary>
  302. ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
  303. ''' 失败会抛出异常。
  304. ''' </summary>
  305. Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
  306. '网页确认
  307. If RelativeUrl.StartsWithF("http", True) Then
  308. If RunInUi() Then
  309. Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性!")
  310. End If
  311. '获取文件名
  312. Dim RawFileName As String
  313. Try
  314. RawFileName = PathUtils.GetLastPart(RelativeUrl)
  315. If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
  316. Catch ex As Exception
  317. Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  318. "例如:" & vbCrLf &
  319. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  320. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  321. End Try
  322. '下载文件
  323. Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
  324. Logger.Info($"转换网络资源:{RelativeUrl} -> {LocalTemp}")
  325. Try
  326. NetDownloadByClient(RelativeUrl, LocalTemp)
  327. NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
  328. Catch ex As Exception
  329. Throw New Exception("下载指定的文件失败!" & vbCrLf &
  330. "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  331. "例如:" & vbCrLf &
  332. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  333. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  334. End Try
  335. RelativeUrl = LocalTemp
  336. End If
  337. RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
  338. '确认实际路径
  339. Dim Location As String, WorkingDir As String = Paths.Base & "PCL"
  340. HelpTryExtract()
  341. If RelativeUrl.Contains(":\") Then
  342. '绝对路径
  343. Location = RelativeUrl
  344. Logger.Info($"自定义事件中由绝对路径{Type}:{Location}")
  345. ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
  346. '相对 PCL 文件夹的路径
  347. Location = Paths.Base & "PCL\" & RelativeUrl
  348. Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}:{Location}")
  349. ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
  350. '相对 PCL 本地帮助文件夹的路径
  351. Location = Paths.Base & "PCL\Help\" & RelativeUrl
  352. WorkingDir = Paths.Base & "PCL\Help\"
  353. Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}:{Location}")
  354. ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
  355. '相对 PCL 自带帮助文件夹的路径
  356. Location = PathTemp & "Help\" & RelativeUrl
  357. WorkingDir = PathTemp & "Help\"
  358. Logger.Info($"自定义事件中由相对 PCL 自带帮助文件夹的路径{Type}:{Location}")
  359. ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
  360. '直接使用原有路径启动程序
  361. Location = RelativeUrl
  362. Logger.Info($"自定义事件中直接{Type}:{Location}")
  363. Else
  364. '打开帮助,但是格式不对劲
  365. Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
  366. End If
  367. Return {Location, WorkingDir}
  368. End Function
  369. ''' <summary>
  370. ''' 弹出安全确认弹窗。返回是否继续执行。
  371. ''' </summary>
  372. Private Shared Function EventSafetyConfirm(Message As String) As Boolean
  373. If Settings.Get(Of Boolean)("HintCustomCommand") Then Return True
  374. Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
  375. Case 1
  376. Return True
  377. Case 2
  378. Settings.Set("HintCustomCommand", True)
  379. Return True
  380. Case Else
  381. Return False
  382. End Select
  383. End Function
  384. End Class