1
0

ModEvent.vb 9.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. Public Module ModEvent
  2. Public Sub TryStartEvent(Type As String, Data As String)
  3. If String.IsNullOrWhiteSpace(Type) Then Exit Sub
  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).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
  15. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
  16. Exit Sub
  17. End If
  18. Hint("正在打开网页,请稍候……")
  19. OpenWebsite(Data(0))
  20. Case "打开文件", "打开帮助"
  21. RunInThread(Sub()
  22. Try
  23. '确认实际路径
  24. Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
  25. Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
  26. '执行
  27. If Type = "打开文件" Then
  28. Dim Info As New ProcessStartInfo With {
  29. .Arguments = If(Data.Length >= 2, Data(1), ""),
  30. .FileName = Location,
  31. .WorkingDirectory = WorkingDir
  32. }
  33. Process.Start(Info)
  34. Else '打开帮助
  35. PageOtherHelp.EnterHelpPage(Location)
  36. End If
  37. Catch ex As Exception
  38. Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
  39. End Try
  40. End Sub)
  41. Case "启动游戏"
  42. '初始化与前置条件检测
  43. If Not (FrmLaunchLeft.BtnLaunch.IsEnabled AndAlso FrmLaunchLeft.BtnLaunch.Visibility = Visibility.Visible AndAlso FrmLaunchLeft.BtnLaunch.IsHitTestVisible) Then
  44. Hint("已有游戏正在启动中!", HintType.Critical) : Exit Sub
  45. End If
  46. If Not Directory.Exists(PathMcFolder & "versions\" & Data(0)) Then
  47. Hint("未在当前 Minecraft 文件夹找到版本 " & Data(0) & "!", HintType.Critical) : Exit Sub
  48. End If
  49. Dim ButtonVersion As New McVersion(Data(0))
  50. ButtonVersion.Load()
  51. If ButtonVersion.State = McVersionState.Error Then
  52. Hint("无法启动 " & Data(0) & ":" & ButtonVersion.Info, HintType.Critical) : Exit Sub
  53. End If
  54. '实际启动
  55. McVersionCurrent = ButtonVersion
  56. Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
  57. FrmLaunchLeft.PageLaunchLeft_Loaded()
  58. FrmLaunchLeft.RefreshButtonsUI()
  59. FrmMain.AprilGiveup()
  60. FrmLaunchLeft.LaunchButtonClick(If(Data.Length >= 2, Data(1), ""))
  61. FrmMain.PageChange(FormMain.PageType.Launch)
  62. Case "复制文本"
  63. ClipboardSet(Join(Data, "|"))
  64. Case "刷新主页"
  65. FrmLaunchRight.ForceRefresh()
  66. Case "刷新帮助"
  67. PageOtherLeft.RefreshHelp()
  68. Case "弹出窗口"
  69. MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
  70. Case "下载文件"
  71. Data(0) = Data(0).Replace("\", "/")
  72. If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
  73. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL2 不支持其他乱七八糟的协议。", "事件执行失败")
  74. Exit Sub
  75. End If
  76. PageOtherTest.StartCustomDownload(Data(0))
  77. Case Else
  78. MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL2 是否为最新版本。", "事件执行失败")
  79. End Select
  80. Catch ex As Exception
  81. Log(ex, "事件执行失败", LogLevel.Msgbox)
  82. End Try
  83. End Sub
  84. ''' <summary>
  85. ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
  86. ''' 失败会抛出异常。
  87. ''' </summary>
  88. Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
  89. '网页确认
  90. If RelativeUrl.ToLower.StartsWith("http") Then
  91. If RunInUi() Then
  92. Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
  93. "因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
  94. End If
  95. '获取文件名
  96. Dim RawFileName As String
  97. Try
  98. RawFileName = GetFileNameFromPath(RelativeUrl)
  99. If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
  100. Catch ex As Exception
  101. Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  102. "例如:" & vbCrLf &
  103. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  104. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  105. End Try
  106. '下载文件
  107. Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName
  108. Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
  109. Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp1)
  110. Hint("正在获取资源,请稍候……")
  111. Try
  112. NetDownload(RelativeUrl, LocalTemp1)
  113. NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
  114. Catch ex As Exception
  115. Throw New Exception("下载指定的文件失败!" & vbCrLf &
  116. "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  117. "例如:" & vbCrLf &
  118. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  119. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  120. End Try
  121. RelativeUrl = LocalTemp1
  122. End If
  123. RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
  124. '确认实际路径
  125. Dim Location As String, WorkingDir As String = Path & "PCL"
  126. If RelativeUrl.Contains(":\") Then
  127. '绝对路径
  128. Location = RelativeUrl
  129. Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location)
  130. ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
  131. '相对 PCL 文件夹的路径
  132. Location = Path & "PCL\" & RelativeUrl
  133. Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location)
  134. ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
  135. '相对 PCL 本地帮助文件夹的路径
  136. Location = Path & "PCL\Help\" & RelativeUrl
  137. WorkingDir = Path & "PCL\Help\"
  138. Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location)
  139. ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
  140. '相对 PCL 自带帮助文件夹的路径
  141. Location = PathTemp & "Help\" & RelativeUrl
  142. WorkingDir = PathTemp & "Help\"
  143. Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
  144. ElseIf EventType = "打开文件" Then
  145. '直接使用原有路径启动程序
  146. Location = RelativeUrl
  147. Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
  148. Else
  149. '打开帮助,但是格式不对劲
  150. Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
  151. End If
  152. Return {Location, WorkingDir}
  153. End Function
  154. End Module