|
@@ -1,128 +1,176 @@
|
|
|
-Public Module ModEvent
|
|
|
|
|
|
|
+Imports System.Collections.ObjectModel
|
|
|
|
|
|
|
|
- Public Sub TryStartEvent(Type As String, Data As String)
|
|
|
|
|
- If String.IsNullOrWhiteSpace(Type) Then Exit Sub
|
|
|
|
|
- Dim RealData As String() = {""}
|
|
|
|
|
- If Data IsNot Nothing Then RealData = Data.Split("|")
|
|
|
|
|
- StartEvent(Type, RealData)
|
|
|
|
|
|
|
+Public Module ModEvent
|
|
|
|
|
+#Region "事件执行方法"
|
|
|
|
|
+ ''' <summary>
|
|
|
|
|
+ ''' 供外部调用的自定义事件执行接口,会在新建工作线程中运行逻辑。
|
|
|
|
|
+ ''' </summary>
|
|
|
|
|
+ ''' <param name="SingleEventType">xaml中的EventType</param>
|
|
|
|
|
+ ''' <param name="SingleEventData">xaml中的EventData</param>
|
|
|
|
|
+ ''' <param name="EventCollection">xaml中的CustomEvents</param>
|
|
|
|
|
+ Public Sub ProcessCustomEvents(SingleEventType As String, SingleEventData As String, EventCollection As CustomEventCollection)
|
|
|
|
|
+ RunInNewThread(
|
|
|
|
|
+ Sub()
|
|
|
|
|
+ Try
|
|
|
|
|
+ '先执行单个事件
|
|
|
|
|
+ StartCustomEvent(SingleEventType, SingleEventData)
|
|
|
|
|
+ '再挨个执行事件集合中的事件
|
|
|
|
|
+ If EventCollection IsNot Nothing Then
|
|
|
|
|
+ For Each AnEvent In RunInUiWait(Function() EventCollection.DeepCloneToStructureList())
|
|
|
|
|
+ StartCustomEvent(AnEvent.EventType, AnEvent.EventData)
|
|
|
|
|
+ Next
|
|
|
|
|
+ End If
|
|
|
|
|
+ Catch ex As Exception
|
|
|
|
|
+ Log(ex, "自定义事件执行器发生异常", LogLevel.Feedback)
|
|
|
|
|
+ End Try
|
|
|
|
|
+ End Sub, "CustomEventProcessor " & GetUuid())
|
|
|
End Sub
|
|
End Sub
|
|
|
- Public Sub StartEvent(Type As String, Data As String())
|
|
|
|
|
|
|
+ ''' <summary>
|
|
|
|
|
+ ''' 对当前线程阻塞地调用自定义事件处理器,接受来自 xaml 原始输入作为参数。
|
|
|
|
|
+ ''' </summary>
|
|
|
|
|
+ Private Sub StartCustomEvent(Type As String, DataRaw As String)
|
|
|
|
|
+ If String.IsNullOrEmpty(Type) Then Exit Sub
|
|
|
|
|
+ Dim Data = If(DataRaw Is Nothing, {""}, DataRaw.Split("|"))
|
|
|
|
|
+ Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", "))
|
|
|
|
|
+ '检测是否存在对应事件
|
|
|
|
|
+ If Not CustomEventProcessorsDict.ContainsKey(Type) Then
|
|
|
|
|
+ MyMsgBox($"未知的事件类型:'{Type}'{vbCrLf}请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败", ForceWait:=True)
|
|
|
|
|
+ Exit Sub
|
|
|
|
|
+ End If
|
|
|
|
|
+ '调用事件处理器
|
|
|
Try
|
|
Try
|
|
|
- Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", "))
|
|
|
|
|
- Select Case Type
|
|
|
|
|
-
|
|
|
|
|
- Case "打开网页"
|
|
|
|
|
- Data(0) = Data(0).Replace("\", "/")
|
|
|
|
|
- If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
|
|
|
|
|
- MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
|
|
|
|
|
- Exit Sub
|
|
|
|
|
- End If
|
|
|
|
|
- Hint("正在开启中,请稍候……")
|
|
|
|
|
- OpenWebsite(Data(0))
|
|
|
|
|
-
|
|
|
|
|
- Case "打开文件", "打开帮助", "执行命令"
|
|
|
|
|
- RunInThread(
|
|
|
|
|
- Sub()
|
|
|
|
|
- Try
|
|
|
|
|
- '确认实际路径
|
|
|
|
|
- Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
|
|
|
|
|
- Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
|
|
|
|
|
- Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
|
|
|
|
|
- '执行
|
|
|
|
|
- If Type = "打开帮助" Then
|
|
|
|
|
- PageOtherHelp.EnterHelpPage(Location)
|
|
|
|
|
- Else
|
|
|
|
|
- If Not Setup.Get("HintCustomCommand") Then
|
|
|
|
|
- Select Case MyMsgBox(
|
|
|
|
|
- "即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
|
|
|
|
|
- "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
|
|
|
|
|
- Case 2
|
|
|
|
|
- Setup.Set("HintCustomCommand", True)
|
|
|
|
|
- Case 3
|
|
|
|
|
- Exit Sub
|
|
|
|
|
- End Select
|
|
|
|
|
- End If
|
|
|
|
|
- Dim Info As New ProcessStartInfo With {
|
|
|
|
|
- .Arguments = If(Data.Length >= 2, Data(1), ""),
|
|
|
|
|
- .FileName = Location,
|
|
|
|
|
- .WorkingDirectory = ShortenPath(WorkingDir)
|
|
|
|
|
- }
|
|
|
|
|
- Process.Start(Info)
|
|
|
|
|
- End If
|
|
|
|
|
- Catch ex As Exception
|
|
|
|
|
- Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
|
|
|
|
|
- End Try
|
|
|
|
|
- End Sub)
|
|
|
|
|
-
|
|
|
|
|
- Case "启动游戏"
|
|
|
|
|
- If Data(0) = "\current" Then
|
|
|
|
|
- If McVersionCurrent Is Nothing Then
|
|
|
|
|
- Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
|
|
|
|
|
- Exit Sub
|
|
|
|
|
- Else
|
|
|
|
|
- Data(0) = McVersionCurrent.Name
|
|
|
|
|
- End If
|
|
|
|
|
- End If
|
|
|
|
|
- If McLaunchStart(New McLaunchOptions With
|
|
|
|
|
- {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
|
|
|
|
|
- Hint("正在启动 " & Data(0) & "……")
|
|
|
|
|
- End If
|
|
|
|
|
-
|
|
|
|
|
- Case "复制文本"
|
|
|
|
|
- ClipboardSet(Join(Data, "|"))
|
|
|
|
|
-
|
|
|
|
|
- Case "刷新主页"
|
|
|
|
|
- FrmLaunchRight.ForceRefresh()
|
|
|
|
|
- If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
|
|
|
|
|
-
|
|
|
|
|
- Case "刷新帮助"
|
|
|
|
|
- PageOtherLeft.RefreshHelp()
|
|
|
|
|
-
|
|
|
|
|
- Case "今日人品"
|
|
|
|
|
- PageOtherTest.Jrrp()
|
|
|
|
|
-
|
|
|
|
|
- Case "内存优化"
|
|
|
|
|
- RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
|
|
|
|
|
-
|
|
|
|
|
- Case "清理垃圾"
|
|
|
|
|
- RunInThread(Sub() PageOtherTest.RubbishClear())
|
|
|
|
|
-
|
|
|
|
|
- Case "弹出窗口"
|
|
|
|
|
- MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
|
|
|
|
|
-
|
|
|
|
|
- Case "切换页面"
|
|
|
|
|
- FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
|
|
|
|
|
-
|
|
|
|
|
- Case "导入整合包", "安装整合包"
|
|
|
|
|
- RunInUi(Sub() ModpackInstall())
|
|
|
|
|
-
|
|
|
|
|
- Case "下载文件"
|
|
|
|
|
- Data(0) = Data(0).Replace("\", "/")
|
|
|
|
|
- If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
|
|
|
|
|
- MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
|
|
|
|
|
- Exit Sub
|
|
|
|
|
- End If
|
|
|
|
|
- Try
|
|
|
|
|
- Select Case Data.Length
|
|
|
|
|
- Case 1
|
|
|
|
|
- PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
|
|
|
|
|
- Case 2
|
|
|
|
|
- PageOtherTest.StartCustomDownload(Data(0), Data(1))
|
|
|
|
|
- Case Else
|
|
|
|
|
- PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
|
|
|
|
|
- End Select
|
|
|
|
|
- Catch
|
|
|
|
|
- PageOtherTest.StartCustomDownload(Data(0), "未知")
|
|
|
|
|
- End Try
|
|
|
|
|
-
|
|
|
|
|
- Case Else
|
|
|
|
|
- MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
|
|
|
|
|
- End Select
|
|
|
|
|
|
|
+ CustomEventProcessorsDict(Type)(Data)
|
|
|
Catch ex As Exception
|
|
Catch ex As Exception
|
|
|
- Log(ex, "事件执行失败", LogLevel.Msgbox)
|
|
|
|
|
|
|
+ Log(ex, $"自定义事件执行失败:{Type}", LogLevel.Msgbox, "自定义主页事件执行失败")
|
|
|
End Try
|
|
End Try
|
|
|
End Sub
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
+ ''' <summary>
|
|
|
|
|
+ ''' 存储各个自定义事件处理器的字典,以 EventType 为键,执行自定义事件时在工作线程中调用 Action 并传入分割后的 EventData 。
|
|
|
|
|
+ ''' Action 应当在事件逻辑结束后,即可以开始下一个事件时再结束;以便于挨个调用事件不打架。
|
|
|
|
|
+ ''' </summary>
|
|
|
|
|
+ Private ReadOnly CustomEventProcessorsDict As New Dictionary(Of String, Action(Of String())) From {
|
|
|
|
|
+ {"打开网页",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ Data(0) = Data(0).Replace("\", "/")
|
|
|
|
|
+ If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
|
|
|
|
|
+ MyMsgBox("打开网页事件中,EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
|
|
|
|
|
+ Exit Sub
|
|
|
|
|
+ End If
|
|
|
|
|
+ Hint("网页正在开启中,请稍候……")
|
|
|
|
|
+ OpenWebsite(Data(0))
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"打开文件",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "打开文件")
|
|
|
|
|
+ Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
|
|
|
|
|
+ Log($"[Control] 打开文件:路径:{Location},工作目录:{WorkingDir}")
|
|
|
|
|
+ If Not CommandRunUserConfirm(If(Data.Length < 2, Location, $"{Location} {Data(1)}")) Then Exit Sub
|
|
|
|
|
+ Dim Info As New ProcessStartInfo With {
|
|
|
|
|
+ .Arguments = If(Data.Length < 2, "", Data(1)),
|
|
|
|
|
+ .FileName = Location,
|
|
|
|
|
+ .WorkingDirectory = ShortenPath(WorkingDir)
|
|
|
|
|
+ }
|
|
|
|
|
+ Process.Start(Info)
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"打开帮助",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "打开帮助")
|
|
|
|
|
+ Dim Location = ActualPaths(0)
|
|
|
|
|
+ Log($"[Control] 打开帮助:{Location}")
|
|
|
|
|
+ PageOtherHelp.EnterHelpPage(Location)
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"执行命令",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "执行命令")
|
|
|
|
|
+ Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
|
|
|
|
|
+ Log($"[Control] 执行命令:路径:{Location},工作目录:{WorkingDir}")
|
|
|
|
|
+ If Not CommandRunUserConfirm(If(Data.Length < 2, Location, $"{Location} {Data(1)}")) Then Exit Sub
|
|
|
|
|
+ Dim Info As New ProcessStartInfo With {
|
|
|
|
|
+ .Arguments = If(Data.Length < 2, "", Data(1)),
|
|
|
|
|
+ .FileName = Location,
|
|
|
|
|
+ .WorkingDirectory = ShortenPath(WorkingDir)
|
|
|
|
|
+ }
|
|
|
|
|
+ Process.Start(Info)
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"启动游戏",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ If Data(0) = "\current" Then
|
|
|
|
|
+ If McVersionCurrent Is Nothing Then
|
|
|
|
|
+ Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
|
|
|
|
|
+ Exit Sub
|
|
|
|
|
+ Else
|
|
|
|
|
+ Data(0) = McVersionCurrent.Name
|
|
|
|
|
+ End If
|
|
|
|
|
+ End If
|
|
|
|
|
+ RunInUiWait(
|
|
|
|
|
+ Sub()
|
|
|
|
|
+ If McLaunchStart(New McLaunchOptions With {.Version = New McVersion(Data(0)), .ServerIp = If(Data.Length >= 2, Data(1), Nothing)}) Then
|
|
|
|
|
+ Hint("正在启动 " & Data(0) & "……")
|
|
|
|
|
+ End If
|
|
|
|
|
+ End Sub)
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"复制文本", Sub(Data As String()) ClipboardSet(Join(Data, "|"))},
|
|
|
|
|
+ {"刷新主页",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ RunInUiWait(Sub() FrmLaunchRight.ForceRefresh())
|
|
|
|
|
+ If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"刷新帮助", Sub() RunInUi(Sub() PageOtherLeft.RefreshHelp())},
|
|
|
|
|
+ {"今日人品", Sub() PageOtherTest.Jrrp()},
|
|
|
|
|
+ {"内存优化",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ If Data.Length >= 1 AndAlso Data(0) = "前台运行" Then
|
|
|
|
|
+ PageOtherTest.MemoryOptimize(Data.Length >= 2 AndAlso Data(1) = "显示提示")
|
|
|
|
|
+ Else
|
|
|
|
|
+ RunInNewThread(Sub() PageOtherTest.MemoryOptimize(True))
|
|
|
|
|
+ End If
|
|
|
|
|
+ End Sub},
|
|
|
|
|
+ {"弹出窗口", Sub(Data As String()) MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf), ForceWait:=True)},
|
|
|
|
|
+ {"切换页面", Sub(Data As String()) RunInUiWait(Sub() FrmMain.PageChange(Val(Data(0)), Val(Data(1))))},
|
|
|
|
|
+ {"安装整合包", Sub() RunInUiWait(Sub() ModpackInstall())},
|
|
|
|
|
+ {"导入整合包", Sub() RunInUiWait(Sub() ModpackInstall())},
|
|
|
|
|
+ {"下载文件",
|
|
|
|
|
+ Sub(Data As String())
|
|
|
|
|
+ Data(0) = Data(0).Replace("\", "/")
|
|
|
|
|
+ If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
|
|
|
|
|
+ MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
|
|
|
|
|
+ Exit Sub
|
|
|
|
|
+ End If
|
|
|
|
|
+ Try
|
|
|
|
|
+ Select Case Data.Length
|
|
|
|
|
+ Case 1
|
|
|
|
|
+ PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
|
|
|
|
|
+ Case 2
|
|
|
|
|
+ PageOtherTest.StartCustomDownload(Data(0), Data(1))
|
|
|
|
|
+ Case Else
|
|
|
|
|
+ PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
|
|
|
|
|
+ End Select
|
|
|
|
|
+ Catch
|
|
|
|
|
+ PageOtherTest.StartCustomDownload(Data(0), "未知")
|
|
|
|
|
+ End Try
|
|
|
|
|
+ End Sub}
|
|
|
|
|
+ }
|
|
|
|
|
+
|
|
|
|
|
+#End Region
|
|
|
|
|
+#Region "工具方法"
|
|
|
|
|
+ ''' <summary>
|
|
|
|
|
+ ''' 弹窗询问用户是否同意继续执行打开类事件。
|
|
|
|
|
+ ''' </summary>
|
|
|
|
|
+ Private Function CommandRunUserConfirm(TextShowToUser As String) As Boolean
|
|
|
|
|
+ If Setup.Get("HintCustomCommand") Then Return True
|
|
|
|
|
+ Select Case MyMsgBox("即将执行:" & TextShowToUser & vbCrLf & "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
|
|
|
|
|
+ Case 1
|
|
|
|
|
+ Return True
|
|
|
|
|
+ Case 2
|
|
|
|
|
+ Setup.Set("HintCustomCommand", True)
|
|
|
|
|
+ Return True
|
|
|
|
|
+ Case Else '3
|
|
|
|
|
+ Log("[Control] 用户取消了打开类事件")
|
|
|
|
|
+ Return False
|
|
|
|
|
+ End Select
|
|
|
|
|
+ End Function
|
|
|
|
|
+
|
|
|
''' <summary>
|
|
''' <summary>
|
|
|
''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
|
|
''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
|
|
|
''' 失败会抛出异常。
|
|
''' 失败会抛出异常。
|
|
@@ -195,4 +243,42 @@
|
|
|
Return {Location, WorkingDir}
|
|
Return {Location, WorkingDir}
|
|
|
End Function
|
|
End Function
|
|
|
|
|
|
|
|
|
|
+#End Region
|
|
|
End Module
|
|
End Module
|
|
|
|
|
+#Region "数据结构类声明"
|
|
|
|
|
+Public Class CustomEventCollection
|
|
|
|
|
+ Inherits ObservableCollection(Of CustomEvent)
|
|
|
|
|
+ Public Function DeepCloneToStructureList() As IList(Of CustomEventStructure)
|
|
|
|
|
+ DeepCloneToStructureList = New List(Of CustomEventStructure)
|
|
|
|
|
+ For Each AnEvent In Me
|
|
|
|
|
+ DeepCloneToStructureList.Add(New CustomEventStructure With {.EventType = AnEvent.EventType, .EventData = AnEvent.EventData})
|
|
|
|
|
+ Next
|
|
|
|
|
+ End Function
|
|
|
|
|
+End Class
|
|
|
|
|
+Public Class CustomEvent
|
|
|
|
|
+ Inherits DependencyObject
|
|
|
|
|
+ Public Property EventType As String
|
|
|
|
|
+ Get
|
|
|
|
|
+ Return GetValue(EventTypeProperty)
|
|
|
|
|
+ End Get
|
|
|
|
|
+ Set(value As String)
|
|
|
|
|
+ SetValue(EventTypeProperty, value)
|
|
|
|
|
+ End Set
|
|
|
|
|
+ End Property
|
|
|
|
|
+ Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
|
|
|
|
|
+ Public Property EventData As String
|
|
|
|
|
+ Get
|
|
|
|
|
+ Return GetValue(EventDataProperty)
|
|
|
|
|
+ End Get
|
|
|
|
|
+ Set(value As String)
|
|
|
|
|
+ SetValue(EventDataProperty, value)
|
|
|
|
|
+ End Set
|
|
|
|
|
+ End Property
|
|
|
|
|
+ Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
|
|
|
|
|
+End Class
|
|
|
|
|
+Public Structure CustomEventStructure
|
|
|
|
|
+ Public EventType As String
|
|
|
|
|
+ Public EventData As String
|
|
|
|
|
+End Structure
|
|
|
|
|
+
|
|
|
|
|
+#End Region
|