ModEvent.vb 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202
  1. Public Module ModEvent
  2. Public Sub TryStartEvent(Type As String, Data As String)
  3. If String.IsNullOrWhiteSpace(Type) Then Return
  4. Dim RealData As String() = {""}
  5. If Data IsNot Nothing Then RealData = Data.Split("|")
  6. StartEvent(Type, RealData)
  7. End Sub
  8. Public Sub StartEvent(Type As String, Data As String())
  9. Try
  10. Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", "))
  11. Select Case Type
  12. Case "打开网页"
  13. Data(0) = Data(0).Replace("\", "/")
  14. If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
  15. MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
  16. Return
  17. End If
  18. Hint("正在开启中,请稍候……")
  19. OpenWebsite(Data(0))
  20. Case "打开文件", "打开帮助", "执行命令"
  21. RunInThread(
  22. Sub()
  23. Try
  24. '确认实际路径
  25. Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
  26. Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
  27. Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
  28. '执行
  29. If Type = "打开帮助" Then
  30. PageOtherHelp.EnterHelpPage(Location)
  31. Else
  32. If Not Setup.Get("HintCustomCommand") Then
  33. Select Case MyMsgBox(
  34. "即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
  35. "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
  36. Case 2
  37. Setup.Set("HintCustomCommand", True)
  38. Case 3
  39. Return
  40. End Select
  41. End If
  42. Dim Info As New ProcessStartInfo With {
  43. .Arguments = If(Data.Length >= 2, Data(1), ""),
  44. .FileName = Location,
  45. .WorkingDirectory = ShortenPath(WorkingDir)
  46. }
  47. Process.Start(Info)
  48. End If
  49. Catch ex As Exception
  50. Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
  51. End Try
  52. End Sub)
  53. Case "启动游戏"
  54. If Data(0) = "\current" Then
  55. If McVersionCurrent Is Nothing Then
  56. Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
  57. Return
  58. Else
  59. Data(0) = McVersionCurrent.Name
  60. End If
  61. End If
  62. If McLaunchStart(New McLaunchOptions With
  63. {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
  64. Hint("正在启动 " & Data(0) & "……")
  65. End If
  66. Case "复制文本"
  67. ClipboardSet(Join(Data, "|"))
  68. Case "刷新主页"
  69. FrmLaunchRight.ForceRefresh()
  70. If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
  71. Case "刷新帮助"
  72. PageOtherLeft.RefreshHelp()
  73. Case "今日人品"
  74. PageOtherTest.Jrrp()
  75. Case "内存优化"
  76. RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
  77. Case "清理垃圾"
  78. RunInThread(Sub() PageOtherTest.RubbishClear())
  79. Case "弹出窗口"
  80. MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
  81. Case "切换页面"
  82. FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
  83. Case "导入整合包", "安装整合包"
  84. RunInUi(Sub() ModpackInstall())
  85. Case "下载文件"
  86. Data(0) = Data(0).Replace("\", "/")
  87. If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
  88. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
  89. Return
  90. End If
  91. Try
  92. Select Case Data.Length
  93. Case 1
  94. PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
  95. Case 2
  96. PageOtherTest.StartCustomDownload(Data(0), Data(1))
  97. Case Else
  98. PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
  99. End Select
  100. Catch
  101. PageOtherTest.StartCustomDownload(Data(0), "未知")
  102. End Try
  103. Case "修改设置"
  104. Setup.Set(Data(0), Data(1))
  105. Hint($"已写入设置:{Data(0)} → {Data(1)}", HintType.Finish)
  106. Case Else
  107. MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
  108. End Select
  109. Catch ex As Exception
  110. Log(ex, "事件执行失败", LogLevel.Msgbox)
  111. End Try
  112. End Sub
  113. ''' <summary>
  114. ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
  115. ''' 失败会抛出异常。
  116. ''' </summary>
  117. Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
  118. '网页确认
  119. If RelativeUrl.StartsWithF("http", True) Then
  120. If RunInUi() Then
  121. Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性!")
  122. End If
  123. '获取文件名
  124. Dim RawFileName As String
  125. Try
  126. RawFileName = GetFileNameFromPath(RelativeUrl)
  127. If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
  128. Catch ex As Exception
  129. Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  130. "例如:" & vbCrLf &
  131. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  132. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  133. End Try
  134. '下载文件
  135. Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
  136. Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp)
  137. Try
  138. NetDownloadByClient(RelativeUrl, LocalTemp)
  139. NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
  140. Catch ex As Exception
  141. Throw New Exception("下载指定的文件失败!" & vbCrLf &
  142. "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  143. "例如:" & vbCrLf &
  144. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  145. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  146. End Try
  147. RelativeUrl = LocalTemp
  148. End If
  149. RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
  150. '确认实际路径
  151. Dim Location As String, WorkingDir As String = Path & "PCL"
  152. HelpTryExtract()
  153. If RelativeUrl.Contains(":\") Then
  154. '绝对路径
  155. Location = RelativeUrl
  156. Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location)
  157. ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
  158. '相对 PCL 文件夹的路径
  159. Location = Path & "PCL\" & RelativeUrl
  160. Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location)
  161. ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
  162. '相对 PCL 本地帮助文件夹的路径
  163. Location = Path & "PCL\Help\" & RelativeUrl
  164. WorkingDir = Path & "PCL\Help\"
  165. Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location)
  166. ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
  167. '相对 PCL 自带帮助文件夹的路径
  168. Location = PathTemp & "Help\" & RelativeUrl
  169. WorkingDir = PathTemp & "Help\"
  170. Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
  171. ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
  172. '直接使用原有路径启动程序
  173. Location = RelativeUrl
  174. Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
  175. Else
  176. '打开帮助,但是格式不对劲
  177. Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
  178. End If
  179. Return {Location, WorkingDir}
  180. End Function
  181. End Module