ModEvent.vb 18 KB

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