ModEvent.vb 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  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. If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
  43. Hint("正在启动 " & Data(0) & "……")
  44. End If
  45. Case "复制文本"
  46. ClipboardSet(Join(Data, "|"))
  47. Case "刷新主页"
  48. FrmLaunchRight.ForceRefresh()
  49. Case "刷新帮助"
  50. PageOtherLeft.RefreshHelp()
  51. Case "弹出窗口"
  52. MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
  53. Case "下载文件"
  54. Data(0) = Data(0).Replace("\", "/")
  55. If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
  56. MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的协议。", "事件执行失败")
  57. Exit Sub
  58. End If
  59. PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
  60. Case Else
  61. MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
  62. End Select
  63. Catch ex As Exception
  64. Log(ex, "事件执行失败", LogLevel.Msgbox)
  65. End Try
  66. End Sub
  67. ''' <summary>
  68. ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
  69. ''' 失败会抛出异常。
  70. ''' </summary>
  71. Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
  72. '网页确认
  73. If RelativeUrl.ToLower.StartsWith("http") Then
  74. If RunInUi() Then
  75. Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
  76. "因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
  77. End If
  78. '获取文件名
  79. Dim RawFileName As String
  80. Try
  81. RawFileName = GetFileNameFromPath(RelativeUrl)
  82. If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
  83. Catch ex As Exception
  84. Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  85. "例如:" & vbCrLf &
  86. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  87. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  88. End Try
  89. '下载文件
  90. Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName
  91. Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
  92. Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp1)
  93. Hint("正在获取资源,请稍候……")
  94. Try
  95. NetDownload(RelativeUrl, LocalTemp1)
  96. NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
  97. Catch ex As Exception
  98. Throw New Exception("下载指定的文件失败!" & vbCrLf &
  99. "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
  100. "例如:" & vbCrLf &
  101. " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
  102. " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
  103. End Try
  104. RelativeUrl = LocalTemp1
  105. End If
  106. RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
  107. '确认实际路径
  108. Dim Location As String, WorkingDir As String = Path & "PCL"
  109. HelpTryExtract()
  110. If RelativeUrl.Contains(":\") Then
  111. '绝对路径
  112. Location = RelativeUrl
  113. Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location)
  114. ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
  115. '相对 PCL 文件夹的路径
  116. Location = Path & "PCL\" & RelativeUrl
  117. Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location)
  118. ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
  119. '相对 PCL 本地帮助文件夹的路径
  120. Location = Path & "PCL\Help\" & RelativeUrl
  121. WorkingDir = Path & "PCL\Help\"
  122. Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location)
  123. ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
  124. '相对 PCL 自带帮助文件夹的路径
  125. Location = PathTemp & "Help\" & RelativeUrl
  126. WorkingDir = PathTemp & "Help\"
  127. Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
  128. ElseIf EventType = "打开文件" Then
  129. '直接使用原有路径启动程序
  130. Location = RelativeUrl
  131. Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
  132. Else
  133. '打开帮助,但是格式不对劲
  134. Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
  135. End If
  136. Return {Location, WorkingDir}
  137. End Function
  138. End Module