Compare commits

..
20 Commits
Author SHA1 Message Date
龙腾猫跃 efd480f06c 2.11.1 2025-11-01 11:51:54 +08:00
龙腾猫跃 a067271995 Merge pull request #7398 from PCL-Community/#7375
fix(validate): 没有判断前导零
2025-10-30 22:18:22 +08:00
龙腾猫跃 f85361d009 Merge pull request #7396 from PCL-Community/#7353
fix(cape): 家园披风没有被正常翻译
2025-10-30 22:15:01 +08:00
wyc-26 4a5cc3f95b fix(validate): 没有判断前导零 2025-10-30 22:01:08 +08:00
wyc-26 4c0f525cf3 fix(cape): 家园披风没有被正常翻译 2025-10-30 21:28:32 +08:00
龙腾猫跃 8d2eb85aec 2.11.0 2025-10-24 22:39:55 +08:00
龙腾猫跃 e5dccf3a13 Merge pull request #7339 from MoYuan-CN/main
允许通过 UrlScheme 打开 Preview 基岩版
2025-10-24 05:18:50 +08:00
墨渊 8ba86ffed8 Allow Preview 2025-10-21 16:15:16 +08:00
龙腾猫跃 76f4e761b1 Merge pull request #7318 from Light-Beacon/main
feat(ModMain): varible 替换标记支持设置默认值
2025-10-20 19:53:54 +08:00
龙腾猫跃 e503a39baf Merge pull request #7323 from ruollin/feat/copper-cape
feat(cape): 添加 Copper (铜披风)的中文译名
2025-10-20 19:49:29 +08:00
若琳酱 5ed4a9bbbf feat(cape): 添加 Copper (铜披风)的中文译名
Resolve https://github.com/Meloong-Git/PCL/issues/7322
2025-10-16 13:24:48 +08:00
Nattiden 382deaa197 feat(ModMain): varible 替换标记支持设置默认值 2025-10-15 14:13:27 +08:00
龙腾猫跃 00966bec6a 2.10.9 正式版 2025-10-08 18:43:40 +08:00
龙腾猫跃 a41579b1da 2.10.9 2025-10-07 04:57:14 +08:00
龙腾猫跃 86ed0e9ae0 Merge pull request #5862 from Open-KFC/feat5684
Feat:支持一个按钮运行多个自定义事件
2025-10-06 01:19:23 +08:00
龙腾猫跃 ab697054c8 Merge branch 'main' into feat5684 2025-10-06 01:14:23 +08:00
龙腾猫跃 0ba2fd1edb Merge pull request #7190 from LuoYun-Team/revert-6216-dialog
Revert(dialog): 撤销更改
2025-10-04 23:43:25 +08:00
龙腾猫跃 49984a2913 2.10.8 正式版 2025-09-13 19:22:29 +08:00
薄奚梦灵 08e5e64ca4 Revert "fix:文件删除没有无法放入回收站的提示" 2025-09-09 22:09:35 +08:00
Open-KFC cd736be212 feat(ModEvent): 支持一个按钮执行多个事件
没给 HelpEntry 加这个功能,其他控件都加了
2025-04-07 07:01:54 +08:00
93 changed files with 3143 additions and 2707 deletions

No files matched your search

+4 -4
View File
@@ -78,7 +78,6 @@ Public Class Application
End If
End Try
Directory.CreateDirectory(PathTemp & "Cache")
Directory.CreateDirectory(PathTemp & "Download")
Directory.CreateDirectory(PathAppdata)
'检测单例
#If Not DEBUG Then
@@ -124,16 +123,17 @@ WaitRetry:
'添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
#If RELEASE Then
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",正式版", "")}")
Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",正式版", "")}")
#Else
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
#End If
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "尚未解压", "我知道了", IsWarn:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
@@ -13,3 +13,11 @@ End Interface
Public Interface IDispatcherUnhandledException
Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
End Interface
''' <summary>
''' 指示该控件是可勾选的。
''' </summary>
Public Interface IMyRadio
Event Check(sender As Object, e As RouteEventArgs)
Event Changed(sender As Object, e As RouteEventArgs)
End Interface
@@ -1,4 +0,0 @@
Public Interface IMyRadio
Event Check(sender As Object, e As RouteEventArgs)
Event Changed(sender As Object, e As RouteEventArgs)
End Interface
@@ -140,39 +140,14 @@ Public Class MyButton
End Try
End Sub
'实现自定义事件
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
End If
ModEvent.TryStartEvent(EventType, EventData)
RaiseCustomEvent() '自定义事件
End Sub
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(MyButton), 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(MyButton), New PropertyMetadata(Nothing))
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
Focus()
+22 -15
View File
@@ -132,7 +132,9 @@
For Each Data As Object In Stack.Tag
Select Case Type
Case 0
Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
Dim VersionItem As MyListItem = CType(Data, McVersion).ToListItem
VersionItem.ContentHandler = AddressOf PageSelectRight.McVersionListContent
Stack.Children.Add(VersionItem)
Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3
@@ -309,9 +311,6 @@
End Set
End Property
Private _IsSwapped As Boolean = False
''' <summary>
''' 是否已被折叠。(已过时,请使用 IsSwapped)
''' </summary>
<Obsolete("IsSwaped 存在拼写错误,请换用 IsSwapped 属性。")>
Public Property IsSwaped As Boolean
Get
@@ -325,37 +324,45 @@
Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
Public Property SwapLogoRight As Boolean = False
Private IsMouseDown As Boolean = False
Private IsSwapMouseDown As Boolean = False '用于触发卡片展开/折叠的 MouseDown
Private IsCustomMouseDown As Boolean = False '用于触发自定义事件的 MouseDown
Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
Public Event Swap(sender As Object, e As RouteEventArgs)
Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwapped AndAlso
(Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return
IsCustomMouseDown = True
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True
IsSwapMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
IsMouseDown = False
Private Sub MyCard_MouseLeftButtonUp() Handles Me.MouseLeftButtonUp
If Not IsCustomMouseDown Then Return
IsCustomMouseDown = False
RaiseCustomEvent() '触发自定义事件
If Not IsSwapMouseDown Then Return
IsSwapMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
If ee.Handled Then
IsMouseDown = False
Dim e = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, e)
If e.Handled Then
IsSwapMouseDown = False
Return
End If
IsSwapped = Not IsSwapped
Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
RaiseEvent Swap(Me, e)
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsMouseDown = False
IsSwapMouseDown = False
End Sub
#End Region
@@ -12,9 +12,6 @@ Public Class MyCheckBox
''' <param name="user">是否为用户手动改变的勾选状态。</param>
Public Event Change(sender As Object, user As Boolean)
Public Event PreviewChange(sender As Object, e As RouteEventArgs)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序引发本控件的 Change 事件
'自定义属性
Public Property Checked As Boolean
@@ -59,6 +56,7 @@ Public Class MyCheckBox
'更改动画
SyncUI()
RaiseCustomEvent()
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
+12 -9
View File
@@ -117,15 +117,14 @@
Private IsTextChanging As Boolean = False
Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
If IsTextChanging OrElse Not IsEditable Then Return
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
IsTextChanging = True
SelectedItem = Nothing
Text = RawText
TextBox.SelectionStart = RawSelectionStart
IsTextChanging = False
End If
If SelectedItem Is Nothing OrElse Text = SelectedItem.ToString Then Return
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
IsTextChanging = True
SelectedItem = Nothing
Text = RawText
TextBox.SelectionStart = RawSelectionStart
IsTextChanging = False
End Sub
Public ReadOnly Property ContentPresenter As ContentPresenter
@@ -134,4 +133,8 @@
End Get
End Property
Private Sub MyComboBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles Me.SelectionChanged
If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent()
End Sub
End Class
@@ -53,25 +53,26 @@
Set(value As Boolean)
If _Show = value Then Return
_Show = value
RunInUi(Sub()
If value Then
'有了
Visibility = Visibility.Visible
AniStart({
AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)),
AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)),
AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyExtraButton MainScale " & Uuid)
Else
'没了
AniStart({
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)),
AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()),
AaCode(Sub() Visibility = Visibility.Collapsed,, True)
}, "MyExtraButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
RunInUi(
Sub()
If value Then
'有了
Visibility = Visibility.Visible
AniStart({
AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)),
AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)),
AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyExtraButton MainScale " & Uuid)
Else
'没了
AniStart({
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)),
AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()),
AaCode(Sub() Visibility = Visibility.Collapsed,, True)
}, "MyExtraButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
End Set
End Property
Public Delegate Function ShowCheckDelegate() As Boolean
@@ -137,6 +138,7 @@
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
End If
If IsLeftMouseHeld Then RaiseCustomEvent()
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
@@ -199,16 +201,17 @@
''' 发出一圈波浪效果提示。
''' </summary>
Public Sub Ribble()
RunInUi(Sub()
Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
PanScale.Children.Insert(0, Shape)
AniStart({
AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)),
AaOpacity(Shape, -Shape.Opacity, 1000),
AaCode(Sub() PanScale.Children.Remove(Shape), After:=True)
}, "ExtraButton Ribble " & GetUuid())
End Sub)
RunInUi(
Sub()
Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
PanScale.Children.Insert(0, Shape)
AniStart({
AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)),
AaOpacity(Shape, -Shape.Opacity, 1000),
AaCode(Sub() PanScale.Children.Remove(Shape), After:=True)
}, "ExtraButton Ribble " & GetUuid())
End Sub)
End Sub
End Class
@@ -81,12 +81,12 @@ Public Class MyExtraTextButton
'触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then
Log("[Control] 按下附加图标按钮:" & Text)
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
End If
If Not IsLeftMouseHeld Then Return
Log("[Control] 按下附加图标按钮:" & Text)
RaiseEvent Click(sender, e)
e.Handled = True
RaiseCustomEvent()
Button_LeftMouseUp()
End Sub
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
+1 -19
View File
@@ -113,7 +113,7 @@ Public Class MyHint
IsMouseDown = False
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
e.Handled = True
ModEvent.TryStartEvent(EventType, EventData)
RaiseCustomEvent() '自定义事件
End Sub
Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
@@ -121,24 +121,6 @@ Public Class MyHint
Private Sub MyHint_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
End Sub
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(MyHint), 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(MyHint), New PropertyMetadata(Nothing))
End Class
Partial Public Module ModAnimation
@@ -48,36 +48,16 @@
End Set
End Property
'触发点击事件
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
ModEvent.TryStartEvent(EventType, EventData)
RaiseCustomEvent() '自定义事件
End Sub
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(MyIconButton), 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(MyIconButton), New PropertyMetadata(Nothing))
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
Focus()
@@ -102,7 +82,6 @@
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
@@ -8,9 +8,6 @@ Public Class MyIconTextButton
Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性
@@ -76,7 +73,7 @@ Public Class MyIconTextButton
Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
ModEvent.TryStartEvent(EventType, EventData)
RaiseCustomEvent() '自定义事件
RefreshColor()
End Sub
Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
@@ -87,24 +84,6 @@ Public Class MyIconTextButton
IsMouseDown = False
RefreshColor()
End Sub
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(MyIconTextButton), 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(MyIconTextButton), New PropertyMetadata(Nothing))
'动画
+16 -3
View File
@@ -46,7 +46,7 @@
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary>
''' 若 Source 是一个网络图片,该地址将作为第二下载源。
''' 若 Source 是一个网络图片,该地址将作为第二图片源。
''' </summary>
Public Property FallbackSource As String
Get
@@ -120,11 +120,12 @@
End If
RunInNewThread(
Sub()
Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
Try
'下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
If(String.IsNullOrEmpty(FallbackSource), {Source}, {Source, FallbackSource}),
If(FallbackSource?.StartsWithF("http"), {Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then
'保存缓存并显示
@@ -139,7 +140,19 @@
If TempPath IsNot Nothing Then File.Delete(TempPath)
Catch
End Try
Log(ex, $"下载图片失败", LogLevel.Hint)
'加载本地备用图片
If IsLocalFallback Then
Try
RunInUiWait(Sub() ActualSource = FallbackSource)
Log(ex, $"下载图片失败,使用本地备用图片({Source})")
Return
Catch exx As Exception
Log(ex, $"下载图片失败({Source})", LogLevel.Hint)
Log(exx, $"加载备用图片失败({FallbackSource})", LogLevel.Hint)
End Try
Else
Log(ex, $"下载图片失败({Source},备用:{FallbackSource})", LogLevel.Hint)
End If
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
@@ -506,8 +506,8 @@ Public Class MyListItem
RaiseEvent Click(sender, e)
If e.Handled Then Return
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData)
If CustomEventService.GetEventType(sender) <> CustomEvent.EventType.None Then
RaiseCustomEvent()
e.Handled = True
End If
If e.Handled Then Return
@@ -537,26 +537,6 @@ Public Class MyListItem
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'实现自定义事件
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(MyListItem), 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(MyListItem), New PropertyMetadata(Nothing))
#End Region
Private StateLast As String
@@ -657,13 +637,14 @@ Public Class MyListItem
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
If CustomEventService.GetEventType(Me) = CustomEvent.EventType.打开帮助 AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
Try
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
Entry.SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
EventType = Nothing
EventData = Nothing
CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
CustomEventService.SetEventData(Me, "")
End Try
End If
End Sub
@@ -183,30 +183,29 @@ Public Class MyLoading
IsLooping = True
ErrorAnimationWaiting = True
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
PathRight.Margin = New Thickness(14, 41, 0, 0)
ErrorAnimationWaiting = False
End Sub),
AaOpacity(PathLeft, -1, 100, 50),
AaX(PathLeft, -5, 180,, New AniEaseOutFluent),
AaY(PathLeft, -6, 180,, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 50),
AaX(PathRight, 5, 180,, New AniEaseOutFluent),
AaY(PathRight, -6, 180,, New AniEaseOutFluent),
AaCode(Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
If ShowProgress Then
End If
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(
Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
PathRight.Margin = New Thickness(14, 41, 0, 0)
ErrorAnimationWaiting = False
End Sub),
AaOpacity(PathLeft, -1, 100, 50),
AaX(PathLeft, -5, 180,, New AniEaseOutFluent),
AaY(PathLeft, -6, 180,, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 50),
AaX(PathRight, 5, 180,, New AniEaseOutFluent),
AaY(PathRight, -6, 180,, New AniEaseOutFluent),
AaCode(
Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
End Sub
''' <summary>
@@ -54,4 +54,7 @@
End If
End Sub
Private Sub MyMenuItem_Click(sender As Object, e As RoutedEventArgs) Handles Me.Click
RaiseCustomEvent()
End Sub
End Class
@@ -130,7 +130,7 @@
Select Case PageState
Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then
'如果加载器在进入页面时不启动(例如 HiPer 联机),那么在此时就会有 State = Waiting
'如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting
PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
@@ -152,7 +152,8 @@
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanLoader)
End If
Case PageStates.ContentEnter '重复调用 PageOnEnter,直接忽略
Case PageStates.ContentEnter
'重复调用 PageOnEnter,直接忽略
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
End Select
@@ -207,8 +208,8 @@
Public Sub PageOnContentExit()
If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
'Loading 的加载器可能触发进一步变化,难以预测会触发子页面的动画还是加载器完成的动画
Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
End If
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
@@ -219,8 +220,12 @@
Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay
PageState = PageStates.ContentExit
TriggerExitAnimation(PanLoader)
Case PageStates.LoaderWait, PageStates.Empty
Case PageStates.LoaderWait
PageOnEnter()
Case PageStates.Empty
'可能是在离开页面后,其他后台线程调用了本函数,此时不应触发 PageOnEnter()
'例如:在加入联机房间后,切换到其他页面,然后联机房间被解散
If IsLoaded Then PageOnEnter()
End Select
End Sub
@@ -89,14 +89,15 @@ Public Class MyRadioBox
End If
End Select
'触发事件
If IsChanged Then
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
RaiseCustomEvent()
'更改动画
SyncUI()
End If
'更改动画
SyncUI()
Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try
@@ -7,10 +7,6 @@ Public Class MyRadioButton
Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性
@@ -46,23 +42,22 @@ Public Class MyRadioButton
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="raiseByMouse">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Public Sub SetChecked(value As Boolean, raiseByMouse As Boolean, anime As Boolean)
Try
'自定义属性基础
Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent Change(Me, user)
If Not value = _Checked Then
If _Checked <> value Then
_Checked = value
IsChanged = True
End If
'保证只有一个单选框选中
If IsNothing(Parent) Then Return
If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -105,7 +100,8 @@ Public Class MyRadioButton
RefreshColor(Nothing, anime)
'触发事件
If Checked Then RaiseEvent Check(Me, user)
If Checked Then RaiseEvent Check(Me, raiseByMouse)
RaiseCustomEvent()
Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
@@ -39,4 +39,7 @@
TextBox.Focus()
End Sub
Private Sub MySearchBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
If e.Key = Key.Enter Then RaiseCustomEvent()
End Sub
End Class
@@ -291,4 +291,8 @@
End If
End Sub
'在按下回车时触发自定义事件
Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
If e.Key = Key.Enter Then RaiseCustomEvent()
End Sub
End Class
+15 -38
View File
@@ -22,15 +22,15 @@
End Set
End Property
Public Shared ReadOnly TextProperty As DependencyProperty =
DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("", Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
If Not e.OldValue = e.NewValue Then
AniStart({
AaOpacity(sender, -sender.Opacity, 50),
AaCode(Sub() sender.Content = e.NewValue,, True),
AaOpacity(sender, 1, 170)
}, "MyTextButton Text " & sender.Uuid)
End If
End Sub))
DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("",
Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
If e.OldValue = e.NewValue Then Return
AniStart({
AaOpacity(sender, -sender.Opacity, 50),
AaCode(Sub() sender.Content = e.NewValue,, True),
AaOpacity(sender, 1, 170)
}, "MyTextButton Text " & sender.Uuid)
End Sub))
'鼠标事件
@@ -43,13 +43,12 @@
IsMouseDown = False
End Sub
Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
IsMouseDown = False
Log("[Control] 按下文本按钮:" & Text)
RaiseEvent Click(Me, Nothing)
ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True
End If
If Not IsMouseDown Then Return
IsMouseDown = False
Log("[Control] 按下文本按钮:" & Text)
RaiseEvent Click(Me, Nothing)
RaiseCustomEvent()
e.Handled = True
End Sub
'指向动画
@@ -85,26 +84,4 @@
End If
End Sub
'实现自定义事件
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(MyTextButton), 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(MyTextButton), New PropertyMetadata(Nothing))
End Class
+91 -40
View File
@@ -11,6 +11,15 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 372 Then 'Release 2.10.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:如果版本设置了自定义描述,会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:支持为一个控件设置多个自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:修改变量、弹出提示自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:添加大量替换标记,允许在更多设置和 XAML 中使用更多替换标记"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 MMC 整合包"))
FeatureCount += 33
BugCount += 11
End If
If LastVersion < 369 Then 'Release 2.10.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许在版本设置中设置禁止更新 Mod,以防整合包玩家误操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:网络与下载稳定性优化"))
@@ -104,6 +113,31 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 374 Then 'Snapshot 2.11.1
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:使用离线登录也可以直接加入联机房间了"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:会从所有共享节点中自动选择负载最低的进行中继连接"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若复制了邀请码,则可以直接快速加入房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点"))
End If
FeatureCount += 9
BugCount += 7
End If
If LastVersion < 373 Then 'Snapshot 2.11.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
FeatureCount += 7
BugCount += 10
End If
If LastVersion < 371 Then 'Snapshot 2.10.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:如果版本设置了自定义描述,会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:支持为一个控件设置多个自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:修改变量、弹出提示自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:添加大量替换标记,允许在更多设置和 XAML 中使用更多替换标记"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 MMC 整合包"))
FeatureCount += 33
BugCount += 11
End If
If LastVersion < 370 Then 'Snapshot 2.10.8
If LastVersion >= 368 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:网络与下载稳定性优化"))
FeatureCount += 3
@@ -318,7 +352,7 @@ Public Class FormMain
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
'模式提醒
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Red)
#End If
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会导致性能下降,若无必要请不要开启!")
'尽早执行的加载池
@@ -398,11 +432,16 @@ Public Class FormMain
RunInNewThread(
Sub()
'EULA 提示
If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Const EulaVersion As Integer = 2
If Setup.Get("SystemEulaVersion") < EulaVersion Then
Select Case MyMsgBox(
If(Setup.Get("SystemEulaVersion") = 0,
"在使用 PCL 前,请先阅读用户协议与免责声明。",
$"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"),
"协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1
Setup.Set("SystemEula", True)
Setup.Set("SystemEulaVersion", EulaVersion)
Case 2
EndProgram(False)
End Select
@@ -467,6 +506,8 @@ Public Class FormMain
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If
#End If
'迁移 EULA 版本
If Setup.Get("SystemEula") AndAlso Setup.Get("SystemEulaVersion") = 0 Then Setup.Set("SystemEulaVersion", 1)
'被移除的窗口设置选项
If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
@@ -545,21 +586,19 @@ Public Class FormMain
''' </summary>
''' <param name="SendWarning">是否在还有下载任务未完成时发出警告。</param>
Public Sub EndProgram(SendWarning As Boolean)
'发出警告
If SendWarning AndAlso HasDownloadingTask() Then
If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then
'强行结束下载任务
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort()
Next
End Sub, "强行停止下载任务")
Else
Return
End If
'强行结束下载任务?
If HasDownloadingTask() Then
If SendWarning AndAlso MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 2 Then Return
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort()
Next
End Sub, "强行停止下载任务")
End If
'关闭联机?
If FrmLinkMain?.TryExit(Not SendWarning, True) Then Return
'关闭
RunInUiWait(
Sub()
@@ -687,9 +726,9 @@ Public Class FormMain
If e.Key = Key.F12 Then
PageSetupUI.HiddenForceShow = Not PageSetupUI.HiddenForceShow
If PageSetupUI.HiddenForceShow Then
Hint("功能隐藏设置已暂时关闭!", HintType.Finish)
Hint("功能隐藏设置已暂时关闭!", HintType.Green)
Else
Hint("功能隐藏设置已重新开启!", HintType.Finish)
Hint("功能隐藏设置已重新开启!", HintType.Green)
End If
PageSetupUI.HiddenRefresh()
Return
@@ -735,6 +774,21 @@ Public Class FormMain
Catch ex As Exception
Log(ex, "切回窗口时出错", LogLevel.Feedback)
End Try
'读取剪贴板,自动加入联机房间
If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本
If Setup.Get("LinkLastAutoJoinInviteCode") = Code Then Return
If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码
Setup.Set("LinkLastAutoJoinInviteCode", Code)
RunInThread(
Sub()
If MyMsgBox("嘿,是否使用复制的邀请码加入房间?", "加入联机房间", "加入", "取消") = 2 Then Return '防止弹窗阻碍主线程,所以必须放在工作线程
RunInUi(
Sub()
PageLinkMain.Join(Code)
ClipboardSet(Nothing, False)
End Sub)
End Sub)
End Sub
'文件拖放
@@ -785,12 +839,12 @@ Public Class FormMain
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Log("[System] Authlib 拖拽:" & AuthlibServer)
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Critical)
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red)
Return
End If
Dim TargetVersion = If(PageCurrent = PageType.VersionSetup, PageVersionLeft.Version, McVersionCurrent)
If TargetVersion Is Nothing Then
Hint("请先下载游戏,再设置第三方登录!", HintType.Critical)
Hint("请先下载游戏,再设置第三方登录!", HintType.Red)
Return
End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
@@ -837,7 +891,7 @@ Public Class FormMain
'获取文件并检查
Dim FilePathRaw = e.Data.GetData(DataFormats.FileDrop)
If FilePathRaw Is Nothing Then '#2690
Hint("请将文件解压后再拖入!", HintType.Critical)
Hint("请将文件解压后再拖入!", HintType.Red)
Return
End If
e.Handled = True
@@ -855,10 +909,10 @@ Public Class FormMain
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Hint("请拖入一个文件,而非文件夹!", HintType.Red)
Return
ElseIf Not File.Exists(FilePathList.First) Then
Hint("拖入的文件不存在:" & FilePathList.First, HintType.Critical)
Hint("拖入的文件不存在:" & FilePathList.First, HintType.Red)
Return
End If
'多文件拖拽
@@ -866,7 +920,7 @@ Public Class FormMain
'必须要求全部为 jar 文件
For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Hint("一次请只拖入一个文件!", HintType.Red)
Return
End If
Next
@@ -885,7 +939,7 @@ Public Class FormMain
Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Finish)
Hint("已加载主页自定义文件!", HintType.Green)
End Sub)
Return
End If
@@ -995,9 +1049,9 @@ Public Class FormMain
#Region "切换页面"
'页面种类与属性
'注意,这一枚举在 “切换页面” EventType 中调用,应视作公开 API 的一部分
''' <summary>
''' 页面种类。
''' 该枚举在自定义事件中使用,是公开 API 的一部分。
''' </summary>
Public Enum PageType
''' <summary>
@@ -1043,6 +1097,7 @@ Public Class FormMain
End Enum
''' <summary>
''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。
''' 该枚举在自定义事件中使用,是公开 API 的一部分。
''' </summary>
Public Enum PageSubType
[Default] = 0
@@ -1053,14 +1108,10 @@ Public Class FormMain
DownloadResourcePack = 5
DownloadShader = 6
SetupLaunch = 0
SetupUI = 1
SetupSystem = 2
SetupLink = 3
LinkHiper = 1
LinkIoi = 2
LinkSetup = 4
LinkHelp = 5
LinkFeedback = 6
SetupLink = 1
SetupUI = 2
SetupSystem = 3
LinkMain = 0
OtherHelp = 0
OtherAbout = 1
OtherTest = 2
@@ -1288,8 +1339,8 @@ Public Class FormMain
'PageGet 方法会在未设置 SubType 时指定默认值,并建立相关页面的实例
PageChangeAnim(FrmDownloadLeft, FrmDownloadLeft.PageGet(SubType))
Case PageType.Link '联机
If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
PageChangeAnim(FrmLinkLeft, FrmLinkLeft.PageGet(SubType))
If FrmLinkMain Is Nothing Then FrmLinkMain = New PageLinkMain
PageChangeAnim(New MyPageLeft, FrmLinkMain)
Case PageType.Setup '设置
If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
PageChangeAnim(FrmSetupLeft, FrmSetupLeft.PageGet(SubType))
@@ -1485,7 +1536,7 @@ Public Class FormMain
'投降
Public Sub AprilGiveup() Handles BtnExtraApril.Click
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
Hint("=D", HintType.Finish)
Hint("=D", HintType.Green)
IsAprilGiveup = True
FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
@@ -1503,7 +1554,7 @@ Public Class FormMain
For Each Watcher In McWatcherList
Watcher.Kill()
Next
Hint("已关闭运行中的 Minecraft!", HintType.Finish)
Hint("已关闭运行中的 Minecraft!", HintType.Green)
Catch ex As Exception
Log(ex, "强制关闭所有 Minecraft 失败", LogLevel.Feedback)
End Try
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

@@ -467,7 +467,7 @@ Public Module ModAnimation
''' 按照 WPF 方式旋转控件的动画。
''' </summary>
''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param>
''' <param name="Value">大小改变的百分比(如-0.6)。</param>
''' <param name="Value">旋转角度(度)。</param>
''' <param name="Time">动画长度(毫秒)。</param>
''' <param name="Delay">动画延迟执行的时间(毫秒)。</param>
''' <param name="Ease">插值器类型。</param>
@@ -792,44 +792,46 @@ Public Module ModAnimation
AniFPSTimer = AniLastTick
AniRunning = True '标记动画执行开始
RunInNewThread(Sub()
Try
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
End If
AniFPSCounter += 2
End If
'执行动画
RunInUiWait(Sub()
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
'#If DEBUG Then
' FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
'#Else
' If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
'#End If
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "(" & GetString(NetManager.Speed) & "/s)")
End If
End Sub)
RunInNewThread(
Sub()
Try
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
End If
AniFPSCounter += 2
End If
'执行动画
RunInUiWait(
Sub()
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
'#If DEBUG Then
' FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
'#Else
' If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
'#End If
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "(" & GetString(NetManager.Speed) & "/s)")
End If
End Sub)
Sleeper:
'控制 FPS
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Critical)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
'控制 FPS
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Critical)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
''' <summary>
@@ -996,7 +998,7 @@ NextAni:
Case AniType.ScaleTransform
Dim Obj As FrameworkElement = Ani.Obj
If TypeOf Obj.RenderTransform IsNot ScaleTransform Then
Obj.RenderTransformOrigin = New Point(0.5, 0.5)
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New ScaleTransform(1, 1)
End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
@@ -1006,7 +1008,7 @@ NextAni:
Case AniType.RotateTransform
Dim Obj As FrameworkElement = Ani.Obj
If TypeOf Obj.RenderTransform IsNot RotateTransform Then
Obj.RenderTransformOrigin = New Point(0.5, 0.5)
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New RotateTransform(0)
End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
+96 -27
View File
@@ -5,6 +5,7 @@ Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports System.Threading.Tasks
Imports System.Xaml
Imports Newtonsoft.Json
@@ -13,13 +14,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.10.8" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.8." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.11.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.11.1." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 367 'Release
Public Const VersionCode As Integer = 372 'Release
#Else
Public Const VersionCode As Integer = 370 'Snapshot
Public Const VersionCode As Integer = 374 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -69,7 +70,7 @@ Public Module ModBase
''' <summary>
''' 识别码。
''' </summary>
Public UniqueAddress As String = SecretGetUniqueAddress()
Public Identify As String = SecretGetIdentify()
''' <summary>
''' 程序是否已结束。
''' </summary>
@@ -498,6 +499,7 @@ Public Module ModBase
RealNum += Digit * Scale
Scale *= FromRadix
Next
If RealNum = 0 Then Return "0"
'转换为指定进制
Dim Result = ""
While RealNum > 0
@@ -761,7 +763,6 @@ Public Module ModBase
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
Dim length As Integer = FilePath.Length
If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FilePath
End Function
''' <summary>
@@ -1301,10 +1302,12 @@ Re:
Dim TotalCount As Long = Archive.Entries.Count
For Each Entry As ZipArchiveEntry In Archive.Entries
If ProgressIncrementHandler IsNot Nothing AndAlso TotalCount > 0 Then ProgressIncrementHandler(1 / TotalCount)
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then Continue For '不创建空文件夹
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹
Dim DestinationDirectory As String = GetPathFromFullPath(DestinationFullPath)
Directory.CreateDirectory(DestinationDirectory)
Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329
Next
End Using
End If
@@ -1400,12 +1403,13 @@ RetryDir:
''' <summary>
''' 若路径长度大于指定值,则将长路径转换为短路径。
''' 如果路径不存在,则返回原始路径。
''' </summary>
Public Function ShortenPath(LongPath As String) As String
If LongPath.Length <= 200 OrElse LongPath.StartsWithF("http", True) Then Return LongPath
If Not Directory.Exists(LongPath) AndAlso Not File.Exists(LongPath) Then Return LongPath
Dim ShortPath As New StringBuilder(260)
GetShortPathName(LongPath, ShortPath, 260)
GetShortPathName(LongPath.Replace("/", "\"), ShortPath, 260) '第一个参数也会在调用后被修改,使用 Replace 后不会影响原始字符串
ShortenPath = ShortPath.ToString
If String.IsNullOrEmpty(ShortenPath) Then Return LongPath
End Function
@@ -1511,6 +1515,19 @@ RetryDir:
Return [Enum].GetName(EnumData.GetType, EnumData)
End Function
''' <summary>
''' 将字符串转换为枚举类型,支持数字或原文两种格式,若为空字符串则返回 0。
''' 若转换失败会抛出异常。
''' </summary>
<Extension> Public Function ParseToEnum(Of T)(Str As String) As T
If String.IsNullOrEmpty(Str) Then
Return CType(0, Object)
ElseIf IsNumeric(Str) Then
Return CType(CInt(Str), Object)
Else
Return [Enum].Parse(GetType(T), Str, True)
End If
End Function
''' <summary>
''' 将文件大小转化为适合的文本形式,如“1.28 M”。
''' </summary>
''' <param name="FileSize">以字节为单位的大小表示。</param>
@@ -1711,6 +1728,7 @@ RetryDir:
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
If Str Is Nothing Then Return False
Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
@@ -1718,6 +1736,7 @@ RetryDir:
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
If Str Is Nothing Then Return False
Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
@@ -1725,6 +1744,7 @@ RetryDir:
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
If Str Is Nothing Then Return False
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
End Function
''' <summary>
@@ -1761,6 +1781,7 @@ RetryDir:
''' 如果输入有误,返回 0。
''' </summary>
Public Function Val(Str As Object) As Double
If Str Is Nothing Then Return 0
Try
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Catch
@@ -2131,6 +2152,29 @@ RetryDir:
Return result
End Function
''' <summary>
''' 为 Task 设置超时,在超时时抛出 TimeoutException。
''' </summary>
<Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
Dim DelayTask = Task.Delay(TimeoutMs)
If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
TokenSource.Cancel()
Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
End If
Return TargetTask.GetAwaiter().GetResult()
End Function
''' <summary>
''' 为 Task 设置超时,在超时时抛出 TimeoutException。
''' </summary>
<Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
Dim DelayTask = Task.Delay(TimeoutMs)
If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
TokenSource.Cancel()
Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
End If
TargetTask.GetAwaiter().GetResult()
End Sub
''' <summary>
''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
''' </summary>
@@ -2355,7 +2399,7 @@ NextElement:
''' <param name="Arguments">运行参数。</param>
''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
Optional WorkingDirectory As String = Nothing) As String
Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
Dim Info = New ProcessStartInfo With {
.Arguments = Arguments,
.FileName = ShortenPath(FileName),
@@ -2363,7 +2407,9 @@ NextElement:
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c)))
.WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c))),
.StandardErrorEncoding = Encoding,
.StandardOutputEncoding = Encoding
}
If WorkingDirectory IsNot Nothing Then
If Info.EnvironmentVariables.ContainsKey("appdata") Then
@@ -2372,7 +2418,7 @@ NextElement:
Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
End If
End If
Log("[System] 执行外部命令并等待返回结果:" & FileName & " " & Arguments)
If PrintLog Then Log("[System] 执行命令并等待返回结果:" & FileName & " " & Arguments)
Using Program As New Process With {.StartInfo = Info}
Program.Start()
Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
@@ -2526,7 +2572,7 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) AndAlso Not Url.StartsWithF("minecraft-preview://", True) Then
Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
End If
Log("[System] 正在打开网页:" & Url)
@@ -2568,7 +2614,7 @@ Retry:
RunInUi(
Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
@@ -2579,9 +2625,24 @@ Retry:
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
If ShowSuccessHint Then Hint("已成功复制!", HintType.Green)
End Sub)
End Sub
''' <summary>
''' 获取剪贴板文本。将在 UI 线程运行,且不会抛出异常。
''' </summary>
Public Function ClipboardGetText() As String
Dim Result As String = Nothing
RunInUiWait(
Sub()
Try
If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
Catch ex As Exception
Log(ex, "获取剪贴板文本失败")
End Try
End Sub)
Return Result
End Function
''' <summary>
''' 以 Byte() 形式获取程序中的资源。
@@ -2716,6 +2777,11 @@ Retry:
''' 将 XML 转换为对应 UI 对象。
''' </summary>
Public Function GetObjectFromXML(Str As String) As Object
Str = Str. '兼容旧版自定义事件写法
Replace("EventType=""", "local:CustomEventService.EventType=""").
Replace("EventData=""", "local:CustomEventService.EventData=""").
Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""")
Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
'类型检查
Using Reader As New XamlXmlReader(Stream)
@@ -2831,7 +2897,7 @@ Retry:
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Red)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
@@ -2884,6 +2950,7 @@ Retry:
'输出日志
Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
If ModeDebug Then
SyncLock LogListLock
LogList.Append(AppendText)
@@ -2903,16 +2970,16 @@ Retry:
Select Case Level
#If DEBUG Then
Case LogLevel.Developer
Hint("[开发者模式] " & Text, HintType.Info, False)
Hint("[开发者模式] " & Text, HintType.Blue, False)
Case LogLevel.Debug
Hint("[调试模式] " & Text, HintType.Info, False)
Hint("[调试模式] " & Text, HintType.Blue, False)
#Else
Case LogLevel.Developer
Case LogLevel.Debug
If ModeDebug Then Hint("[调试模式] " & Text, HintType.Info, False)
If ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
#End If
Case LogLevel.Hint
Hint(Text, HintType.Critical, False)
Hint(Text, HintType.Red, False)
Case LogLevel.Msgbox
MyMsgBox(Text, Title, IsWarn:=True)
Case LogLevel.Feedback
@@ -2955,6 +3022,7 @@ Retry:
'输出日志
Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
If ModeDebug Then
SyncLock LogListLock
LogList.Append(AppendText)
@@ -2973,19 +3041,19 @@ Retry:
#If DEBUG Then
Case LogLevel.Developer
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
Hint("[开发者模式] " & ExLine, HintType.Info, False)
Hint("[开发者模式] " & ExLine, HintType.Blue, False)
Case LogLevel.Debug
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
Hint("[调试模式] " & ExLine, HintType.Info, False)
Hint("[调试模式] " & ExLine, HintType.Blue, False)
#Else
Case LogLevel.Developer
Case LogLevel.Debug
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Blue, False)
#End If
Case LogLevel.Hint
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
Hint(ExLine, HintType.Critical, False)
Hint(ExLine, HintType.Red, False)
Case LogLevel.Msgbox
MyMsgBox(ExFull, Title, IsWarn:=True)
Case LogLevel.Feedback
@@ -3054,6 +3122,7 @@ Retry:
Public Sub Telemetry([Event] As String, ParamArray Datas As String())
If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
RunInNewThread(
Sub()
Try
@@ -3091,7 +3160,7 @@ Retry:
End Function
''' <summary>
''' 取随机整数。
''' 取随机整数(包含)。
''' </summary>
Public Function RandomInteger(min As Integer, max As Integer) As Integer
Return Math.Floor((max - min + 1) * Random.NextDouble) + min
@@ -8,6 +8,7 @@
Implements ILoadingTrigger
Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader
Protected Shared LogBlackList As String() = {"EasyTier CLI"}
'基础属性
''' <summary>
@@ -89,7 +90,7 @@
Dim OldState = _State
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value
Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变:{GetStringFromEnum(value)}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(
Sub()
@@ -170,6 +171,7 @@
'状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
Public MustOverride Sub Abort()
Public MustOverride Sub Failed(Ex As Exception)
'等待结束
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -290,6 +292,7 @@
'检验输入以确定情况
If IsForceRestart Then Return True '强制要求重启
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
@@ -316,13 +319,13 @@
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsAborted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Return
End If
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效
@@ -335,25 +338,33 @@
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Return
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
Failed(ex)
End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
End Sub
Public Overrides Sub Abort()
If State <> LoadState.Loading Then Return
Public Overrides Sub Failed(ex As Exception)
[Error] = ex
SyncLock LockState
If IsAborted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
TriggerThreadAbort()
End Sub
Public Overrides Sub Abort()
SyncLock LockState
If State <> LoadState.Loading Then Return
State = LoadState.Aborted
End SyncLock
TriggerThreadAbort()
End Sub
Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Return
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt()
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
End If
LastRunningThread = Nothing
End Sub
@@ -452,6 +463,17 @@
Next
End Sub)
End Sub
Public Overrides Sub Failed(Ex As Exception)
[Error] = Ex '先设置错误再调整状态,防止父加载器获取不到异常
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
For Each Loader In Loaders
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
End Sub
''' <summary>
''' 子任务状态变更。
@@ -469,18 +491,9 @@
Case LoadState.Aborted
'被中断,这个任务也中断
Abort()
Case Else
Case LoadState.Failed
'完蛋,出错了
SyncLock LockState
If State >= LoadState.Finished Then Return
[Error] = New Exception(Loader.Name & "失败", Loader.Error)
State = Loader.State
End SyncLock
For Each Loader In Loaders
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
Return
Failed(New Exception(Loader.Name & "失败", Loader.Error))
End Select
End Sub
''' <summary>
+75 -30
View File
@@ -262,11 +262,11 @@ RequestFinished:
})
End If
End SyncLock
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
Dim ResponseBytes As Byte()
Using Stream As New MemoryStream
ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetAwaiter().GetResult()
ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
ResponseBytes = Stream.ToArray()
End Using
'输出
@@ -286,7 +286,7 @@ RequestFinished:
Throw
Catch ex As Exception
RecordIPReliability(HostIp, -1)
If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
Throw New WebException($"连接服务器超时,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},IP:{HostIp})", WebExceptionStatus.Timeout)
ElseIf ex.IsNetworkRelated Then
Throw New WebException($"网络请求失败,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},IP:{HostIp})", WebExceptionStatus.Timeout)
@@ -992,26 +992,24 @@ StartThread:
HostIp = DNSLookup(HttpRequest, CancelToken) 'DNS 预解析
If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
Dim ContentLength As Long = 0
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}") '状态码检查
If State = NetState.Error Then GoTo SourceBreak '快速中断
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}:重定向至 {Response.RequestMessage.RequestUri}")
'文件大小校验
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
If ContentLength = -1 Then
If ContentLength < 0 Then
If FileSize > 1 Then
If Th.DownloadStart = 0 Then
Log($"[Download] {LocalName}:文件大小未知,但已从其他下载源获取,不作处理")
Else
Log($"[Download] {LocalName}:ContentLength 返回了 -1,无法确定是否支持分段下载,视作不支持")
Log($"[Download] {LocalName}:ContentLength 返回了 {ContentLength},无法确定是否支持分段下载,视作不支持")
GoTo NotSupportRange
End If
Else
FileSize = -1 : IsUnknownSize = True
Log($"[Download] {LocalName}:文件大小未知")
End If
ElseIf ContentLength < 0 Then
Throw New Exception("获取片大小失败,结果为 " & ContentLength & "。")
ElseIf Th.IsFirstThread Then
If Check IsNot Nothing Then
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
@@ -1040,15 +1038,11 @@ StartThread:
ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
NotSupportRange:
SyncLock LockSource
If SourcesOnce.Contains(Th.Source) Then
GoTo SourceBreak
Else
SourcesOnce.Add(Th.Source)
End If
If SourcesOnce.Contains(Th.Source) Then GoTo SourceBreak
End SyncLock
Throw New WebException($"该下载源不支持分段下载:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
Throw New RangeNotSupportedException($"该下载源不支持分段下载:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
Throw New WebException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
Throw New RangeNotSupportedException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
End If
'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}")
Th.State = NetState.Get
@@ -1061,6 +1055,7 @@ NotSupportRange:
Cache = New MemoryStream
ResultStream = Cache
Else
Directory.CreateDirectory(PathTemp & "Download")
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
End If
@@ -1068,7 +1063,7 @@ NotSupportRange:
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetAwaiter().GetResult()
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
'限速
@@ -1118,7 +1113,7 @@ NotSupportRange:
'无数据,且已超时
Throw New TimeoutException("操作超时,无数据。")
End If
HttpDataCount = ResponseStream.Read(ResponseBytes, 0, 16384)
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
End While
SourceBreak:
If State = NetState.Error OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
@@ -1135,7 +1130,8 @@ SourceBreak:
RecordIPReliability(HostIp, 0.5)
End If
Catch ex As Exception
Log($"[Download] {LocalName}:出错,{If(TypeOf ex Is OperationCanceledException, $"已超时({Timeout}ms)", ex.GetDetail())},IP:{HostIp}")
Log($"[Download] {LocalName}:出错,{If(TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException,
$"已超时({Timeout}ms)", ex.GetDetail())},IP:{HostIp}")
RecordIPReliability(HostIp, -0.7)
SourceFail(Th, ex, False)
Finally
@@ -1165,9 +1161,10 @@ SourceBreak:
Th.State = NetState.Error
Th.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
If IsMergeFailure OrElse
ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
If IsMergeFailure OrElse IsRangeNotSupported OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("未能解析") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429,所以不应因此禁用下载源
(Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
'当一个下载源有多个线程在下载时,只选择其中一个线程进行后续处理
@@ -1180,9 +1177,9 @@ SourceBreak:
End SyncLock
'……后续处理
If IsThisFail Then
Log($"[Download] {LocalName}:下载源被禁用({Th.Source.Id}):{Th.Source.Url}")
Log($"[Download] {LocalName}:下载源被禁用({Th.Source.Id},Range 问题:{IsRangeNotSupported}):{Th.Source.Url}")
Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用",
If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), LogLevel.Developer, LogLevel.Debug))
SyncLock LockSource
SourcesOnce.Remove(Th.Source)
End SyncLock
@@ -1191,9 +1188,10 @@ SourceBreak:
Fail(ex)
ElseIf HasAvailableSource() AndAlso Not IsMergeFailure Then
'当前源失败,但还有下载源:正常地继续执行
ElseIf Not Retried AndAlso Sources.Count > 1 Then
ElseIf Not Retried Then
'合并失败或首次下载失败,未重试:将所有下载源重新标记为不允许断点续传的下载源,逐个重新尝试下载
Hint($"{LocalName}:文件下载失败,正在自动重试……", If(ModeDebug, HintType.Critical, HintType.Info)) '在调试模式下给出红色提示
'若所有源均不支持 Range,也会走到这里重试
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}:文件下载失败,正在自动重试……", LogLevel.Debug)
Retried = True
SyncLock LockSource
SourcesOnce.Clear()
@@ -1388,6 +1386,12 @@ Retry:
End Sub
End Class
Private Class RangeNotSupportedException
Inherits WebException
Public Sub New(Message As String)
MyBase.New(Message)
End Sub
End Class
''' <summary>
''' 下载一系列文件的加载器。
''' </summary>
@@ -1639,20 +1643,23 @@ Retry:
Next
OnFail(File.Ex)
End Sub
Public Overrides Sub Failed(Ex As Exception)
OnFail(New List(Of Exception) From {Ex})
End Sub
Public Sub OnFail(ExList As List(Of Exception))
SyncLock LockState
If State > LoadState.Loading Then Return
If State >= LoadState.Finished Then Return
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
'寻找有效的错误信息
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot TimeoutException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
'获取实际失败的文件
For Each File In Files
If File.State <> NetState.Error Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}({s.Url})"), vbCrLf)
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf &
"各下载源的错误如下:" & vbCrLf & Detail,
[Error])
"各下载源的错误如下:" & vbCrLf & Detail, [Error])
'上报
Telemetry("文件下载失败",
"FileName", File.LocalName,
@@ -1890,7 +1897,6 @@ Retry:
Catch ex As Exception
Log(ex, "清理下载缓存失败")
End Try
Directory.CreateDirectory(PathTemp & "Download")
End If
IsDownloadCacheCleared = True
End SyncLock
@@ -1946,6 +1952,45 @@ Retry:
Return False
End Function
#End Region
#Region "端口"
''' <summary>
''' 随机获取单个可用的端口。
''' </summary>
Public Function FindFreePort() As Integer
Dim Listener As New TcpListener(IPAddress.Loopback, 0)
Listener.Start()
Dim port As Integer = CType(Listener.LocalEndpoint, IPEndPoint).Port
Listener.Stop()
Return port
End Function
''' <summary>
''' 获取当前已被占用的端口列表。
''' </summary>
Public Function GetUsedPorts() As List(Of Integer)
Dim IPProperties = NetworkInformation.IPGlobalProperties.GetIPGlobalProperties()
Dim UsedPorts As New List(Of Integer)
UsedPorts.AddRange(IPProperties.GetActiveTcpListeners().Select(Function(ep) ep.Port))
UsedPorts.AddRange(IPProperties.GetActiveUdpListeners().Select(Function(ep) ep.Port))
UsedPorts.AddRange(IPProperties.GetActiveTcpConnections().Select(Function(conn) conn.LocalEndPoint.Port))
Return UsedPorts.Distinct().ToList()
End Function
''' <summary>
''' 寻找数个连续编号的可用端口。
''' </summary>
Public Function FindFreePorts(ConsecutiveCount As Integer, ParamArray ExtraBlackLists As Integer()) As List(Of Integer)
Dim UsedPorts = GetUsedPorts().Concat(ExtraBlackLists)
For port = 12000 To 65000 - ConsecutiveCount
Dim Range = Enumerable.Range(port, ConsecutiveCount)
If Not Range.Any(Function(p) UsedPorts.Contains(p)) Then Return Range.ToList
Next
Throw New Exception("未能找到可用的端口!")
End Function
#End Region
''' <summary>
@@ -113,11 +113,11 @@ Public Class ValidateInteger
Me.Max = Max
End Sub
Public Overrides Function Validate(Str As String) As String
Dim Valed As Integer
If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数!"
If Str.Length > 9 Then Return "请输入一个大小合理的数字!"
Dim Valed As Integer = Val(Str)
If Valed.ToString <> Str Then Return "请输入一个整数!"
If Val(Str) > Max Then Return "不可超过 " & Max & "!"
If Val(Str) < Min Then Return "不可低于 " & Min & "!"
If Valed > Max Then Return "不可超过 " & Max & "!"
If Valed < Min Then Return "不可低于 " & Min & "!"
Return ""
End Function
End Class
@@ -1211,11 +1211,11 @@ Retry:
Function(Project As CompProject) As Double
Select Case Request.Type
Case CompType.Mod, CompType.ModPack
Return If(Project.FromCurseForge, 1, 7)
Return If(Project.FromCurseForge, 1, 5)
Case CompType.DataPack
Return If(Project.FromCurseForge, 10, 1)
Case CompType.ResourcePack, CompType.Shader
Return If(Project.FromCurseForge, 1, 5)
Return If(Project.FromCurseForge, 1, 4)
Case Else
Return 1
End Select
@@ -908,8 +908,7 @@ NextStack:
If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
FileContent = FilterUserName(FileContent, "*")
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
@@ -917,7 +916,7 @@ NextStack:
'导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出!", HintType.Finish)
Hint("错误报告已导出!", HintType.Green)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Return
@@ -73,8 +73,10 @@
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
@@ -93,6 +95,11 @@
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort()
Throw New ThreadInterruptedException
End If
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
@@ -35,7 +35,7 @@ Public Module ModLaunch
'预检查
If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中!", HintType.Critical)
Hint("已有游戏正在启动中!", HintType.Red)
Return False
End If
'强制切换需要启动的版本
@@ -44,7 +44,7 @@ Public Module ModLaunch
'检查版本
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Critical)
Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Red)
Return False
End If
'切换版本
@@ -98,7 +98,7 @@ Public Module ModLaunch
McLaunchPrecheck()
McLaunchLog("预检测已通过")
Catch ex As Exception
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
Throw
End Try
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -146,7 +146,7 @@ Public Module ModLaunch
'成功与失败处理
Select Case LaunchLoader.State
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功!", HintType.Finish)
Hint(McVersionCurrent.Name & " 启动成功!", HintType.Green)
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动成功",
@@ -155,9 +155,9 @@ Public Module ModLaunch
End If
Case LoadState.Aborted
If AbortHint Is Nothing Then
Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Info)
Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Blue)
Else
Hint(AbortHint, HintType.Finish)
Hint(AbortHint, HintType.Green)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
@@ -270,7 +270,7 @@ NextInner:
Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
Case 2
Hint("游戏将以试玩模式启动!", HintType.Critical)
Hint("游戏将以试玩模式启动!", HintType.Red)
CurrentLaunchOptions.ExtraArgs.Add("--demo")
Case 3
Throw New Exception("$$")
@@ -755,10 +755,10 @@ LoginFinish:
ContentType:="application/json; charset=utf-8", RequireJson:=True))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Critical)
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Red)
Throw New Exception("$你还没有创建角色,请在创建角色后再试!")
ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then
Hint("你的账户中只有一个角色,无法更换!", HintType.Critical)
Hint("你的账户中只有一个角色,无法更换!", HintType.Red)
End If
Dim SelectedName As String = Nothing
Dim SelectedId As String = Nothing
@@ -1304,7 +1304,7 @@ Retry:
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java,已取消启动!", HintType.Critical)
Hint("没有可用的 Java,已取消启动!", HintType.Red)
Throw New Exception("$$")
End If
@@ -1395,7 +1395,7 @@ Retry:
Next
'自定义
Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent)
Arguments += " " & If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame)
Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame))
'进行参数替换
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1412,6 +1412,9 @@ Retry:
FinalArguments += Argument & " "
Next
FinalArguments = FinalArguments.TrimEnd
'替换 Module Path 为短路径(Forge 会在版本 JSON 硬编码这些路径)
FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )",
Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]{1}:\\[^;]+", Function(m) ShortenPath(m.Value)))
'进服
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then
@@ -1427,7 +1430,7 @@ Retry:
'不包含端口号
FinalArguments += $" --server {Server} --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Red)
End If
End If
'输出
@@ -1447,7 +1450,7 @@ Retry:
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
@@ -1460,9 +1463,7 @@ Retry:
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", McVersionCurrent))
Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1571,7 +1572,7 @@ NextVersion:
'去重
DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M") '#3511 的清理
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
@@ -1592,7 +1593,7 @@ NextVersion:
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
DataList.Add(BasicString)
Dim Result As String = Join(DataList, " ")
Dim Result As String = DataList.Join(" ")
'特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
@@ -1697,7 +1698,7 @@ NextVersion:
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))
GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)))
GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
GameArguments.Add("${user_properties}", "{}")
@@ -1707,7 +1708,7 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221
GameArguments.Add("${primary_jar}", Version.Path & Version.Name & ".jar") '#6942
GameArguments.Add("${primary_jar}", ShortenPath(Version.Path & Version.Name & ".jar")) '#6942
'窗口尺寸参数
Dim GameSize As Size
@@ -1827,10 +1828,14 @@ NextVersion:
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
If IsGBKEncoding OrElse Result.IsASCII() Then Return ShortenPath(Result)
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Result.IsASCII() Then Return ShortenPath(Result)
Return OsDrive & "ProgramData\PCL\natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
Result = OsDrive & "ProgramData\PCL\natives"
End If
End If
Directory.CreateDirectory(Result) '提前创建,这样 ShortenPath 才有结果(否则在长路径下首次启动 Forge 会崩溃)
Return ShortenPath(Result)
End Function
#End Region
@@ -1981,7 +1986,7 @@ NextVersion:
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Red)
End If
'离线皮肤资源包
@@ -2125,9 +2130,9 @@ IgnoreCustomSkin:
'获取自定义命令
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal, True)
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion, True)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
'输出 bat
Try
@@ -2283,7 +2288,7 @@ IgnoreCustomSkin:
'获取窗口标题
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
WindowTitle = ArgumentReplace(WindowTitle, False)
WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
'初始化等待
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
@@ -2332,47 +2337,6 @@ IgnoreCustomSkin:
End Sub
''' <summary>
''' 在启动结束时,对 PCL 约定的替换标记进行处理。
''' </summary>
Private Function ArgumentReplace(Raw As String, ReplaceTimeAndDate As Boolean) As String
If Raw Is Nothing Then Return Nothing
'路径替换
Raw = Raw.Replace("{minecraft}", PathMcFolder)
Raw = Raw.Replace("{verpath}", McVersionCurrent.Path)
Raw = Raw.Replace("{verindie}", McVersionCurrent.PathIndie)
Raw = Raw.Replace("{java}", McLaunchJavaSelected.PathFolder)
'普通替换
Raw = Raw.Replace("{user}", McLoginLoader.Output.Name)
Raw = Raw.Replace("{uuid}", McLoginLoader.Output.Uuid)
If ReplaceTimeAndDate Then '设置窗口标题时需要动态替换日期和时间
Raw = Raw.Replace("{date}", Date.Now.ToString("yyyy/M/d"))
Raw = Raw.Replace("{time}", Date.Now.ToString("HH:mm:ss"))
End If
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
Raw = Raw.Replace("{login}", "联机离线")
Else
Raw = Raw.Replace("{login}", "离线")
End If
Case McLoginType.Ms
Raw = Raw.Replace("{login}", "正版")
Case McLoginType.Nide
Raw = Raw.Replace("{login}", "统一通行证")
Case McLoginType.Auth
Raw = Raw.Replace("{login}", "Authlib-Injector")
End Select
Raw = Raw.Replace("{name}", McVersionCurrent.Name)
If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
Raw = Raw.Replace("{version}", McVersionCurrent.Name)
Else
Raw = Raw.Replace("{version}", McVersionCurrent.Version.McName)
End If
Raw = Raw.Replace("{path}", Path)
Return Raw
End Function
#End Region
End Module
@@ -68,7 +68,7 @@ Public Module ModMinecraft
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Critical)
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Red)
Continue For
End If
Dim Name As String = Folder.Split(">")(0)
@@ -261,6 +261,12 @@ Public Module ModMinecraft
''' 显示的描述文本。
''' </summary>
Public Info As String = "该版本未被加载,请向作者反馈此问题"
Public ReadOnly Property HasCustomInfo As Boolean
Get
Return ReadIni(Path & "PCL\Setup.ini", "CustomInfo") <> ""
End Get
End Property
''' <summary>
''' 该版本的列表检查原始结果,不受自定义影响。
''' </summary>
@@ -784,7 +790,17 @@ ExitDataLoad:
End If
'确定版本描述
Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
If CustomInfo <> "" Then
Info = CustomInfo
Else
Info = GetVersionDescription()
If State = McVersionState.Fool Then
Info = GetMcFoolName(Version.McName)
ElseIf State <> McVersionState.Error Then
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
End If
'确定版本收藏状态
IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
'确定版本显示种类
@@ -817,11 +833,13 @@ ExitDataLoad:
End Try
Return Me
End Function
Public IsLoaded As Boolean = False
''' <summary>
''' 获取版本的默认描述。
''' 获取对该版本的简短描述。
''' 例如 “快照 16w01a”、“原版 1.12.2”、“愚人节版本 2.0”。
''' </summary>
Public Function GetDefaultDescription() As String
Dim Info As String = ""
Public Function GetVersionDescription() As String
Dim Info As String
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
@@ -838,21 +856,38 @@ ExitDataLoad:
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Info = "愚人节版本 " & Version.McName
Case McVersionState.Error
Return Me.Info '已有错误信息
Case Else
Info = "发生了未知错误,请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Return Info
End Function
Public IsLoaded As Boolean = False
Public Function ToListItem() As MyListItem
Dim NewItem As New MyListItem With {.Info = Info, .Height = 42, .Tag = Me, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
'标题
NewItem.Inlines.Clear()
NewItem.Inlines.Add(New Run(Name))
If HasCustomInfo Then '如果版本设置了自定义描述,在标题后面以淡灰色显示其版本号
NewItem.Inlines.Add(New Run(" | " & GetVersionDescription()) With {.Foreground = New MyColor(215, 215, 215), .FontSize = 12})
End If
'Logo
Try
If Logo.EndsWith("PCL\Logo.png") Then
NewItem.Logo = Path & "PCL\Logo.png" '修复老版本中,存储的自定义 Logo 使用完整路径,导致移动后无法加载的 Bug
Else
NewItem.Logo = Logo
End If
Catch ex As Exception
Log(ex, "加载版本图标失败", LogLevel.Hint)
NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
End Try
Return NewItem
End Function
'运算符支持
Public Overrides Function Equals(obj As Object) As Boolean
Dim version = TryCast(obj, McVersion)
Return version IsNot Nothing AndAlso Path = version.Path
@@ -865,7 +900,6 @@ ExitDataLoad:
Public Shared Operator <>(a As McVersion, b As McVersion) As Boolean
Return Not (a = b)
End Operator
End Class
Public Enum McVersionState
[Error]
@@ -1567,12 +1601,12 @@ OnLoaded:
Try
Dim Image As New MyBitmap(FileName)
If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Critical)
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Red)
Return New McSkinInfo With {.IsVaild = False}
End If
Dim FileInfo As New FileInfo(FileName)
If FileInfo.Length > 24 * 1024 Then
Hint("皮肤文件大小需小于 24 KB,而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Critical)
Hint("皮肤文件大小需小于 24 KB,而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Red)
Return New McSkinInfo With {.IsVaild = False}
End If
Catch ex As Exception
@@ -1892,17 +1926,29 @@ OnLoaded:
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
.LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
CustomMcFolder & "libraries\" & Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")),
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
$"{CustomMcFolder}libraries\{Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")}"),
.Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString),
.IsNatives = True,
.SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
Else
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End If
Catch ex As Exception
Log(ex, "处理实际支持库列表失败(有 Natives," & If(Library("name"), "Nothing").ToString & ")")
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End Try
End If
@@ -2096,19 +2142,12 @@ OnLoaded:
''' <param name="WithHead">是否包含 Lib 文件夹头部,若不包含,则会类似以 com\xxx\ 开头。</param>
Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
'有时候原始的有四段,例如 net.minecraftforge:forge:1.21.4-54.0.34:client
'文件夹名应该忽略最后一段(client),但文件名需要保留
'参见 #7306(以及 #5376 也是因为这里没有处理好导致的)
Dim Splited = Original.Split(":")
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer
If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1).BeforeFirst("_"))
Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 2, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
End If
End If
$"{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited.Skip(1).Join("-")}.jar"
End Function
''' <summary>
@@ -31,7 +31,7 @@ Public Module ModModpack
Try
'字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Red) : Throw New CancelledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
@@ -344,7 +344,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException
End If
@@ -485,7 +485,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException
End If
@@ -540,7 +540,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException
End If
'启动
@@ -639,8 +639,8 @@ Retry:
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
If Not Component.Contains("uid") Then Continue For
For Each Component As JObject In PackJson("components")
If Not Component.ContainsKey("uid") Then Continue For
Select Case Component("uid").ToString
Case "org.lwjgl"
Log("[ModPack] 已跳过 LWJGL 项")
@@ -667,7 +667,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException
End If
@@ -725,7 +725,7 @@ Retry:
Next
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Red)
Throw New CancelledException
End If
Dim Request As New McInstallRequest With {
@@ -746,7 +746,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException
End If
@@ -766,7 +766,7 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -843,8 +843,8 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -349,7 +349,7 @@
State = MinecraftState.Crashed
'崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Critical)
Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Red)
FeedbackInfo()
RunInNewThread(
Sub()
+271 -79
View File
@@ -1,49 +1,183 @@
Public Module ModEvent

#Region "附加属性"
Public Sub TryStartEvent(Type As String, Data As String)
If String.IsNullOrWhiteSpace(Type) Then Return
Dim RealData As String() = {""}
If Data IsNot Nothing Then RealData = Data.Split("|")
StartEvent(Type, RealData)
''' <summary>
''' 用于在 XAML 中初始化列表对象。
''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象,因此需要一个包装类,然后在 XAML 中显式初始化。
''' </summary>
<Markup.ContentProperty("Events")>
Public Class CustomEventCollection
Implements IEnumerable(Of CustomEvent)
Dim _Events As New List(Of CustomEvent)
Public ReadOnly Property Events As List(Of CustomEvent)
Get
Return _Events
End Get
End Property
Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return DirectCast(Events, IEnumerable).GetEnumerator()
End Function
End Class
''' <summary>
''' 提供自定义事件的附加属性。
''' </summary>
Public Class CustomEventService
'Events
Public Shared ReadOnly EventsProperty As DependencyProperty =
DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
d.SetValue(EventsProperty, value)
End Sub
Public Sub StartEvent(Type As String, Data As String())
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
Return d.GetValue(EventsProperty)
End Function
'EventType
Public Shared ReadOnly EventTypeProperty As DependencyProperty =
DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
d.SetValue(EventTypeProperty, value)
End Sub
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
Return d.GetValue(EventTypeProperty)
End Function
'EventData
Public Shared ReadOnly EventDataProperty As DependencyProperty =
DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEventData(d As DependencyObject, value As String)
d.SetValue(EventDataProperty, value)
End Sub
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Function GetEventData(d As DependencyObject) As String
Return d.GetValue(EventDataProperty)
End Function
End Class
Partial Public Module ModMain
''' <summary>
''' 触发该控件上的自定义事件。
''' 事件会在新线程中执行。
''' </summary>
<Runtime.CompilerServices.Extension>
Public Sub RaiseCustomEvent(Control As DependencyObject)
'收集事件列表
Dim Events = CustomEventService.GetEvents(Control).ToList
Dim EventType = CustomEventService.GetEventType(Control)
If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
'执行事件
If Not Events.Any Then Return
RunInNewThread(
Sub()
For Each e In Events
e.Raise()
Next
End Sub, "执行自定义事件 " & GetUuid())
End Sub
End Module
#End Region
''' <summary>
''' 自定义事件。
''' </summary>
Public Class CustomEvent
#Region "属性与触发"
Public Property Type As EventType = EventType.None
Public Property Data As String = Nothing
Public Sub New()
End Sub
Public Sub New(Type As EventType, Data As String)
Me.Type = Type
Me.Data = Data
End Sub
''' <summary>
''' 在当前线程中触发该自定义事件。
''' </summary>
Public Sub Raise()
Raise(Type, Data)
End Sub
#End Region
Public Enum EventType
None = 0
打开网页
打开文件
打开帮助
执行命令
启动游戏
复制文本
刷新主页
刷新页面
刷新帮助
今日人品
内存优化
清理垃圾
弹出窗口
弹出提示
切换页面
导入整合包
安装整合包
下载文件
修改设置
写入设置
修改变量
写入变量
加入房间
End Enum
''' <summary>
''' 在当前线程中触发一个自定义事件。
''' </summary>
Public Shared Sub Raise(Type As EventType, Arg As String)
If Type = EventType.None Then Return
Log($"[Control] 执行自定义事件:{Type}, {Arg}")
Try
Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", "))
Dim Args As String() = If(Arg?.Split("|"), {""})
Select Case Type
Case "打开网页"
Data(0) = Data(0).Replace("\", "/")
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
Case EventType.打开网页
Arg = Arg.Replace("\", "/")
If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Return
End If
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
Hint("正在开启中,请稍候:" & Arg)
RunInThread(Sub() OpenWebsite(Arg))
Case "打开文件", "打开帮助", "执行命令"
Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
RunInThread(
Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开帮助" Then
If Type = EventType.打开帮助 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
Return
End Select
End If
If Not EventSafetyConfirm("即将执行:" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.Arguments = If(Args.Length >= 2, Args(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
@@ -54,76 +188,118 @@
End Try
End Sub)
Case "启动游戏"
If Data(0) = "\current" Then
Case EventType.启动游戏
If Args(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Hint("请先选择一个 Minecraft 版本!", HintType.Red)
Return
Else
Data(0) = McVersionCurrent.Name
Args(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) & "……")
RunInUi(
Sub()
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Version = New McVersion(Args(0))}) Then
Hint($"正在启动 {Args(0)}……")
End If
End Sub)
Case EventType.复制文本
ClipboardSet(Arg)
Case EventType.刷新主页
RunInUi(
Sub()
FrmLaunchRight.ForceRefresh()
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
End Sub)
Case EventType.刷新页面
If TypeOf FrmMain.PageRight Is IRefreshable Then
RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
Else
Hint("当前页面不支持刷新操作!", HintType.Red)
End If
Case "复制文本"
ClipboardSet(Join(Data, "|"))
Case EventType.刷新帮助
RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
Case "刷新主页"
FrmLaunchRight.ForceRefresh()
If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
Case "刷新帮助"
PageOtherLeft.RefreshHelp()
Case "今日人品"
Case EventType.今日人品
PageOtherTest.Jrrp()
Case "内存优化"
Case EventType.内存优化
RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
Case "清理垃圾"
Case EventType.清理垃圾
RunInThread(Sub() PageOtherTest.RubbishClear())
Case "弹出窗口"
MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
Case EventType.弹出窗口
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 弹窗标题|弹窗内容")
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
Case "切换页面"
FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
Case EventType.弹出提示
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ParseToEnum(Of HintType)))
Case "导入整合包", "安装整合包"
Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange(
Args(0).ParseToEnum(Of FormMain.PageType),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ParseToEnum(Of FormMain.PageSubType))))
Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall())
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
Case EventType.下载文件
Args(0) = Args(0).Replace("\", "/")
If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Return
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
If Not EventSafetyConfirm("即将从该网址下载文件:" & vbCrLf & Args(0)) Then Return
RunInUi(
Sub()
Try
Select Case Args.Length
Case 1
PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0)))
Case 2
PageOtherTest.StartCustomDownload(Args(0), Args(1))
Case Else
PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Args(0), "未知")
End Try
End Sub)
Case "修改设置"
Setup.Set(Data(0), Data(1))
Hint($"已写入设置:{Data(0)} → {Data(1)}", HintType.Finish)
Case EventType.修改设置, EventType.写入设置
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
Setup.SetSafe(Args(0), Args(1), Version:=McVersionCurrent)
If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.修改变量, EventType.写入变量
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
WriteReg("CustomEvent" & Args(0), Args(1))
If Args.Length = 2 Then Hint($"已写入变量:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.加入房间
RunInUi(
Sub()
If String.IsNullOrWhiteSpace(Arg) Then
PageLinkMain.Join()
Else
If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
PageLinkMain.Join(Arg)
End If
End Sub)
Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
End Select
Catch ex As Exception
Log(ex, "事件执行失败", LogLevel.Msgbox)
Log(ex, $"事件执行失败({Type}, {Arg})", LogLevel.Msgbox)
End Try
End Sub
@@ -131,7 +307,7 @@
''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
''' 失败会抛出异常。
''' </summary>
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
'网页确认
If RelativeUrl.StartsWithF("http", True) Then
@@ -172,25 +348,25 @@
If RelativeUrl.Contains(":\") Then
'绝对路径
Location = RelativeUrl
Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location)
Log("[Control] 自定义事件中由绝对路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径
Location = Path & "PCL\" & RelativeUrl
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location)
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径
Location = Path & "PCL\Help\" & RelativeUrl
WorkingDir = Path & "PCL\Help\"
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location)
ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & ":" & Location)
ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径
Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & ":" & Location)
ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
'直接使用原有路径启动程序
Location = RelativeUrl
Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
Log("[Control] 自定义事件中直接" & Type & ":" & Location)
Else
'打开帮助,但是格式不对劲
Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
@@ -199,4 +375,20 @@
Return {Location, WorkingDir}
End Function
End Module
''' <summary>
''' 弹出安全确认弹窗。返回是否继续执行。
''' </summary>
Private Shared Function EventSafetyConfirm(Message As String) As Boolean
If Setup.Get("HintCustomCommand") Then Return True
Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 1
Return True
Case 2
Setup.Set("HintCustomCommand", True)
Return True
Case Else
Return False
End Select
End Function
End Class
+93 -46
View File
@@ -7,23 +7,12 @@ Public Module ModMain
''' <summary>
''' 提示信息的种类。
''' 该枚举在自定义事件中使用,是公开 API 的一部分。
''' </summary>
Public Enum HintType
''' <summary>
''' 信息,通常是蓝色的“i”。
''' </summary>
''' <remarks></remarks>
Info
''' <summary>
''' 已完成,通常是绿色的“√”。
''' </summary>
''' <remarks></remarks>
Finish
''' <summary>
''' 错误,通常是红色的“×”。
''' </summary>
''' <remarks></remarks>
Critical
Blue
Green
Red
End Enum
Private Structure HintMessage
Public Text As String
@@ -38,7 +27,7 @@ Public Module ModMain
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
@@ -68,13 +57,13 @@ Public Module ModMain
Dim TargetColor0, TargetColor1 As MyColor
Dim Percent As Double = 0.3
Select Case CurrentHint.Type
Case HintType.Info
Case HintType.Blue
TargetColor0 = New MyColor(215, 37, 155, 252)
TargetColor1 = New MyColor(215, 10, 142, 252)
Case HintType.Finish
Case HintType.Green
TargetColor0 = New MyColor(215, 33, 177, 33)
TargetColor1 = New MyColor(215, 29, 160, 29)
Case Else 'HintType.Critical
Case Else 'HintType.Red
TargetColor0 = New MyColor(215, 255, 53, 11)
TargetColor1 = New MyColor(215, 255, 43, 0)
End Select
@@ -248,10 +237,6 @@ EndHint:
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
WaitingMyMsgBox.Add(Converter)
If RunInUi() Then
'若为 UI 线程,立即执行弹窗刻, 避免快速(连点器)点击时多次弹窗
MyMsgBoxTick()
End If
If Button2.Length > 0 OrElse ForceWait Then
'若有多个按钮则开始等待
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
@@ -275,6 +260,7 @@ EndHint:
Else
Try
FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
@@ -306,6 +292,7 @@ EndHint:
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
@@ -328,6 +315,7 @@ EndHint:
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
@@ -350,7 +338,7 @@ EndHint:
ElseIf WaitingMyMsgBox.Any Then
'没有弹窗,显示一个等待的弹窗
FrmMain.PanMsg.Visibility = Visibility.Visible
Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
Select Case WaitingMyMsgBox(0).Type
Case MyMsgBoxType.Input
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Select
@@ -363,7 +351,7 @@ EndHint:
WaitingMyMsgBox.RemoveAt(0)
Else
'没有弹窗,没有等待的弹窗
If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
@@ -388,11 +376,7 @@ EndHint:
Public FrmSpeedRight As PageSpeedRight
'联机页面声明
Public FrmLinkLeft As PageLinkLeft
Public FrmLinkIoi As PageLinkIoi
Public FrmLinkHiper As PageLinkHiper
Public FrmLinkHelp As PageOtherHelpDetail
Public FrmLinkFeedback As PageLinkFeedback
Public FrmLinkMain As PageLinkMain
'下载页面声明
Public FrmDownloadLeft As PageDownloadLeft
@@ -490,7 +474,7 @@ EndHint:
''' 是否为 “执行事件”。
''' </summary>
Public IsEvent As Boolean
Public EventType As String
Public EventType As CustomEvent.EventType
Public EventData As String
''' <summary>
''' 若非执行事件,其对应的 .xaml 本地文件内容。
@@ -504,7 +488,7 @@ EndHint:
''' </summary>
Public Sub New(FilePath As String)
RawPath = FilePath
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeXML))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息
If JsonData("Title") IsNot Nothing Then
@@ -524,8 +508,7 @@ EndHint:
Next
'加载事件信息
If If(JsonData("IsEvent"), False) Then
EventType = JsonData("EventType")
If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
EventType = [Enum].Parse(GetType(CustomEvent.EventType), JsonData("EventType").ToString)
EventData = If(JsonData("EventData"), "")
IsEvent = True
Else
@@ -550,7 +533,7 @@ EndHint:
Public Function SetToListItem(Item As MyListItem) As MyListItem
Dim Logo As String
If IsEvent Then
If EventType = "弹出窗口" Then
If EventType = CustomEvent.EventType.弹出窗口 Then
Logo = PathImage & "Blocks/GrassPath.png"
Else
Logo = PathImage & "Blocks/CommandBlock.png"
@@ -567,9 +550,9 @@ EndHint:
.Height = 42
.Type = MyListItem.CheckType.Clickable
.Tag = Me
.EventType = Nothing
.EventData = Nothing
End With
CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性,它们会被下面的点击事件处理
CustomEventService.SetEventData(Item, Nothing)
'项目的点击事件
AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
Return Item
@@ -669,15 +652,6 @@ NextFile:
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
End If
End Sub
''' <summary>
''' 对帮助文件约定的替换标记进行处理,如果遇到需要转义的字符会进行转义。
''' </summary>
Public Function HelpArgumentReplace(Xaml As String) As String
Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
Return Result
End Function
#End Region
@@ -836,6 +810,79 @@ NextFile:
End Using
End Sub
''' <summary>
''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
''' </summary>
Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
'预处理
If Text Is Nothing Then Return Nothing
Dim Replacer =
Function(s As String) As String
If s Is Nothing Then Return ""
If EscapeHandler Is Nothing Then Return s
If s.Contains(":\") Then s = ShortenPath(s)
Return EscapeHandler(s)
End Function
'基础
Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
Text = Text.Replace("{pcl_version_branch}", Replacer(VersionBranchName))
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
Text = Text.Replace("{identify}", Replacer(Identify))
Text = Text.Replace("{path}", Replacer(Path))
Text = Text.Replace("{path_with_name}", Replacer(PathWithName))
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
'时间
If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy/M/d")))
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH:mm:ss")))
End If
'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
Text = Text.Replace("{minecraft}", Replacer(PathMcFolder))
If McVersionCurrent IsNot Nothing Then
Text = Text.Replace("{version_path}", Replacer(McVersionCurrent.Path)) : Text = Text.Replace("{verpath}", Replacer(McVersionCurrent.Path))
Text = Text.Replace("{version_indie}", Replacer(McVersionCurrent.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McVersionCurrent.PathIndie))
Text = Text.Replace("{name}", Replacer(McVersionCurrent.Name))
If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Name))
Else
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Version.McName))
End If
Else
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
Text = Text.Replace("{name}", Replacer(Nothing))
Text = Text.Replace("{version}", Replacer(Nothing))
End If
'登录信息
If McLoginLoader.State = LoadState.Finished Then
Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.ToLower))
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
Text = Text.Replace("{login}", Replacer("离线"))
Case McLoginType.Ms
Text = Text.Replace("{login}", Replacer("正版"))
Case McLoginType.Nide
Text = Text.Replace("{login}", Replacer("统一通行证"))
Case McLoginType.Auth
Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
End Select
Else
Text = Text.Replace("{user}", Replacer(Nothing))
Text = Text.Replace("{uuid}", Replacer(Nothing))
Text = Text.Replace("{login}", Replacer(Nothing))
End If
'高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Setup.GetSafe(m.Groups(1).Value, McVersionCurrent)))
Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text
End Function
#End Region
#Region "任务缓存"
+12 -12
View File
@@ -111,7 +111,7 @@
''' </summary>
Public Sub MusicControlPause()
If MusicNAudio Is Nothing Then
Hint("音乐播放尚未开始!", HintType.Critical)
Hint("音乐播放尚未开始!", HintType.Red)
Else
Select Case MusicState
Case MusicStates.Pause
@@ -131,14 +131,14 @@
Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then
MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Green)
Else
Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then
Hint("没有可以播放的音乐!", HintType.Critical)
Hint("没有可以播放的音乐!", HintType.Red)
Else
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Green)
End If
End If
MusicRefreshUI()
@@ -182,19 +182,19 @@
MusicListInit(True)
If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Red)
Else
MusicNAudio = Nothing
If ShowHint Then Hint("背景音乐已清除!", HintType.Finish)
If ShowHint Then Hint("背景音乐已清除!", HintType.Green)
End If
Else
Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then
If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical)
If ShowHint Then Hint("没有可以播放的音乐!", HintType.Red)
Else
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
Catch
End Try
End If
@@ -303,18 +303,18 @@
Catch ex As Exception
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Critical)
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Red)
Thread.Sleep(1000000000)
End If
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Red)
Thread.Sleep(1000000000)
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Red)
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
+13 -4
View File
@@ -6,6 +6,8 @@ Friend Module ModSecret
#Region "杂项"
'标注 PCL 的不同分支,仅用于替换标记
Public Const VersionBranchMain As String = "OpenSource"
'在开源版的注册表与常规版的注册表隔离,以防数据冲突
Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
@@ -56,13 +58,13 @@ Friend Module ModSecret
''' <summary>
''' 获取设备标识码。
''' </summary>
Friend Function SecretGetUniqueAddress() As String
Friend Function SecretGetIdentify() As String
Return "0000-0000-0000-0000"
End Function
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
DataList.Insert(0, ArgumentReplace(If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom))) '可变 JVM 参数
McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
@@ -279,9 +281,16 @@ Friend Module ModSecret
#End Region
#Region "联网通知"
#Region "联网配置"
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
''' <summary>
''' 联网获取的配置信息。
''' 若获取失败或仍在获取中,可能为 Nothing。
''' </summary>
Public ServerConfig As JObject
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
{.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
#End Region
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.10.8.0")>
<Assembly: AssemblyFileVersion("2.10.8.0")>
<Assembly: AssemblyVersion("2.11.1.0")>
<Assembly: AssemblyFileVersion("2.11.1.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -34,7 +34,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.8" />
<local:MyComboBoxItem Content="1.21.10" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -290,9 +290,9 @@
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Critical)
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Hint(MyLoader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
Return '不重新加载版本列表
End Select
@@ -326,7 +326,7 @@
Dim DefaultFolder As String = Nothing
If File.Type <> CompType.ModPack Then
Dim SubFolder As String = Nothing
Select Case Project.Type
Select Case File.Type
Case CompType.Mod : SubFolder = "mods\"
Case CompType.ResourcePack : SubFolder = "resourcepacks\"
Case CompType.Shader : SubFolder = "shaderpacks\"
@@ -346,7 +346,7 @@
Function(Version)
If Not Version.IsLoaded Then Version.Load()
'只对 Mod 和数据包进行版本检测
If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then
If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
End If
@@ -359,8 +359,8 @@
Return False
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(Project.Type) Then
DefaultFolder = CachedFolder(Project.Type)
If CachedFolder.ContainsKey(File.Type) Then
DefaultFolder = CachedFolder(File.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}"
@@ -425,7 +425,7 @@
If Not Target.Contains("\") Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(Project.Type) = GetPathFromFullPath(Target)
If Target <> DefaultFolder Then CachedFolder(File.Type) = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动
@@ -1,5 +1,4 @@
Imports System.IO.Compression
Imports System.Net.Http
Public Module ModDownloadLib
@@ -32,7 +31,7 @@ Public Module ModDownloadLib
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return OngoingLoader
Next
@@ -100,7 +99,8 @@ Public Module ModDownloadLib
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim Version As New McVersion(VersionFolder)
Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)}
Dim AssetIndex = DlClientAssetIndexGet(Version)
Task.Output = If(AssetIndex Is Nothing, New List(Of NetFile), New List(Of NetFile) From {AssetIndex})
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
@@ -223,7 +223,7 @@ Public Module ModDownloadLib
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 服务端下载" Then Continue For
Hint("该服务端正在下载中!", HintType.Critical)
Hint("该服务端正在下载中!", HintType.Red)
Return
Next
@@ -241,7 +241,7 @@ Public Module ModDownloadLib
File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder)
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Critical)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Abort()
Return
@@ -300,7 +300,7 @@ pause"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -401,7 +401,7 @@ pause"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -832,7 +832,7 @@ Retry:
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -866,7 +866,7 @@ Retry:
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -1048,7 +1048,7 @@ Retry:
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -1345,7 +1345,7 @@ Retry:
Dim RawJson As JObject = GetJson(NetRequestByLoader(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim Address = McLibGet(OriginalName).Replace(".jar", "." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
@@ -1803,7 +1803,7 @@ Retry:
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Red)
Return
Next
@@ -1986,28 +1986,28 @@ Retry:
''' 在加载器状态改变后显示一条提示。
''' 不会进行任何其他操作。
''' </summary>
Public Sub LoaderStateChangedHintOnly(Loader)
Public Sub LoaderStateChangedHintOnly(Loader As LoaderBase)
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Critical)
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Hint(Loader.Name & "已取消!", HintType.Blue)
End Select
End Sub
''' <summary>
''' 安装加载器状态改变后进行提示和重载文件夹列表的方法。
''' </summary>
Public Sub McInstallState(Loader)
Public Sub McInstallState(Loader As LoaderBase)
Select Case Loader.State
Case LoadState.Finished
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存(合并安装会先生成文件夹,这会在刷新时误判为可以使用缓存)
Hint(Loader.Name & "成功!", HintType.Finish)
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Critical)
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Hint(Loader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
Return '不重新加载版本列表
End Select
@@ -2108,7 +2108,7 @@ Retry:
'重复版本检查
If File.Exists($"{VersionFolder}{Request.TargetVersionName}.json") Then
Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Critical)
Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Red)
Throw New CancelledException
End If
@@ -613,16 +613,16 @@
PanMinecraft.Children.Clear()
'添加最新版本
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 15, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim PinnedVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
PinnedVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
PinnedVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = PinnedVersions}
MyCard.StackInstall(PanInfo, 7)
CardInfo.Children.Add(PanInfo)
PanMinecraft.Children.Insert(0, CardInfo)
@@ -630,7 +630,7 @@
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7}
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
@@ -5,7 +5,7 @@
<local:MyScrollViewer PanningMode="VerticalOnly" HorizontalScrollBarVisibility="Disabled" VerticalScrollBarVisibility="Auto" Style="{StaticResource ScrollViewerFullMargin}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="原版游戏"
Logo="m351.9,801.7c-8.6,0-17-3-23.7-8.4L18.9,614.7c-12.5-7.2-19.7-20.5-18.8-34.9V221c-.7-15,6.6-28.8,19.2-36L325.2,8.3c6.6-5.3,15.1-8.3,24-8.3s17.3,2.9,23.9,8.2l308.3,178c.2.1.5.3.8.5h0c12,6.7,19.4,19.8,19.4,34.1,0,13.9-7.1,26-18.7,32.5l-290.1,167.5v276l234-135.1v-168.9c0-20.8,17-37.8,37.8-37.8s37.8,17,37.8,37.8v191.7c0,16.4-10.9,31.2-26.5,36.1l-299.4,172.8c-6.7,5.4-15.1,8.3-23.7,8.3h-.9Zm-34.8-101.9v-276l-241.4-139.4v276l241.4,139.4Zm35.3-342.8l236.8-136.7-240-138.6L112.4,218.3l240,138.6Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -1,8 +1,8 @@
<Grid x:Class="MyMsgLogin"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
RenderTransformOrigin="0,0.5" UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="400" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="25">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
RenderTransformOrigin="0,0.5" UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="400" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="25">
<Grid.RenderTransform>
<TransformGroup>
<RotateTransform x:Name="TransformRotate" Angle="-4" />
@@ -23,17 +23,17 @@
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
<local:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
</local:MyScrollViewer>
<StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="重新打开网页" x:Name="Btn1" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="打开网页" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="复制代码" x:Name="Btn2" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="复制文本" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="取消" x:Name="Btn3" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False" />
<local:MyButton ColorType="Normal" x:FieldModifier="public" Text="重新打开网页" x:Name="Btn1" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
local:CustomEventService.EventType="打开网页" />
<local:MyButton ColorType="Normal" x:FieldModifier="public" Text="复制代码" x:Name="Btn2" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
local:CustomEventService.EventType="复制文本" />
<local:MyButton ColorType="Normal" x:FieldModifier="public" Text="取消" x:Name="Btn3" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
</Border>
@@ -89,14 +89,14 @@
$"登录网页将自动开启,请在网页中输入 {UserCode}(已自动复制)。" & vbCrLf & vbCrLf &
$"如果网络环境不佳,网页可能一直加载不出来,届时请使用加速器或 VPN 改善网络环境。" & vbCrLf &
$"你也可以用其他设备打开 {Website} 并输入上述代码。"
Btn1.EventData = Website
Btn2.EventData = UserCode
CustomEventService.SetEventData(Btn1, Website)
CustomEventService.SetEventData(Btn2, UserCode)
'启动工作线程
RunInNewThread(AddressOf WorkThread, "MyMsgLogin")
End Sub
Private Sub WorkThread()
Thread.Sleep(3000)
Thread.Sleep(2000)
If MyConverter.IsExited Then Return
OpenWebsite(Website)
ClipboardSet(UserCode)
@@ -118,7 +118,7 @@
'获取结果
Dim ResultJson As JObject = GetJson(Result)
McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒")
Hint("网页登录成功!", HintType.Finish)
Hint("网页登录成功!", HintType.Green)
Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString})
Return
Catch ex As Exception
@@ -47,7 +47,7 @@
Public Shared Sub Save(Loader As LoaderTask(Of EqualableList(Of String), String))
Dim Address = Loader.Output
If Not Loader.State = LoadState.Finished Then
Hint("皮肤正在获取中,请稍候!", HintType.Critical)
Hint("皮肤正在获取中,请稍候!", HintType.Red)
If Not Loader.State = LoadState.Loading Then Loader.Start()
Return
End If
@@ -61,7 +61,7 @@
Else
CopyFile(Address, FileAddress)
End If
Hint("皮肤保存成功!", HintType.Finish)
Hint("皮肤保存成功!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "保存皮肤失败", LogLevel.Hint)
@@ -143,7 +143,7 @@
Next
If FrmLaunchLeft IsNot Nothing AndAlso HasLoaderRunning Then
'由于 Abort 不是实时的,暂时不会释放文件,会导致删除报错,故只能取消执行
Hint("有正在获取中的皮肤,请稍后再试!", HintType.Info)
Hint("有正在获取中的皮肤,请稍后再试!", HintType.Blue)
Else
RunInThread(
Sub()
@@ -161,7 +161,7 @@
For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs})
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
Hint("已刷新头像!", HintType.Finish)
Hint("已刷新头像!", HintType.Green)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
End Try
@@ -184,7 +184,7 @@
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
'完成提示
Hint("更改皮肤成功!", HintType.Finish)
Hint("更改皮肤成功!", HintType.Green)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
End Try
@@ -212,7 +212,7 @@
Return
End If
If McLoginMsLoader.State = LoadState.Failed Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Hint("登录失败,无法更改披风!", HintType.Red)
Return
End If
Hint("正在获取披风列表,请稍候……")
@@ -225,7 +225,7 @@ Retry:
'获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Hint("登录失败,无法更改披风!", HintType.Red)
Return
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
@@ -244,7 +244,7 @@ Retry:
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"},
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -265,10 +265,10 @@ Retry:
ContentType:="application/json",
Headers:={{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage").ToString, HintType.Critical)
Hint("更改披风失败:" & GetJson(Result)("errorMessage").ToString, HintType.Red)
Return
Else
Hint("更改披风成功!", HintType.Finish)
Hint("更改披风成功!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
@@ -110,11 +110,7 @@
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
LabLaunchingMethod.Text = "离线登录"
Case McLoginType.Ms
LabLaunchingMethod.Text = "正版登录"
Case McLoginType.Nide
@@ -104,6 +104,9 @@ Public Class PageLaunchRight
Case 12
Log("[Page] 主页预设:PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.org/Custom.xaml"
Case 13
Log("[Page] 主页预设:PCL 更新摘要")
Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml"
End Select
End Select
'联网下载
@@ -113,14 +116,14 @@ Public Class PageLaunchRight
Log("[Page] 主页自定义数据来源:联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml")
'后台更新缓存
OnlineLoader.Start(Url)
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, False))
Else
'缓存不可用
Log("[Page] 主页自定义数据来源:联网全新下载")
Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面
Setup.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(Url) '下载完成后将会再次触发更新
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新
Return
End If
End If
@@ -130,10 +133,13 @@ Public Class PageLaunchRight
Private RefreshLock As New Object
'联网获取主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化
Private OnlineLoader As New LoaderTask(Of Tuple(Of String, Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of Tuple(Of String, Boolean), Integer))
Dim Address As String = Task.Input.Item1 '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.Item2
Try
'替换自定义变量与设置
Address = ArgumentReplace(Address, AddressOf WebUtility.HtmlEncode)
'获取版本校验地址
Dim VersionAddress As String
If Address.Contains(".xaml") Then
@@ -146,29 +152,27 @@ Public Class PageLaunchRight
End If
'校验版本
Dim Version As String = ""
Dim NeedDownload As Boolean = True
Try
Version = NetRequestByClientRetry(VersionAddress)
If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
NeedDownload = False
Else
Log($"[Page] 需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
Return
End If
Log($"[Page] 需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
Catch exx As Exception
Log(exx, $"联网获取主页版本失败", LogLevel.Developer)
Log($"[Page] 无法检查联网主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
If Not NeedDownload Then Return
Dim FileContent As String = NetRequestByClientRetry(Address)
Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
Refresh() '要求刷新
'若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
Catch ex As Exception
Log(ex, $"下载主页失败({Address})", If(ModeDebug, LogLevel.Msgbox, LogLevel.Hint))
End Try
@@ -195,7 +199,7 @@ Public Class PageLaunchRight
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = ""
OnlineLoader.Input = New Tuple(Of String, Boolean)("", True)
Setup.Set("CacheSavedPageUrl", "")
Setup.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空主页缓存")
@@ -220,7 +224,7 @@ Public Class PageLaunchRight
End If
Dim LoadStartTime As Date = Date.Now
'修改时应同时修改 PageOtherHelpDetail.Init
Content = HelpArgumentReplace(Content)
Content = ArgumentReplace(Content, AddressOf EscapeXML)
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
@@ -50,7 +50,7 @@
If CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then
Hint("正在尝试更换,请稍候!")
Else
Hint("正在登录中,请稍后再更换角色!", HintType.Critical)
Hint("正在登录中,请稍后再更换角色!", HintType.Red)
End If
Return
End If
@@ -68,7 +68,7 @@ Public Class PageLoginLegacy
End Sub
Private Sub Skin_Click() Handles Skin.Click
If (Setup.Get("UiHiddenPageSetup") OrElse Setup.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
Hint("启动设置已被禁用!", HintType.Critical)
Hint("启动设置已被禁用!", HintType.Red)
Else
FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面
End If
@@ -27,9 +27,9 @@
<ColumnDefinition Width="30" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<local:MyTextButton Text="» 购买正版" EventType="打开网页" EventData="https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"
<local:MyTextButton Text="» 购买正版" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"
Grid.Column="0" />
<local:MyTextButton Text="» 前往官网" EventType="打开网页" EventData="https://www.minecraft.net/zh-hans"
<local:MyTextButton Text="» 前往官网" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://www.minecraft.net/zh-hans"
Grid.Column="2" />
</Grid>
</Grid>
@@ -90,7 +90,7 @@
Catch ex As Exception
If ex.Message = "$$" Then
ElseIf ex.Message.StartsWith("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Critical)
Hint(ex.Message.TrimStart("$"), HintType.Red)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
Else
@@ -77,7 +77,7 @@
Return
End If
If McLoginLoader.State = LoadState.Failed Then
Hint("登录失败,无法更改皮肤!", HintType.Critical)
Hint("登录失败,无法更改皮肤!", HintType.Red)
Return
End If
Dim SkinInfo As McSkinInfo = McSkinSelect()
@@ -106,7 +106,7 @@ Retry:
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败:" & GetJson(Result)("error").ToString, HintType.Critical)
Hint("更改皮肤失败:" & GetJson(Result)("error").ToString, HintType.Red)
Return
End If
'获取新皮肤地址
@@ -121,8 +121,8 @@ Retry:
Next
Throw New Exception("未知错误(" & Result & ")")
Catch ex As Exception
If TypeOf ex Is OperationCanceledException Then
Hint("更改皮肤失败:连接皮肤服务器超时,请稍后再试,或使用 VPN 改善网络环境", HintType.Critical)
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then
Hint("更改皮肤失败:连接皮肤服务器超时,请稍后再试,或使用 VPN 改善网络环境", HintType.Red)
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
End If
@@ -1,38 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkFeedback"
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<local:MyCard Title="关于" Margin="0,0,0,15">
<StackPanel Margin="20,40,18,18">
<TextBlock TextWrapping="Wrap" Text="多人联机服务由速聚授权提供,PCL 仅为速聚提供多人联机服务入口,使用中遇到的任何问题由速聚负责处理。你在使用多人联机服务过程中所遇到的任何问题与纠纷(包括其付费业务)均与 PCL 无关,应与速聚协商解决。"
Margin="0,0,0,3" />
<TextBlock TextWrapping="Wrap" Text="PCL 作者并不会从速聚的付费业务中获得任何分成、奖金等报酬,请不要瞎说。"
Margin="0,0,0,6" />
<local:MyListItem Title="速聚官网" Info="打开速聚的官方网站"
Type="Clickable" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html"
Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="授权协议书" Info="查看速聚与 PCL 间的授权协议书"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/0l3NVXYzeXhb903R"
Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="用户协议与隐私政策" Info="查看速聚的用户协议与隐私政策文档"
Type="Clickable" EventType="打开网页" EventData="https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkxMTMyODk3Mg==&amp;action=getalbum&amp;album_id=2585385685407514625&amp;scene=173&amp;from_msgid=2247483720&amp;from_itemidx=1&amp;count=3&amp;nolastread=1#wechat_redirect"
Logo="pack://application:,,,/images/Blocks/Grass.png" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="发送反馈" Margin="0,0,0,15">
<StackPanel Margin="20,40,18,18">
<local:MyListItem Title="联机反馈与交流" Info="加入联机模块官方 QQ 群反馈联机异常,或询问联机功能的使用方式"
Type="Clickable" Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png"
EventType="打开网页" EventData="https://shimo.im/docs/KrkEVXz1K0frowAJ#anchor-7qQG" />
<local:MyListItem Title="违法违规举报" Info="投诉、举报联机使用者的各类违法违规行为"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW#anchor-7x6P"
Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png" />
</StackPanel>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,2 +0,0 @@
Public Class PageLinkFeedback
End Class
@@ -1,235 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkHiper"
d:DesignWidth="800" d:DesignHeight="800">
<Grid>
<Grid x:Name="PanLoad">
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" x:Name="CardLoad">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="30" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="20" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="18" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="23" />
</Grid.RowDefinitions>
<local:MyLoading Grid.Column="1" Grid.Row="1" x:Name="Load" Grid.RowSpan="3" Margin="0,0,0,-30" HorizontalAlignment="Center"
Text="" TextError="" TextErrorInherit="False" AutoRun="False" IsHitTestVisible="False" />
<TextBlock x:Name="LabLoadTitle" Grid.Column="3" Grid.Row="1" Grid.ColumnSpan="2" VerticalAlignment="Center" Text="正在创建联机房间" FontSize="19"
Margin="0,0,25,1" Foreground="{Binding Foreground, ElementName=Load}" IsHitTestVisible="False" />
<TextBlock x:Name="LabLoadDesc" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" VerticalAlignment="Center" Margin="0,5,10,-5" Text="下载联机模块中……" FontSize="14"
LineHeight="19" MaxWidth="400" MaxHeight="220" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray3}" IsHitTestVisible="False" />
<local:MyIconButton Grid.Column="5" Grid.Row="1" x:Name="BtnLoadCancel" Height="28" Width="28" VerticalAlignment="Top"
Theme="Black" Opacity="0.5"
ToolTip="取消" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100"
LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
<Grid Height="12" VerticalAlignment="Bottom" Grid.ColumnSpan="100" Grid.RowSpan="100" Margin="0,0,0,-0.6">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="0*" x:Name="ColumnProgressA" />
<ColumnDefinition Width="1*" x:Name="ColumnProgressB" />
</Grid.ColumnDefinitions>
<Grid.Clip>
<RectangleGeometry RadiusX="6" RadiusY="6" x:Name="RectProgressClip" />
</Grid.Clip>
<Rectangle Fill="{Binding Foreground, ElementName=Load}" VerticalAlignment="Bottom" Height="2" />
</Grid>
</Grid>
</local:MyCard>
</Grid>
<Grid x:Name="PanContent">
<Grid x:Name="PanCert">
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" /> <!--Logo-->
<ColumnDefinition Width="10" />
<ColumnDefinition Width="1*" /> <!--文本区 ↓↓-->
<ColumnDefinition Width="Auto" /> <!--按钮 1-->
<ColumnDefinition Width="Auto" /> <!--按钮 2-->
<ColumnDefinition Width="25" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="21" />
<RowDefinition Height="Auto" /> <!--标题栏-->
<RowDefinition Height="Auto" /> <!--文本区-->
<RowDefinition Height="Auto" /> <!--文本框-->
<RowDefinition Height="Auto" /> <!--按钮-->
<RowDefinition Height="21" />
</Grid.RowDefinitions>
<Path Grid.Column="1" Grid.Row="1" Height="25" Width="25"
Stretch="Uniform" Fill="{DynamicResource ColorBrush3}"
Data="M856.3 291.1c-12-29.6-29.5-56-52.2-78.6-22.6-22.6-49.1-40.2-78.6-52.2-28.5-11.5-58.5-17.4-89.3-17.4s-60.8 5.9-89.3 17.4c-29.6 12-56 29.5-78.6 52.2-22.6 22.6-40.2 49.1-52.2 78.6-11.5 28.5-17.4 58.5-17.4 89.3 0 30.8 5.9 60.8 17.4 89.3 1.5 3.6 3 7.2 4.6 10.7l-238 238c-19 19-30.4 43.4-32.3 68.7-2 26.9 6.9 51.6 25 69.5C191.9 873 214 881 236.9 881c27 0 55.2-11.2 77.1-33l40.4-40.4c12.5-12.5 17.6-30.4 13.2-46.6-3.2-11.7 1.5-25.9 11.8-36.3 10.3-10.3 24.5-15 36.2-11.8 16.3 4.4 34.2-0.7 46.8-13.3l95.1-95.1c25.3 8.9 51.6 13.4 78.6 13.4 30.8 0 60.8-5.9 89.3-17.4 29.6-12 56-29.5 78.6-52.2 22.6-22.6 40.2-49.1 52.2-78.6 11.5-28.5 17.4-58.5 17.4-89.3 0.1-30.7-5.7-60.8-17.3-89.3zM427.2 664.2c-28.7-7.1-60.4 2.5-83 25.1-22.7 22.7-32.2 54.4-25.1 83l-40.3 40.3c-20.7 20.7-51.8 24.5-68 8.4-7.6-7.5-11.3-18.3-10.4-30.4 1-13.4 7.3-26.6 17.8-37l229.2-229.2c6.4 8.4 13.4 16.3 20.9 23.9 12.7 12.7 26.6 23.8 41.6 33.2l-82.7 82.7zM810 450.9c-9.5 23.3-23.3 44.2-41.2 62.1-17.9 17.9-38.7 31.7-62.1 41.2-22.5 9.1-46.2 13.7-70.5 13.7-24.3 0-48-4.6-70.5-13.7-2.5-1.7-5.3-2.8-8.1-3.5-20.1-9.3-38.2-21.9-54-37.7-17.9-17.9-31.7-38.7-41.2-62.1-9.1-22.5-13.7-46.2-13.7-70.5 0-24.3 4.6-48 13.7-70.5 9.5-23.3 23.3-44.2 41.2-62.1 17.9-17.9 38.7-31.7 62.1-41.2 22.5-9.1 46.2-13.7 70.5-13.7s48 4.6 70.5 13.7c23.3 9.5 44.2 23.3 62.1 41.2 17.9 17.9 31.7 38.7 41.2 62.1 9.1 22.5 13.7 46.2 13.7 70.5 0 24.3-4.6 48-13.7 70.5z M551.5 295.7c-22.6 22.6-35.1 52.7-35.1 84.7s12.5 62.1 35.1 84.7c23.4 23.4 54 35 84.7 35 30.7 0 61.4-11.7 84.7-35 22.6-22.6 35.1-52.7 35.1-84.7s-12.5-62.1-35.1-84.7c-46.7-46.7-122.7-46.7-169.4 0z m134.1 134.1c-27.2 27.2-71.5 27.2-98.7 0-13.2-13.2-20.4-30.7-20.4-49.4 0-18.6 7.3-36.2 20.4-49.4 13.6-13.6 31.5-20.4 49.4-20.4s35.7 6.8 49.4 20.4c13.2 13.2 20.4 30.7 20.4 49.4-0.1 18.7-7.3 36.2-20.5 49.4z" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1" x:Name="LabCertTitle"
Text="输入索引码" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="0,10,0,6"
Text="你需要获取索引码才能使用 HiPer。&#xa;如果实在没有索引码,可以在左侧选择 IOI 方式联机。" x:Name="LabCertDesc"
FontSize="14" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray2}" />
<local:MyTextBox x:Name="TextCert" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="3"
Margin="0,0,0,12" Width="400" MaxLength="100" Height="28">
<local:MyTextBox.ValidateRules>
<local:ValidateNullOrWhiteSpace />
<local:ValidateRegex Regex="^[^\u4e00-\u9fa5]{6,}$" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<local:MyButton Grid.Column="4" Grid.Row="4" Margin="0,0,15,0" Text="获取索引码" Padding="13,8" EventType="打开网页" EventData="https://shimo.im/docs/KrkEVXz1K0frowAJ" />
<local:MyButton x:Name="BtnCertDone" Grid.Column="5" Grid.Row="4" Text="确定" ColorType="Highlight" Padding="13,8" IsEnabled="False" />
</Grid>
</local:MyCard>
</Grid>
<Grid x:Name="PanSelect" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="480" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="120" />
<RowDefinition Height="20" />
<RowDefinition Height="120" />
<RowDefinition Height="20" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<local:MyCard x:Name="BtnSelectCreate" Grid.Column="1" Grid.Row="1">
<Grid Margin="35,0,25,0" IsHitTestVisible="False">
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="30" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Path Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" Margin="0,25,0,12"
Data="M904.479163 416.014006c-41.499044-0.199995-78.198199 20.799521-99.797701 52.698786-4.499896 6.699846-13.299694 9.09979-20.499527 5.399876L398.590818 280.017139c-6.999839-3.499919-10.39976-11.69973-7.999816-19.199557 6.099859-19.199558 9.399783-39.599088 9.399783-60.7986C399.990785 88.721546 308.092902-1.676371 196.795466 0.023589 87.797977 1.72355 0 90.621502 0 200.018982c0 92.597867 62.898551 170.396075 148.196586 193.195549 6.999839 1.899956 11.799728 8.199811 11.799728 15.399646v253.994148c0 7.199834-4.799889 13.399691-11.599733 15.399646C81.198129 697.007533 31.999263 758.806109 31.999263 832.004423c0 88.597959 71.998341 160.296307 160.5963 159.996314 88.09797-0.299993 159.396328-71.798346 159.396328-159.996314v-1.399968c-0.099998-6.099859 3.399922-11.69973 8.799797-14.399668l425.990187-214.495059c6.999839-3.499919 15.499643-1.499965 20.099537 4.79989 21.799498 29.999309 57.198682 49.598857 97.197761 49.598857 66.898459 0 120.997213-54.69874 119.997235-121.797194-1.099975-65.198498-54.498745-118.097279-119.597245-118.297275zM103.797609 296.216766C78.198199 270.517358 63.998526 236.318146 63.998526 200.018982c0-36.299164 14.199673-70.498376 39.799083-96.197784C129.497017 78.12179 163.696229 64.022115 199.995393 64.022115s70.498376 14.099675 96.197784 39.799083c25.699408 25.699408 39.799083 59.798622 39.799083 96.197784 0 15.499643-2.59994 30.499297-7.499828 44.69897-6.599848 19.199558-17.599595 36.699155-32.399253 51.498814-0.899979 0.899979-1.799959 1.699961-2.59994 2.59994-19.499551 18.399576-43.498998 30.499297-69.498399 35.099192-7.79982 1.399968-15.899634 2.099952-23.999447 2.099951-13.799682 0-27.199373-1.999954-39.999079-5.999862-20.999516-6.399853-40.199074-17.899588-56.198705-33.799221z m181.595816 557.887148c-9.99977 42.299026-48.098892 73.898298-93.397848 73.898298-52.898781 0-95.997788-43.099007-95.997789-95.997789 0-41.699039 26.799383-77.298219 63.998526-90.497915 9.99977-3.599917 20.799521-5.499873 31.999263-5.499873s21.999493 1.899956 31.999263 5.499873c22.699477 7.999816 41.499044 24.399438 52.698786 45.398954 7.199834 13.499689 11.29974 28.799337 11.299739 45.098961 0 7.599825-0.899979 14.999654-2.59994 22.099491z m41.299049-108.597498c-20.799521-32.399254-52.998779-56.698694-90.897906-67.498445-6.899841-1.999954-11.799728-8.199811-11.799728-15.399646V412.314091c0-7.699823 5.499873-14.299671 12.9997-15.699638 42.299026-7.899818 79.898159-29.09933 108.297505-59.098638 4.799889-5.099883 12.499712-6.399853 18.69957-3.199927l377.291308 189.995623c11.69973 5.899864 11.69973 22.699477 0 28.599342l-393.990924 198.395429c-7.299832 3.699915-16.199627 1.199972-20.599525-5.799866zM903.979175 592.009952c-19.699546 0-37.099145-10.299763-47.098915-25.699408-5.599871-8.6998-8.899795-19.09956-8.899795-30.299302 0-9.499781 2.399945-18.499574 6.599848-26.399392C863.980096 492.012255 882.579668 480.012532 903.979175 480.012532c30.899288 0 55.99871 25.099422 55.99871 55.99871s-25.099422 55.99871-55.99871 55.99871z" />
<TextBlock Grid.Row="1" Text="创建房间" Margin="0,0,0,25" FontSize="20" Foreground="{DynamicResource ColorBrush3}" HorizontalAlignment="Center" />
<TextBlock Grid.RowSpan="2" Grid.Column="2" LineHeight="23" FontSize="14" TextWrapping="Wrap" VerticalAlignment="Center" Margin="0,7,0,0"
Text="1、打开游戏,在暂停画面选择【对局域网开放】&#xa;2、点击这里,并输入游戏显示的端口号&#xa;3、将联机码发送给你的朋友" />
</Grid>
</local:MyCard>
<local:MyCard x:Name="BtnSelectJoin" Grid.Column="1" Grid.Row="3">
<Grid Margin="35,0,25,0" IsHitTestVisible="False">
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="30" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Path Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" Margin="0,25,0,12"
Data="M896 64H544c-17.7 0-32 14.3-32 32s14.3 32 32 32h352c35.3 0 64 28.7 64 64v640c0 35.3-28.7 64-64 64H544c-17.7 0-32 14.3-32 32s14.3 32 32 32h352c70.7 0 128-57.3 128-128V192c0-70.7-57.3-128-128-128z M821.3 488.3L458.9 160.7c-41.2-37.2-106.9-8-106.9 47.5V339c0 4.4-3.6 8-8 8H32c-17.7 0-32 14.3-32 32v266c0 17.7 14.3 32 32 32h312c4.4 0 8 3.6 8 8v130.9c0 55.5 65.8 84.7 106.9 47.5l362.4-327.6c14.1-12.8 14.1-34.8 0-47.5zM64 597V427c0-8.8 7.2-16 16-16h304c17.7 0 32-14.3 32-32V244.9c0-13.9 16.4-21.2 26.7-11.9L746 506.1c3.5 3.2 3.5 8.7 0 11.9L442.7 791c-10.3 9.3-26.7 2-26.7-11.9V645c0-17.7-14.3-32-32-32H80c-8.8 0-16-7.2-16-16z" />
<TextBlock Grid.Row="1" Text="加入房间" Margin="0,0,0,25" FontSize="20" Foreground="{DynamicResource ColorBrush3}" HorizontalAlignment="Center" />
<TextBlock Grid.RowSpan="2" Grid.Column="2" LineHeight="23" FontSize="14" TextWrapping="Wrap" VerticalAlignment="Center" Margin="0,7,10,0" HorizontalAlignment="Center"
Text="点击这里,然后输入朋友发送给你的联机码" />
</Grid>
</local:MyCard>
<local:MyCard x:Name="BtnSelectReturn" Grid.Column="1" Grid.Row="5" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" IsHitTestVisible="False" Margin="15,12">
<Path Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" Height="13" Margin="0,0,8,0"
Data="M268.70922 566.468085h929.588652c36.312057 0 72.624113-29.049645 72.624114-72.624113 0-36.312057-29.049645-72.624113-72.624114-72.624114H305.021277l297.758865-297.758865c29.049645-29.049645 29.049645-72.624113 0-101.673759-29.049645-29.049645-72.624113-29.049645-101.673759 0L72.624113 450.269504c-14.524823 14.524823-21.787234 36.312057-21.787234 58.09929 0 21.787234 0 43.574468 21.787234 58.099291l428.48227 428.48227c29.049645 29.049645 72.624113 29.049645 101.673759 0 29.049645-29.049645 29.049645-72.624113 0-101.673759l-334.070922-326.808511z" />
<TextBlock Text="修改索引码" FontSize="14" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock Text="(28F…)" x:Name="LabSelectCode" FontSize="12" Foreground="{DynamicResource ColorBrushGray4}" VerticalAlignment="Bottom" Margin="5,0,0,0.5" />
</StackPanel>
</local:MyCard>
</Grid>
<Grid x:Name="PanFinish" Visibility="Collapsed" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="0,-50,0,0">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="0,0,0,20">
<StackPanel Orientation="Horizontal" Margin="3,0">
<StackPanel x:Name="BtnFinishQuality" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="连接状况" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-35">
<Path IsHitTestVisible="False" Height="14" Width="14" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" Margin="12,1,7,0"
Data="M512 128c212.064 0 384 171.936 384 384s-173.632 384-384 384C299.936 896 128 724.064 128 512S299.936 128 512 128z m-126.4 575.968c-1.728 40.8 3.52 76.8 36.32 115.2 28.576 8.32 58.816 12.832 90.08 12.832 81.984 0 156.8-30.848 213.408-81.536-77.12 7.2-161.6-5.952-289.216-61.856-11.616 7.52-18.976 12.608-50.592 15.36z m-193.44-202.368c0 123.744 53.536 214.272 135.744 272.16-6.08-25.6-8.352-48.448-4.96-91.68-21.344-17.6-34.944-39.264-34.624-82.08-50.816-42.88-82.88-75.712-96.16-98.4zM544 448c-14.944 0-29.12-3.424-41.728-9.504-10.976 12.96-21.376 26.432-31.2 40.512-4.832 6.912-15.36 23.776-31.616 50.624a95.872 95.872 0 0 1 36.384 106.432c155.52 68.16 302.56 62.048 325.952 11.904 23.36-50.112-35.968-139.776-189.504-228.48A95.68 95.68 0 0 1 544 448z m-160 128a32 32 0 1 0 0 64 32 32 0 0 0 0-64z m-161.92-199.2c-16.576 35.52 16.96 99.68 94.08 163.2a95.936 95.936 0 0 1 59.616-27.648c19.936-35.008 30.72-52.736 42.88-70.08 10.944-15.648 22.528-30.656 38.432-49.44-5.696-12.128-8.96-25.6-9.088-39.872-118.176-30.4-206.88-16.96-225.92 23.84z m415.136-47.84c1.824 7.36 3.296 19.104 2.336 32.416 88.96 48.704 153.76 105.056 192.32 160.704 0-118.656-34.208-176.064-75.52-210.976-49.792-5.92-69.952-4.064-119.136 17.856zM544 320a32 32 0 1 0 0 64 32 32 0 0 0 0-64z m-32-128c-82.016 0-156.8 30.848-213.44 81.6 47.264-4.384 96-0.544 170.304 18.624A95.84 95.84 0 0 1 544 256c21.568 0 41.472 7.104 57.504 19.104 35.968-17.28 62.016-25.824 87.136-29.984A318.528 318.528 0 0 0 512 192z" />
<TextBlock x:Name="LabFinishQuality" IsHitTestVisible="False" Text="优秀" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0,12,0" />
</StackPanel>
<TextBlock Text="|" Opacity="0.3" Margin="0,8.8,0,8" RenderTransformOrigin="0.5,0.5">
<TextBlock.RenderTransform>
<ScaleTransform ScaleX="1" ScaleY="2.75" CenterX="0.5" CenterY="0.5" />
</TextBlock.RenderTransform>
</TextBlock>
<StackPanel x:Name="BtnFinishPing" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="与房主的延迟(点击刷新)" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-35">
<Path IsHitTestVisible="False" Height="14" Width="14" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" Margin="12,0,7,0"
Data="M512 409.6a102.4 102.4 0 0 0-51.2 190.464V1024h102.4v-423.936A102.4 102.4 0 0 0 512 409.6z M512 0a512 512 0 0 0-263.168 950.272l51.2-87.552a409.6 409.6 0 1 1 420.864 0l51.2 87.552A512 512 0 0 0 512 0z M819.2 512a307.2 307.2 0 1 0-464.896 263.168l51.2-88.064a204.8 204.8 0 1 1 209.92 0l51.2 88.064A307.2 307.2 0 0 0 819.2 512z" />
<TextBlock x:Name="LabFinishPing" IsHitTestVisible="False" Text="15ms" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0,12,0" />
</StackPanel>
<TextBlock Text="|" x:Name="LineFinishPing" Opacity="0.3" Margin="0,8.8,0,8" RenderTransformOrigin="0.5,0.5">
<TextBlock.RenderTransform>
<ScaleTransform ScaleX="1" ScaleY="2.75" CenterX="0.5" CenterY="0.5" />
</TextBlock.RenderTransform>
</TextBlock>
<StackPanel x:Name="BtnFinishIp" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="服务器 IP 地址(点击复制)" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-35">
<Path IsHitTestVisible="False" Height="11" Width="11" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" Margin="12,0,7,0"
Data="M277.333333 853.333333H192V170.666667h85.333333z m341.333334-597.333333h-170.666667v256h170.666667a128 128 0 0 0 0-256m0-85.333333a213.333333 213.333333 0 0 1 0 426.666666h-170.666667v256h-85.333333V170.666667z" />
<TextBlock x:Name="LabFinishIp" IsHitTestVisible="False" Text="6.0.0.1:12345" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0,12,0" />
</StackPanel>
<TextBlock Text="|" Opacity="0.3" Margin="0,8.8,0,8" RenderTransformOrigin="0.5,0.5">
<TextBlock.RenderTransform>
<ScaleTransform ScaleX="1" ScaleY="2.75" CenterX="0.5" CenterY="0.5" />
</TextBlock.RenderTransform>
</TextBlock>
<StackPanel Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="索引码剩余时间" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-35">
<Path IsHitTestVisible="False" Height="13" Width="13" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" Margin="12,0,7,0"
Data="M832 64H192c-35.2 0-64 28.8-64 64v192c0 14.532 4.918 27.965 13.158 38.739a63.808 63.808 0 0 0 5.94 6.869L293.49 512 147.098 658.392a63.808 63.808 0 0 0-5.94 6.869C132.918 676.035 128 689.468 128 704v192c0 35.2 28.8 64 64 64h640c35.2 0 64-28.8 64-64V704c0-14.532-4.918-27.965-13.158-38.739a63.808 63.808 0 0 0-5.94-6.869L730.51 512l146.392-146.392a63.808 63.808 0 0 0 5.94-6.869C891.082 347.965 896 334.532 896 320V128c0-35.2-28.8-64-64-64z m-32 244.49L640.098 466.392c-12.534 12.534-18.749 29.086-18.659 45.608-0.09 16.522 6.125 33.074 18.659 45.608L800 718.51V864H224V718.51l158.902-160.902c12.534-12.534 18.749-29.086 18.659-45.608 0.09-16.522-6.125-33.074-18.659-45.608L224 302.49V160h576v148.49z M476.33 457.292c15.631 17.517 42.263 57.543 8.75 100.373L297.608 745.137a31.809 31.809 0 0 0-2.275 2.536C290.757 753.211 288 760.299 288 768c0 17.6 14.4 32 32 32h384.001c17.6 0 32-14.4 32-32 0-7.701-2.757-14.789-7.333-20.327a32.004 32.004 0 0 0-2.275-2.536L545.71 564.454c-16.012-18.851-39.722-58.366-5.07-100.241l58.388-57.487c12.445-12.445 12.445-32.81 0-45.255a31.711 31.711 0 0 0-13.806-8.102A31.712 31.712 0 0 0 576 352H449c-1.287 0-2.553 0.086-3.801 0.235-7.385 0.548-14.612 3.621-20.227 9.236-12.445 12.445-12.445 32.81 0 45.255l51.358 50.566z" />
<TextBlock x:Name="LabFinishTime" IsHitTestVisible="False" Text="2:21" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0,12,0" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Grid.Row="1" HorizontalAlignment="Center" VerticalAlignment="Center">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" /> <!--Logo-->
<ColumnDefinition Width="13" />
<ColumnDefinition Width="1*" /> <!--文本区 ↓↓-->
<ColumnDefinition Width="Auto" /> <!--按钮 1-->
<ColumnDefinition Width="Auto" /> <!--按钮 2-->
<ColumnDefinition Width="25" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="21" />
<RowDefinition Height="Auto" /> <!--标题栏-->
<RowDefinition Height="Auto" /> <!--文本区-->
<RowDefinition Height="Auto" /> <!--按钮-->
<RowDefinition Height="21" />
</Grid.RowDefinitions>
<Path Grid.Column="1" Grid.Row="1" Height="25" Width="25"
Stretch="Uniform" Fill="{DynamicResource ColorBrush3}"
Data="M845 547.45h65.54A400.6 400.6 0 0 0 712.7 201.77l-33.22 56.49C781.6 318.32 845 429.13 845 547.45zM347.72 253.92L316 196.58a401.21 401.21 0 0 0-207 350.87h65.54a335.66 335.66 0 0 1 173.18-293.53zM509.79 882.68a334 334 0 0 1-181.3-53.2L293 884.57a401.13 401.13 0 0 0 419.1 8.91L679 836.93a334.94 334.94 0 0 1-169.21 45.75z M821.51 625.1A108.64 108.64 0 0 0 752.2 650l-67.31-38.86a185.44 185.44 0 0 0 11.22-63.7c0-91.55-66.38-167.9-153.54-183.42V289a109.14 109.14 0 1 0-65.57 0v75c-87.16 15.53-153.54 91.87-153.54 183.42a185.46 185.46 0 0 0 11.22 63.7L267.39 650a109.17 109.17 0 1 0 35.81 55l64.47-37.23a186 186 0 0 0 284.23 0L716.38 705a109.13 109.13 0 1 0 105.13-79.9zM198.07 777.85a43.6 43.6 0 1 1 43.61-43.61 43.66 43.66 0 0 1-43.61 43.61z m311.72-636.53a43.61 43.61 0 1 1-43.61 43.61 43.65 43.65 0 0 1 43.61-43.61z m0 526.91a120.78 120.78 0 1 1 120.78-120.78 120.91 120.91 0 0 1-120.78 120.77z m311.72 109.62a43.6 43.6 0 1 1 43.61-43.61 43.65 43.65 0 0 1-43.61 43.61z" />
<TextBlock x:Name="LabFinishTitle" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1"
Text="已加入 Herobrine 的房间" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock x:Name="LabFinishDesc" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="0,10,0,12"
Text="描述文本。"
FontSize="14" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray2}" />
<local:MyButton x:Name="BtnFinishCopy" Grid.Column="4" Grid.Row="3" Margin="0,0,15,0" Text="复制联机码" Padding="13,8" />
<local:MyButton x:Name="BtnFinishExit" Grid.Column="5" Grid.Row="3" Text="退出" Padding="13,8" />
</Grid>
</local:MyCard>
</Grid>
</Grid>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html" />
</Grid>
</Grid>
</local:MyPageRight>
@@ -1,395 +0,0 @@
Public Class PageLinkHiper
Public Const RequestVersion As Char = "2"
'记录的启动情况
Public Shared IsServerSide As Boolean
Private Shared HostIp As String
Private Shared HostPort As Integer
#Region "初始化"
'加载器初始化
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, InitLoader, AutoRun:=False)
'注册自定义的 OnStateChanged
AddHandler InitLoader.OnStateChangedUi, AddressOf OnLoadStateChanged
End Sub
Private IsLoad As Boolean = False
Private Sub OnLoaded() Handles Me.Loaded
FormMain.EndProgramForce(ProcessReturnValues.Aborted)
If IsLoad Then Return
IsLoad = True
'启动监视线程
If Not IsWatcherStarted Then RunInNewThread(AddressOf WatcherThread, "Hiper Watcher")
'读取索引码
Try
Dim Time As String = Setup.Get("LinkHiperCertTime")
If Time = "" Then
Log("[HiPer] 没有缓存凭证")
ElseIf Date.Parse(Time) > Date.Now Then
TextCert.Text = Setup.Get("LinkHiperCertLast")
Log("[HiPer] 缓存凭证尚未过期:" & Time)
CurrentSubpage = Subpages.PanSelect
Else
Log("[HiPer] 缓存凭证已过期:" & Time)
LabCertTitle.Text = "输入索引码"
LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
End If
Catch ex As Exception
Log(ex, "读取缓存凭证失败")
Setup.Set("LinkHiperCertTime", "")
End Try
End Sub
#End Region
#Region "加载步骤"
Public Shared PathHiper As String = PathAppdata & "联机模块\"
Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("HiPer 初始化", {
New LoaderTask(Of Integer, Integer)("网络环境:连通检测", AddressOf InitPingCheck) With {.Block = False, .ProgressWeight = 0.5},
New LoaderTask(Of Integer, Integer)("网络环境:IP 检测", AddressOf InitIpCheck) With {.Block = False, .ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("检查网络环境", AddressOf InitCheck) With {.ProgressWeight = 0.5},
New LoaderTask(Of Integer, List(Of NetFile))("获取所需文件", AddressOf InitGetFile) With {.ProgressWeight = 4},
New LoaderDownload("下载所需文件", New List(Of NetFile)) With {.ProgressWeight = 4},
New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 7}
})
'检查网络状态
Private Shared Sub InitPingCheck(Task As LoaderTask(Of Integer, Integer))
End Sub
Private Shared Sub InitIpCheck()
End Sub
Private Shared PingTime As Integer, IpCheckStatus As LoadState = LoadState.Loading, IpIsInChina As Boolean
Private Shared Sub InitCheck(Task As LoaderTask(Of Integer, Integer))
End Sub
'获取所需文件
Private Shared Sub InitGetFile(Task As LoaderTask(Of Integer, List(Of NetFile)))
End Sub
Public Class CertOutdatedException
Inherits Exception
End Class
'启动联机模块
Private Shared Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
End Sub
Private Shared PingNodes As Integer, AllNodes As List(Of String)
#End Region
#Region "进程管理"
Private Shared _HiperState As LoadState = LoadState.Waiting
Public Shared Property HiperState As LoadState
Get
Return _HiperState
End Get
Set(value As LoadState)
_HiperState = value
RunInUi(Sub() If FrmLinkLeft IsNot Nothing Then CType(FrmLinkLeft.ItemHiper.Buttons(0), MyIconButton).Visibility = If(HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading, Visibility.Visible, Visibility.Collapsed))
End Set
End Property
Public Shared Sub ModuleStopManually() '关闭联机模块按钮
HiperExit(False)
End Sub
Private Shared HiperIp As String = Nothing
Private Shared HiperProcessId As Integer = -1, McbProcessId As Integer = -1
Private Shared HiperCertTime As Date = Date.Now
''' <summary>
''' 若程序正在运行,则结束程序进程,同时初始化状态数据。返回是否关闭了相关进程。
''' </summary>
Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
Return False
End Function
''' <summary>
''' 启动程序,并等待初始化完成后退出运行,同时更新 HiperIp。
''' 若启动失败,则会直接抛出异常。
''' 若程序正在运行,则会先停止其运行。
''' </summary>
Public Shared Sub HiperStart(Task As LoaderTask(Of Integer, Integer))
End Sub
'Hiper 日志
Private Shared Sub HiperLogLine(Content As String, Task As LoaderTask(Of Integer, Integer))
End Sub
Private Shared PossibleFailReason As String = Nothing
#End Region
#Region "监视线程"
'主 Timer 线程
Private IsWatcherStarted As Boolean = False
Private Sub WatcherThread()
Dim Sec15 As Integer = 0
Do While True
Try
For i = 1 To 5
Thread.Sleep(200)
If InitLoader.State = LoadState.Loading Then
RunInUi(AddressOf UpdateProgress)
End If
Next
Thread.Sleep(1000)
Sec15 += 1
WatcherTimer1()
If Sec15 = 15 Then
Sec15 = 0
WatcherTimer15()
End If
Catch ex As Exception
Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
Thread.Sleep(20000)
End Try
Loop
End Sub
'每 1 秒执行的 Timer
Private Sub WatcherTimer1()
If HiperState <> LoadState.Finished Then Return
RunInUi(Sub()
'索引码剩余时间
Dim Span As TimeSpan = HiperCertTime - Date.Now
If Span.TotalDays >= 30 Then
LabFinishTime.Text = "> 30 天"
ElseIf Span.TotalDays >= 4 Then
LabFinishTime.Text = Span.Days & " 天"
ElseIf Span.TotalDays >= 1 Then
LabFinishTime.Text = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
ElseIf Span.TotalMinutes >= 10 Then
LabFinishTime.Text = Span.Hours & ":" & Span.Minutes.ToString.PadLeft(2, "0") & "'"
Else
LabFinishTime.Text = Span.Minutes & "'" & Span.Seconds.ToString.PadLeft(2, "0") & """"
End If
'提示索引码即将到期
If Span.TotalSeconds <= 5 * 60 AndAlso Span.TotalSeconds > 5 * 60 - 1 AndAlso Setup.Get("LinkHiperCertWarn") Then
MyMsgBox("你的索引码还有不到 5 分钟就要过期了!" & vbCrLf & "你可以在设置中关闭这个提示……", "索引码即将过期", "我知道了……")
ShowWindowToTop(Handle)
Beep()
End If
'检查索引码到期
If Span.TotalSeconds < 2 Then
LabCertTitle.Text = "索引码已过期"
LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
TextCert.Text = ""
HiperExit(True)
ShowWindowToTop(Handle)
Beep()
Return
End If
'网络质量
Dim QualityScore As Integer = If(IpIsInChina, 0, -2)
QualityScore -= Math.Ceiling((Math.Min(PingTime, 600) + Math.Min(PingNodes, 600)) / 80)
Select Case QualityScore
Case Is >= -1
LabFinishQuality.Text = "优秀"
Case Is >= -2
LabFinishQuality.Text = "优良"
Case Is >= -3
LabFinishQuality.Text = "良好"
Case Is >= -5
LabFinishQuality.Text = "一般"
Case Is >= -7
LabFinishQuality.Text = "较差"
Case Else
LabFinishQuality.Text = "很差"
End Select
'Ping
If HostPing <> -1 Then
If FrmLinkHiper IsNot Nothing AndAlso FrmLinkHiper.LabFinishPing.IsLoaded Then
FrmLinkHiper.LabFinishPing.Text = HostPing & "ms"
End If
End If
End Sub)
End Sub
'每 15 秒执行的 Timer
Private Shared HostPing As Integer = -1
Private Sub WatcherTimer15()
End Sub
#End Region
#Region "PanCert | 索引码输入页面"
'检测输入
Private Sub TextCert_ValidateChanged(sender As Object, e As EventArgs) Handles TextCert.ValidateChanged
BtnCertDone.IsEnabled = TextCert.ValidateResult = ""
End Sub
Private Sub TextCert_KeyDown(sender As Object, e As KeyEventArgs) Handles TextCert.KeyDown
If e.Key = Key.Enter AndAlso BtnCertDone.IsEnabled Then BtnCertDone_Click() '允许回车确认
End Sub
'确认
Private Sub BtnCertDone_Click() Handles BtnCertDone.Click
CurrentSubpage = Subpages.PanSelect
End Sub
#End Region
#Region "PanSelect | 种类选择页面"
'返回
Private Sub BtnSelectReturn_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectReturn.MouseLeftButtonUp
LabCertTitle.Text = "输入索引码"
LabCertDesc.Text = "你需要获取索引码才能使用 HiPer。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
CurrentSubpage = Subpages.PanCert
End Sub
'创建房间
Private Sub BtnSelectCreate_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectCreate.MouseLeftButtonUp
End Sub
Private Sub RoomCreate(Port As Integer)
'记录信息
HostIp = Nothing : HostPort = Port
IsServerSide = True
'启动
InitLoader.Start(IsForceRestart:=True)
End Sub
'加入房间
Private Sub BtnSelectJoin_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectJoin.MouseLeftButtonUp
End Sub
Private Sub RoomJoin(Ip As String, Port As Integer)
'记录信息
HostIp = Ip : HostPort = Port
IsServerSide = False
'启动
InitLoader.Start(IsForceRestart:=True)
End Sub
#End Region
#Region "PanLoad | 加载中页面"
'承接状态切换的 UI 改变
Private Sub OnLoadStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
End Sub
Private Shared LoadStep As String = "准备初始化"
Private Shared Sub SetLoadDesc(Intro As String, [Step] As String)
Log("[Hiper] 连接步骤:" & Intro)
LoadStep = [Step]
RunInUiWait(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Return
FrmLinkHiper.LabLoadDesc.Text = Intro
FrmLinkHiper.UpdateProgress()
End Sub)
End Sub
'承接重试
Private Sub CardLoad_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles CardLoad.MouseLeftButtonUp
If Not InitLoader.State = LoadState.Failed Then Return
InitLoader.Start(IsForceRestart:=True)
End Sub
'取消加载
Private Sub CancelLoad() Handles BtnLoadCancel.Click
If InitLoader.State = LoadState.Loading Then
CurrentSubpage = Subpages.PanSelect
InitLoader.Abort()
Else
InitLoader.State = LoadState.Waiting
End If
HiperStop(False)
End Sub
'进度改变
Private Sub UpdateProgress(Optional Value As Double = -1)
If Value = -1 Then Value = InitLoader.Progress
Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
If Math.Round(Value - DisplayingProgress, 3) = 0 Then Return
If DisplayingProgress > Value Then
ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
AniStop("Hiper Progress")
Else
Dim NewProgress As Double = If(Value = 1, 1, (Value - DisplayingProgress) * 0.2 + DisplayingProgress)
AniStart({
AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 300, Ease:=New AniEaseOutFluent),
AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 300, Ease:=New AniEaseOutFluent)
}, "Hiper Progress")
End If
End Sub
Private Sub CardResized() Handles CardLoad.SizeChanged
RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
End Sub
#End Region
#Region "PanFinish | 加载完成页面"
'复制 IP
Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
ClipboardSet(LabFinishIp.Text)
End Sub
'退出
Private Sub BtnFinishExit_Click(sender As Object, e As EventArgs) Handles BtnFinishExit.Click
If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗?", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Return
HiperExit(False)
End Sub
'复制联机码
Private Sub BtnFinishCopy_Click(sender As Object, e As EventArgs) Handles BtnFinishCopy.Click
End Sub
'Ping 房主
Private Sub BtnFinishPing_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishPing.MouseLeftButtonUp
LabFinishPing.Text = "检测中"
If TaskPingHost.State = LoadState.Loading Then Return
TaskPingHost.Start(True, IsForceRestart:=True)
End Sub
Private Shared TaskPingHost As New LoaderTask(Of Boolean, Integer)("HiPer Ping Host",
Sub(Task As LoaderTask(Of Boolean, Integer))
HostPing = -1
HostPing = Ping(HostIp, 5000, Task.Input)
End Sub)
#End Region
#Region "子页面管理"
Public Enum Subpages
PanCert
PanSelect
PanFinish
End Enum
Private _CurrentSubpage As Subpages = Subpages.PanCert
Public Property CurrentSubpage As Subpages
Get
Return _CurrentSubpage
End Get
Set(value As Subpages)
If _CurrentSubpage = value Then Return
_CurrentSubpage = value
Log("[Hiper] 子页面更改为 " & GetStringFromEnum(value))
PageOnContentExit()
If value = Subpages.PanSelect Then
LabSelectCode.Text = "(" & TextCert.Text.Substring(0, Math.Min(TextCert.Text.Length, 3)) & "…)"
End If
End Set
End Property
Private Sub PageLinkHiper_OnPageEnter() Handles Me.PageEnter
FrmLinkHiper.PanCert.Visibility = If(CurrentSubpage = Subpages.PanCert, Visibility.Visible, Visibility.Collapsed)
FrmLinkHiper.PanSelect.Visibility = If(CurrentSubpage = Subpages.PanSelect, Visibility.Visible, Visibility.Collapsed)
FrmLinkHiper.PanFinish.Visibility = If(CurrentSubpage = Subpages.PanFinish, Visibility.Visible, Visibility.Collapsed)
End Sub
Private Shared Sub HiperExit(ExitToCertPage As Boolean)
Log("[Hiper] 要求退出 Hiper(当前加载器状态为 " & GetStringFromEnum(InitLoader.State) & ")")
HiperStop(False)
If InitLoader.State = LoadState.Loading Then InitLoader.Abort()
If InitLoader.State = LoadState.Failed Then InitLoader.State = LoadState.Waiting
RunInUi(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Return
FrmLinkHiper.CurrentSubpage = If(ExitToCertPage, Subpages.PanCert, Subpages.PanSelect)
FrmLinkHiper.PageOnContentExit()
End Sub)
End Sub
#End Region
End Class
@@ -1,50 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:System="clr-namespace:System;assembly=mscorlib"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkIoi"
PanScroll="PanBack">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25,10">
<local:MyCard Margin="0,15,0,0" x:Name="CardUser" Title="已连接的玩家 (0)">
<StackPanel Margin="20,37,20,15">
<local:MyHint Margin="5,2,5,8" x:Name="LabHint" />
<StackPanel x:Name="PanUserList" />
<Grid Height="35" Margin="5,8,5,5">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnLeftCreate" Grid.Column="0" MinWidth="140" Text="建立连接" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnLeftCopy" Grid.Column="1" MinWidth="140" Text="复制联机码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,15" Title="房间列表" x:Name="CardRoom">
<StackPanel Margin="20,37,20,15">
<StackPanel x:Name="PanRoom">
<!--<local:MyListItem Type="Clickable" PaddingRight="60" Height="40" Title="00ll00" Info="已连接,1100 ms" Logo="pack://application:,,,/images/Blocks/Grass.png">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton ToolTip="刷新" ToolTipService.Placement="Bottom" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="5" ToolTipService.InitialShowDelay="200" LogoScale="0.85" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
<local:MyIconButton ToolTip="断开" ToolTipService.Placement="Bottom" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="5" ToolTipService.InitialShowDelay="200" LogoScale="0.85" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>-->
</StackPanel>
<local:MyListItem x:Name="BtnCreate" Type="Clickable" Title="创建房间" Height="34" PaddingLeft="0"
Logo="M512.277 954.412c-118.89 0-230.659-46.078-314.73-129.73S67.12 629.666 67.12 511.222s46.327-229.744 130.398-313.427 195.82-129.73 314.73-129.73 230.659 46.078 314.72 129.73S957.397 392.81 957.397 511.183 911.078 740.96 826.97 824.642s-195.8 129.77-314.692 129.77z m0-822.784c-101.972 0-197.809 39.494-269.865 111.222s-111.7 166.997-111.7 268.373 39.653 196.695 111.67 268.335S410.246 890.78 512.248 890.78s197.809-39.484 269.865-111.222 111.7-166.998 111.67-268.374c-0.03-101.375-39.654-196.665-111.67-268.303S614.22 131.628 512.277 131.628z m222.585 347.8H544.073V288.64c-0.76-17.561-15.613-31.18-33.173-30.419-16.495 0.714-29.704 13.924-30.419 30.419v190.787H289.703c-17.56 0.761-31.179 15.614-30.419 33.174 0.715 16.494 13.924 29.703 30.42 30.418H480.48v190.788c0.761 17.56 15.614 31.179 33.174 30.419 16.494-0.715 29.703-13.925 30.418-30.42V543.02h190.788c17.56 0.762 32.413-12.857 33.173-30.418 0.762-17.561-12.858-32.414-30.419-33.174a31.683 31.683 0 0 0-2.753 0z" />
</StackPanel>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
<local:MyCard Opacity="0" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40,0" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
<local:MyLoading Text="正在加载联机模块" Margin="20,20,20,17" x:Name="Load" ShowProgress="True" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html" />
</Grid>
</Grid>
</local:MyPageRight>
@@ -1,430 +0,0 @@
Imports System.Net.Sockets
Public Class PageLinkIoi
Public Const RequestVersion As Integer = 4
Public Const IoiVersion As Integer = 10 '由于已关闭更新渠道,在提升 IoiVersion 时必须提升 RequestVersion
Public Shared PathIoi As String = PathAppdata & "联机模块\IOI 联机模块.exe"
#Region "进程管理"
Private Shared IoiId As String, IoiPassword As String
Private Shared IoiProcess As Process = Nothing
Private Shared IoiState As LoadState = LoadState.Waiting
''' <summary>
''' 若 Ioi 正在运行,则结束 Ioi 进程,同时初始化状态数据。返回是否关闭了对应进程。
''' </summary>
Public Shared Function IoiStop(SleepWhenKilled As Boolean) As Boolean
Return False
End Function
''' <summary>
''' 启动 Ioi,并等待初始化完成后退出运行,同时更新 IoiId 与 IoiPassword。
''' 正常初始化返回 True,需要更新返回 False,其余情况抛出异常。
''' 若 Ioi 正在运行,则会先停止其运行。
''' </summary>
Public Shared Function IoiStart() As Boolean
Return False
End Function
'Ioi 日志
Private Shared Sub IoiLogLine(Content As String)
End Sub
Private Shared LogLinesCount As Integer = 0
Private Shared LastPortsId As String = "" '上一个收到 portssub 的 ID,用于记录端口
#End Region
#Region "时钟"
'UI 线程刷新
Private Shared UserListIdentifyCache As String = ""
Private Shared RoomListIdentifyCache As String = ""
Public Sub RefreshUi()
End Sub
'工作线程刷新
Public Sub RefreshWorker()
End Sub
#End Region
#Region "发送请求"
''' <summary>
''' 发送 Portsub 请求并等待获取控制台端口。进度将从 0 变化至 80%。
''' </summary>
Private Shared Sub SendPortsubRequest(User As LinkUserIoi)
End Sub
''' <summary>
''' 向控制台发送 Connect 请求。
''' </summary>
Private Shared Sub SendConnectRequest(User As LinkUserIoi)
Dim RawJson As New JObject()
RawJson("version") = RequestVersion
RawJson("name") = GetPlayerName()
RawJson("id") = IoiId
RawJson("type") = "connect"
User.Send(RawJson)
End Sub
''' <summary>
''' 向控制台发送 Update 请求。
''' </summary>
Private Shared Sub SendUpdateRequest(User As LinkUserIoi, Stage As Integer, Optional Unique As Long = -1)
If Unique = -1 Then Unique = GetTimeTick()
Dim RawJson As New JObject
RawJson("name") = GetPlayerName()
RawJson("id") = IoiId
RawJson("type") = "update"
RawJson("stage") = Stage
RawJson("unique") = Unique
If Stage < 3 Then
Dim Rooms As New JArray
For Each Room In RoomListForMe
Dim RoomObject As New JObject
RoomObject("name") = Room.DisplayName
RoomObject("port") = Room.Port
Rooms.Add(RoomObject)
Next
RawJson("rooms") = Rooms
User.PingPending(Unique) = Date.Now
End If
User.Send(RawJson)
End Sub
''' <summary>
''' 尝试发送断开请求,并将其从用户列表中移除。
''' </summary>
Private Shared Sub SendDisconnectRequest(User As LinkUserIoi, Optional Message As String = Nothing, Optional IsError As Boolean = False)
End Sub
#End Region
#Region "左边栏操作"
'刷新连接
Private Shared Sub BtnListRefresh_Click(sender As MyIconButton, e As EventArgs)
End Sub
'断开连接
Private Shared Sub BtnListDisconnect_Click(sender As MyIconButton, e As EventArgs)
End Sub
'复制联机码
Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click
End Sub
#End Region
#Region "玩家名"
''' <summary>
''' 获取当前的玩家名。
''' </summary>
Public Shared Function GetPlayerName() As String
'自动生成玩家名
If AutogenPlayerName Is Nothing Then
If IsPlayerNameValid(McLoginName) Then
AutogenPlayerName = McLoginName()
Else
AutogenPlayerName = "玩家 " & CType(GetHash(If(UniqueAddress, "")) Mod 1048576, Integer).ToString("x5").ToUpper
End If
End If
'获取玩家自定义的名称
Dim CustomName As String = Setup.Get("LinkName").ToString.Trim()
If CustomName <> "" Then
If IsPlayerNameValid(CustomName) Then
Return CustomName.Trim
Else
Hint("你所设置的玩家名存在异常,已被重置!", HintType.Critical)
Setup.Set("LinkName", "")
End If
End If
'使用自动生成的玩家名
Return AutogenPlayerName
End Function
Private Shared AutogenPlayerName As String = Nothing '并非由玩家自定义,而是自动生成的玩家名
''' <summary>
''' 检查某个玩家名是否合法。
''' </summary>
Private Shared Function IsPlayerNameValid(Name As String) As Boolean
Return True
End Function
#End Region
#Region "请求核心"
''' <summary>
''' 启动 Socket 监听核心。
''' </summary>
Public Shared Sub StartSocketListener()
End Sub
#End Region
#Region "用户核心"
'用户基类
Public MustInherit Class LinkUserBase
Implements IDisposable
'基础数据
Public Uuid As Integer = GetUuid()
Public Id As String
Public DisplayName As String
'请求管理
Public Socket As Socket = Nothing
Public Sub Send(Request As JObject)
End Sub
Public ListenerThread As Thread = Nothing
Public Sub StartListener()
End Sub
Public Sub BindSocket(Socket As Socket)
If Me.Socket IsNot Nothing Then Throw New Exception("该用户已经绑定了 Socket")
Me.Socket = Socket
StartListener()
End Sub
'Ping
'0:与 Ping 计算无关,不回应
'1:A to B,2:B to A,3:A to B
Public PingPending As New Dictionary(Of Long, Date)
Public PingRecord As New Queue(Of Integer)
'心跳包
Public LastSend As Date = Date.Now
Public LastReceive As Date = Date.Now
'类型转换
Public Sub New(Id As String, DisplayName As String)
Me.Id = Id
Me.DisplayName = DisplayName
Log("[IOI] 无通信包的新用户对象:" & ToString())
End Sub
Public Sub New(Id As String, DisplayName As String, Socket As Socket)
Me.Id = Id
Me.DisplayName = DisplayName
Me.Socket = Socket
Log("[IOI] 新用户对象:" & ToString())
StartListener()
End Sub
Public Overrides Function ToString() As String
Return DisplayName & " @ " & Id & " #" & Uuid
End Function
Public Shared Widening Operator CType(User As LinkUserBase) As String
Return User.ToString
End Operator
'释放资源
Public IsDisposed As Boolean = False
Protected Overridable Sub Dispose(IsDisposing As Boolean)
If Socket IsNot Nothing Then Socket.Dispose()
If ListenerThread IsNot Nothing AndAlso ListenerThread.IsAlive Then ListenerThread.Interrupt()
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
If Not IsDisposed Then
IsDisposed = True
Dispose(True)
End If
GC.SuppressFinalize(Me)
End Sub
End Class
'用户对象
Public Shared UserList As New Dictionary(Of String, LinkUserIoi)
Public Class LinkUserIoi
Inherits LinkUserBase
Public Sub New(Id As String, DisplayName As String, Socket As Socket)
MyBase.New(Id, DisplayName, Socket)
End Sub
Public Sub New(Id As String, DisplayName As String)
MyBase.New(Id, DisplayName)
End Sub
'基础数据
Public Ports As New Dictionary(Of Integer, String)
Public Rooms As New List(Of RoomEntry)
'进度与 UI
Public Progress As Double = 0
Public RelativeThread As Thread = Nothing
Public Function GetDescription() As String
Return If(Progress < 1,
"正在连接," & Math.Round(Progress * 100) & "%",
"已连接," & If(Not PingRecord.Any(), "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
End Function
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
.Title = DisplayName, .Height = 42, .Tag = Me, .Type = MyListItem.CheckType.None,
.Logo = "pack://application:,,,/images/Blocks/Grass.png"}
'绑定图标按钮
Dim BtnRefresh As New MyIconButton With {.Logo = Logo.IconButtonRefresh, .LogoScale = 0.85, .ToolTip = "刷新", .Tag = Me}
AddHandler BtnRefresh.Click, AddressOf BtnListRefresh_Click
ToolTipService.SetPlacement(BtnRefresh, Primitives.PlacementMode.Bottom)
ToolTipService.SetHorizontalOffset(BtnRefresh, -10)
ToolTipService.SetVerticalOffset(BtnRefresh, 5)
ToolTipService.SetInitialShowDelay(BtnRefresh, 200)
Dim BtnClose As New MyIconButton With {.Logo = Logo.IconButtonCross, .LogoScale = 0.85, .ToolTip = "断开", .Tag = Me}
AddHandler BtnClose.Click, AddressOf BtnListDisconnect_Click
ToolTipService.SetPlacement(BtnClose, Primitives.PlacementMode.Bottom)
ToolTipService.SetHorizontalOffset(BtnClose, -10)
ToolTipService.SetVerticalOffset(BtnClose, 5)
ToolTipService.SetInitialShowDelay(BtnClose, 200)
Item.Buttons = {BtnRefresh, BtnClose}
'刷新并返回
RefreshUi(Item)
Return Item
End Function
Public Sub RefreshUi(RelatedListItem As MyListItem)
RelatedListItem.Title = DisplayName
RelatedListItem.Info = GetDescription()
RelatedListItem.Buttons(0).Visibility = If(Progress = 1, Visibility.Visible, Visibility.Collapsed)
End Sub
'释放
Protected Overrides Sub Dispose(IsDisposing As Boolean)
Log("[IOI] 用户资源释放(IOI, " & DisplayName & ")")
If RelativeThread IsNot Nothing AndAlso RelativeThread.IsAlive Then RelativeThread.Interrupt()
UserList.Remove(Id)
MyBase.Dispose(IsDisposing)
End Sub
End Class
'房间对象
Private Shared RoomListForMe As New List(Of RoomEntry)
Private Function GetRoomList() As List(Of RoomEntry)
Dim RoomList As New List(Of RoomEntry)(RoomListForMe)
For i = 0 To UserList.Count - 1
If i > UserList.Count - 1 Then Exit For
RoomList.AddRange(UserList.Values(i).Rooms)
Next
Return RoomList
End Function
Public Class RoomEntry
'基础数据
Public Port As Integer
Public DisplayName As String
Public User As LinkUserIoi = Nothing '若 IsOwner = True,则此项为 Nothing
Public IsOwner As Boolean
Public ReadOnly Property Ip As String
Get
If IsOwner Then
Return "localhost:" & Port
Else
Return User.Ports(Port) & ":" & Port
End If
End Get
End Property
'类型转换
Public Sub New(Port As Integer, DisplayName As String, Optional User As LinkUserIoi = Nothing)
Me.IsOwner = User Is Nothing
Me.User = User
Me.DisplayName = DisplayName
Me.Port = Port
End Sub
Public Overrides Function ToString() As String
Return DisplayName & " - " & Port & " - " & IsOwner
End Function
Public Shared Widening Operator CType(Room As RoomEntry) As String
Return Room.ToString
End Operator
Public Shared Function SelectPort(Room As RoomEntry) As Integer
Return Room.Port
End Function
'UI
Public Function GetDescription() As String
If IsOwner Then
Return "由我创建,端口 " & Port
Else
Return "由 " & User.DisplayName & " 创建,端口 " & Port
End If
End Function
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
.Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me,
.Type = If(IsOwner, MyListItem.CheckType.None, MyListItem.CheckType.Clickable),
.Logo = "pack://application:,,,/images/Blocks/" & If(IsOwner, "GrassPath", "Grass") & ".png"}
If IsOwner Then
'绑定图标按钮
Dim BtnEdit As New MyIconButton With {.Logo = Logo.IconButtonEdit, .LogoScale = 1, .ToolTip = "修改名称", .Tag = Me}
AddHandler BtnEdit.Click, AddressOf BtnRoomEdit_Click
ToolTipService.SetPlacement(BtnEdit, Primitives.PlacementMode.Bottom)
ToolTipService.SetHorizontalOffset(BtnEdit, -22)
ToolTipService.SetVerticalOffset(BtnEdit, 5)
ToolTipService.SetInitialShowDelay(BtnEdit, 200)
Dim BtnClose As New MyIconButton With {.Logo = Logo.IconButtonCross, .LogoScale = 0.85, .ToolTip = "关闭", .Tag = Me}
AddHandler BtnClose.Click, AddressOf BtnRoomClose_Click
ToolTipService.SetPlacement(BtnClose, Primitives.PlacementMode.Bottom)
ToolTipService.SetHorizontalOffset(BtnClose, -10)
ToolTipService.SetVerticalOffset(BtnClose, 5)
ToolTipService.SetInitialShowDelay(BtnClose, 200)
Item.Buttons = {BtnEdit, BtnClose}
Else
'绑定点击事件
AddHandler Item.Click, AddressOf BtnRoom_Click
End If
Return Item
End Function
Public Sub RefreshUi(RelatedListItem As MyListItem)
RelatedListItem.Title = DisplayName
RelatedListItem.Info = GetDescription()
End Sub
End Class
#End Region
'正向与反向连接
Public Shared Sub BtnLeftCreate_Click() Handles BtnLeftCreate.Click
End Sub
Private Shared Sub SendPortsubBack(User As LinkUserIoi, TargetVersion As Integer)
End Sub
'创建房间
Private Sub LinkCreate() Handles BtnCreate.Click
End Sub
Private Shared Sub SendUpdateRequestToAllUsers()
For i = 0 To UserList.Count - 1
If i > UserList.Count - 1 Then Exit For
Dim User = UserList.Values(i)
If User.Progress < 1 Then Continue For
Try
SendUpdateRequest(User, 1) '不需要使用多线程,发送实际会瞬间完成
Catch ex As Exception
Log(ex, "发送全局刷新请求失败(" & User.DisplayName & ")")
End Try
Next
End Sub
'修改房间名称
Private Shared Sub BtnRoomEdit_Click(sender As MyIconButton, e As EventArgs)
End Sub
'加入房间
Private Shared Sub BtnRoom_Click(sender As MyListItem, e As EventArgs)
Dim Room As RoomEntry = sender.Tag
If MyMsgBox("请在多人游戏页面点击直接连接,输入 " & Room.Ip & " 以进入服务器!", "加入房间", "复制地址", "确定") = 1 Then
ClipboardSet(Room.Ip)
End If
End Sub
'关闭房间
Private Shared Sub BtnRoomClose_Click(sender As MyIconButton, e As EventArgs)
End Sub
'获取数据包
Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing)
End Sub
''' <summary>
''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。
''' </summary>
Public Shared Sub UserRemove(User As LinkUserIoi, ShowLeaveMessage As Boolean)
End Sub
Public Shared Sub ModuleStopManually()
End Sub
End Class
@@ -1,44 +0,0 @@
<local:MyPageLeft x:Class="PageLinkLeft"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d" AnimatedControl="PanItem" MinWidth="150">
<StackPanel Orientation="Vertical" x:Name="PanItem" Margin="0,12,0,0">
<TextBlock Text="联机方式" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemHiper" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="HiPer"
LogoScale="0.85" Logo="M554.496 170.496c141.312 0 256 114.688 256 256s-114.688 256-256 256H402.432c-22.016-1.536-39.424-19.968-39.424-42.496a42.391 42.391 0 0 1 42.496-42.496h149.504c94.208 0 170.496-76.288 170.496-170.496S648.704 256 554.496 256h-256C204.288 256 128 332.288 128 426.496c0 38.4 12.8 73.728 33.792 102.4 5.632 7.168 8.704 15.872 8.704 25.6A42.391 42.391 0 0 1 128 596.992c-11.264 0-20.992-4.096-28.672-11.264l-0.512 0.512c-35.328-44.032-56.32-99.328-56.32-159.744 0-141.312 114.688-256 256-256h256z m64 192h3.072c22.016 1.536 39.424 19.968 39.424 42.496a42.391 42.391 0 0 1-42.496 42.496H469.504c-94.208 0-170.496 76.288-170.496 170.496S375.296 788.48 469.504 788.48h256C819.712 788.48 896 712.192 896 617.984c0-38.4-12.8-73.728-33.792-102.4-5.632-7.168-8.704-15.872-8.704-25.6A42.391 42.391 0 0 1 896 447.488c11.264 0 20.992 4.096 28.672 11.264l0.512-0.512c35.328 44.032 56.32 99.328 56.32 159.744 0 141.312-114.688 256-256 256h-256c-141.312 0-256-114.688-256-256s114.688-256 256-256h148.992z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton ToolTip="关闭联机模块" Loaded="BtnHiperStop_Loaded" Click="BtnHiperStop_Click"
ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" ToolTipService.VerticalOffset="-2" ToolTipService.InitialShowDelay="200" LogoScale="0.7"
Logo="M576 512l277.333333 277.333333-64 64-277.333333-277.333333L234.666667 853.333333 170.666667 789.333333l277.333333-277.333333L170.666667 234.666667 234.666667 170.666667l277.333333 277.333333L789.333333 170.666667 853.333333 234.666667 576 512z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemIoi" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="IOI"
LogoScale="0.85" Logo="M554.496 170.496c141.312 0 256 114.688 256 256s-114.688 256-256 256H402.432c-22.016-1.536-39.424-19.968-39.424-42.496a42.391 42.391 0 0 1 42.496-42.496h149.504c94.208 0 170.496-76.288 170.496-170.496S648.704 256 554.496 256h-256C204.288 256 128 332.288 128 426.496c0 38.4 12.8 73.728 33.792 102.4 5.632 7.168 8.704 15.872 8.704 25.6A42.391 42.391 0 0 1 128 596.992c-11.264 0-20.992-4.096-28.672-11.264l-0.512 0.512c-35.328-44.032-56.32-99.328-56.32-159.744 0-141.312 114.688-256 256-256h256z m64 192h3.072c22.016 1.536 39.424 19.968 39.424 42.496a42.391 42.391 0 0 1-42.496 42.496H469.504c-94.208 0-170.496 76.288-170.496 170.496S375.296 788.48 469.504 788.48h256C819.712 788.48 896 712.192 896 617.984c0-38.4-12.8-73.728-33.792-102.4-5.632-7.168-8.704-15.872-8.704-25.6A42.391 42.391 0 0 1 896 447.488c11.264 0 20.992 4.096 28.672 11.264l0.512-0.512c35.328 44.032 56.32 99.328 56.32 159.744 0 141.312-114.688 256-256 256h-256c-141.312 0-256-114.688-256-256s114.688-256 256-256h148.992z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton ToolTip="关闭联机模块" Loaded="BtnIoiStop_Loaded" Click="BtnIoiStop_Click"
ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" ToolTipService.VerticalOffset="-2" ToolTipService.InitialShowDelay="200" LogoScale="0.7"
Logo="M576 512l277.333333 277.333333-64 64-277.333333-277.333333L234.666667 853.333333 170.666667 789.333333l277.333333-277.333333L170.666667 234.666667 234.666667 170.666667l277.333333 277.333333L789.333333 170.666667 853.333333 234.666667 576 512z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="更多选项" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemSetup" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="设置"
LogoScale="0.85" Logo="M940.4 463.7L773.3 174.2c-17.3-30-49.2-48.4-83.8-48.4H340.2c-34.6 0-66.5 18.5-83.8 48.4L89.2 463.7c-17.3 30-17.3 66.9 0 96.8L256.4 850c17.3 30 49.2 48.4 83.8 48.4h349.2c34.6 0 66.5-18.5 83.8-48.4l167.2-289.5c17.3-29.9 17.3-66.8 0-96.8z m-94.6 96.8L725.9 768.1c-17.3 30-49.2 48.4-83.8 48.4H387.5c-34.6 0-66.5-18.5-83.8-48.4L183.9 560.5c-17.3-30-17.3-66.9 0-96.8l119.8-207.5c17.3-30 49.2-48.4 83.8-48.4h254.6c34.6 0 66.5 18.5 83.8 48.4l119.8 207.5c17.3 30 17.3 66.9 0.1 96.8z M522.3 321.2c-2.5-0.1-5-0.2-7.5-0.2-119.9 0-214 110.3-186.3 235 15.8 70.9 71.5 126.6 142.4 142.4 17.5 3.9 34.7 5.4 51.4 4.7 102.1-3.9 183.6-87.9 183.6-191 0.1-103-81.5-187-183.6-190.9z m68.6 269.1c-18.5 18-43 28.9-68.6 30.7l-6 0.3c-30.2 0.4-58.6-11.4-79.7-33-19.5-20.1-30.7-47-30.9-75-0.3-29.6 11.1-57.4 32-78.3 20.6-20.6 48-32 77.2-32 2.5 0 5 0.1 7.5 0.3 26.7 1.8 51.5 13.2 70.5 32.5 19.6 20 30.8 46.9 31.2 74.9 0.2 30.2-11.5 58.6-33.2 79.6z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="5" ToolTip="初始化设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemHelp" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="常见问题"
LogoScale="0.97" Logo="M520.6 620.3c-11.3-0.6-20.1-4-26.9-10.5-6.6-6.3-8.1-11-10.1-20.8-1.9-9.5-1.5-16.7-1-24.9l0.3-5.3c0.5-9.9 3.5-19.6 8.8-28.1 5.7-9 12.5-17.2 20.8-25.1 8.6-8 17.7-15.7 27-22.9 9.4-7.2 18.7-14.8 27.7-22.7 9-7.9 16.2-15.8 22.1-24.3 6.2-9 9.3-18.8 9.3-29.4 1.2-20.3-6.5-37.7-22.8-51.3-16-13.3-37.4-20-63.5-20-13.7 0-26.3 3.3-37.4 10-10.9 6.5-20.2 14.5-27.7 23.8-7.5 9.2-13.5 19-17.9 29.2-4.5 10.6-6.7 19.4-6.7 26.8 0 9.2-3.3 16-10.1 20.8-6.9 4.8-14.6 7.3-22.8 7.3h-1.3c-9-0.3-17-3.3-24.6-9.2-7.3-5.6-11.1-14.6-11.6-27.5-0.6-11.5 1.9-26.1 7.2-43.5 5.4-17.4 14.8-34.4 28.1-50.5 13.4-16.3 31.2-30.4 52.8-41.8 21.6-11.4 49.2-17.2 81.9-17.2 26.4 0 49.6 3.9 69.1 11.7 19.4 7.7 35.4 18.2 47.5 31.1l1.6 1.7c11.8 12.6 20.3 21.7 29.4 44.4 11.6 28.9 7.1 52.1 5.5 58.5-5.8 22.6-12.6 37.7-22.7 50.4-11.7 14.6-24.9 28.2-39.2 40.4-14 11.7-39.2 33.3-39.2 33.3-13.3 11.4-19.4 22.1-18.6 32.9V587c0.5 8.7-2.4 16.1-8.8 22.8-6.2 6.4-14.8 10-26.2 10.5zM519 766.1c-13 0-23.6-4.2-32.2-12.9-8.7-8.7-13-19-13-31.4 0-12.9 4.2-23.5 12.9-32.2 8.7-8.7 19.2-12.9 32.2-12.9 13 0 23.5 4.2 32.2 12.9s12.9 19.2 12.9 32.2c0 12.4-4.2 22.7-12.9 31.4-8.6 8.6-19.2 12.9-32.1 12.9z M515 928.3c-228.1 0-413.7-185.6-413.7-413.7S286.9 100.9 515 100.9s413.7 185.6 413.7 413.7c0.1 228.1-185.5 413.7-413.7 413.7z m0-747.4c-184 0-333.7 149.7-333.7 333.7S331 848.3 515 848.3s333.7-149.7 333.7-333.7S699 180.9 515 180.9z" />
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="关于与反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
</StackPanel>
</local:MyPageLeft>
@@ -1,112 +0,0 @@
Public Class PageLinkLeft
Private IsLoad As Boolean = False
Private IsPageSwitched As Boolean = False '如果在 Loaded 前切换到其他页面,会导致触发 Loaded 时再次切换一次
Private Sub PageLinkLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If IsLoad Then Return
IsLoad = True
'切换默认页面
If IsPageSwitched Then Return
ItemHiper.SetChecked(True, False, False)
End Sub
Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded
IsPageSwitched = False
End Sub
#Region "页面切换"
''' <summary>
''' 当前页面的编号。
''' </summary>
Public PageID As FormMain.PageSubType = FormMain.PageSubType.LinkHiper
''' <summary>
''' 勾选事件改变页面。
''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemHiper.Check, ItemIoi.Check, ItemSetup.Check, ItemHelp.Check, ItemFeedback.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
End Sub
Public Function PageGet(Optional ID As FormMain.PageSubType = -1)
If ID = -1 Then ID = PageID
Select Case ID
Case 0, FormMain.PageSubType.LinkHiper
If FrmLinkHiper Is Nothing Then FrmLinkHiper = New PageLinkHiper
Return FrmLinkHiper
Case FormMain.PageSubType.LinkIoi
If FrmLinkIoi Is Nothing Then FrmLinkIoi = New PageLinkIoi
Return FrmLinkIoi
Case FormMain.PageSubType.LinkSetup
If FrmSetupLink Is Nothing Then FrmSetupLink = New PageSetupLink
Return FrmSetupLink
Case FormMain.PageSubType.LinkHelp
If FrmLinkHelp Is Nothing Then FrmLinkHelp = PageOtherHelp.GetHelpPage(PathTemp & "Help\启动器\联机.json")
Return FrmLinkHelp
Case FormMain.PageSubType.LinkFeedback
If FrmLinkFeedback Is Nothing Then FrmLinkFeedback = New PageLinkFeedback
Return FrmLinkFeedback
Case Else
Throw New Exception("未知的更多子页面种类:" & ID)
End Select
End Function
''' <summary>
''' 切换现有页面。
''' </summary>
Public Sub PageChange(ID As FormMain.PageSubType)
If PageID = ID Then Return
AniControlEnabled += 1
IsPageSwitched = True
Try
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
End Sub
Private Shared Sub PageChangeRun(Target As MyPageRight)
AniStop("FrmMain PageChangeRight") '停止主页面的右页面切换动画,防止它与本动画一起触发多次 PageOnEnter
If Target.Parent IsNot Nothing Then Target.SetValue(ContentPresenter.ContentProperty, Nothing)
FrmMain.PageRight = Target
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit()
AniStart({
AaCode(Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
End Sub
#End Region
Public Sub Reset(sender As Object, e As EventArgs)
If MyMsgBox("是否要初始化联机页的所有设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupLink) Then FrmSetupLink = New PageSetupLink
FrmSetupLink.Reset()
ItemSetup.Checked = True
End If
End Sub
Private Sub BtnHiperStop_Loaded(sender As Object, e As RoutedEventArgs)
sender.Visibility = If(PageLinkHiper.HiperState = LoadState.Finished OrElse PageLinkHiper.HiperState = LoadState.Loading, Visibility.Visible, Visibility.Collapsed)
End Sub
Private Sub BtnHiperStop_Click(sender As Object, e As EventArgs)
PageLinkHiper.ModuleStopManually()
End Sub
Private Sub BtnIoiStop_Loaded(sender As Object, e As RoutedEventArgs)
End Sub
Private Sub BtnIoiStop_Click(sender As Object, e As EventArgs)
PageLinkIoi.ModuleStopManually()
End Sub
End Class
@@ -0,0 +1,202 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkMain"
d:DesignWidth="800" d:DesignHeight="800">
<Grid>
<Grid x:Name="PanLoad">
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" x:Name="CardLoad" MinWidth="300">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="20" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="20" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="20" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="20" />
</Grid.RowDefinitions>
<local:MyLoading Grid.Column="1" Grid.Row="1" x:Name="Load" Grid.RowSpan="3" Margin="0,-4,0,-29" HorizontalAlignment="Center"
Text="" TextError="" TextErrorInherit="False" AutoRun="False" IsHitTestVisible="False" RenderTransformOrigin="0.5,0.5">
<local:MyLoading.RenderTransform>
<ScaleTransform ScaleX="0.9" ScaleY="0.9" />
</local:MyLoading.RenderTransform>
</local:MyLoading>
<TextBlock x:Name="LabLoadTitle" Grid.Column="3" Grid.Row="1" Grid.ColumnSpan="2" VerticalAlignment="Center" Text="正在创建联机房间" FontSize="19"
Margin="0,0,25,1" Foreground="{Binding Foreground, ElementName=Load}" IsHitTestVisible="False" />
<TextBlock x:Name="LabLoadDesc" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" VerticalAlignment="Center" Margin="0,5,10,-5" Text="下载联机模块中……" FontSize="14"
LineHeight="19" MaxWidth="450" MaxHeight="220" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray3}" IsHitTestVisible="False" />
<local:MyIconButton Grid.Column="5" Grid.Row="1" x:Name="BtnLoadCancel" Height="25" Width="25"
VerticalAlignment="Top" Margin="0,-13,-13,0"
Theme="Black" Opacity="0.3"
ToolTip="取消" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100"
ToolTipService.VerticalOffset="-2" ToolTipService.HorizontalOffset="0"
LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
<Grid Height="12" VerticalAlignment="Bottom" Grid.ColumnSpan="100" Grid.RowSpan="100" Margin="0,0,0,-0.6">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="0*" x:Name="ColumnProgressA" />
<ColumnDefinition Width="1*" x:Name="ColumnProgressB" />
</Grid.ColumnDefinitions>
<Grid.Clip>
<RectangleGeometry RadiusX="6" RadiusY="6" x:Name="RectProgressClip" />
</Grid.Clip>
<Rectangle Fill="{Binding Foreground, ElementName=Load}" VerticalAlignment="Bottom" Height="2" />
</Grid>
</Grid>
</local:MyCard>
</Grid>
<Grid x:Name="PanContent">
<Grid x:Name="PanSelect">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
<RowDefinition Height="35" />
<RowDefinition Height="Auto" />
<RowDefinition Height="10" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<local:MyCard x:Name="PanSelectCreate" Grid.Column="1" Grid.Row="1" CornerRadius="13" VerticalAlignment="Center">
<Grid IsHitTestVisible="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="13" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="22" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="12" />
</Grid.RowDefinitions>
<Path Grid.Column="1" Grid.Row="1" Height="26" Width="26" Margin="0,-1,0,0"
Stretch="Uniform" Fill="{DynamicResource ColorBrush3}"
Data="M384 128v192h256a64 64 0 0 1 64 64v256h192V128H384zM320 320V128a64 64 0 0 1 64-64h512a64 64 0 0 1 64 64v512a64 64 0 0 1-64 64h-192v192a64 64 0 0 1-64 64H128a64 64 0 0 1-64-64V384a64 64 0 0 1 64-64h192z m320 384H384a64 64 0 0 1-64-64V384H128v512h512v-192z m0-64V384H384v256h256z" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1"
Text="创建房间" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="1,10,30,10"
Text="邀请朋友加入你的单人游戏。"
FontSize="15" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray3}" />
</Grid>
</local:MyCard>
<local:MyCard x:Name="PanSelectJoin" Grid.Column="1" Grid.Row="3" CornerRadius="13" VerticalAlignment="Center">
<Grid IsHitTestVisible="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="13" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="22" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="12" />
</Grid.RowDefinitions>
<Path Grid.Column="1" Grid.Row="1" Height="26" Width="26" Margin="0,-1,0,0"
Stretch="Uniform" Fill="{DynamicResource ColorBrush3}"
Data="m399,355l-92.5,101.6c-13.7,13.7-10.6,36.4,4.6,47,13.7,9.1,30.3,7.6,41-4.5l127.4-138.1c16.7-18.2,18.2-47,0-66.8l-125.9-141.1c-12.1-13.7-34.9-15.2-47,0-12.1,12.1-12.1,31.9,0,44l92.5,98.6H28.8c-16.7,0-28.8,13.7-28.8,28.8s13.7,28.8,28.8,28.8h370.2v1.5ZM625.7,0H224.6c-44,0-78.9,34.9-78.9,78.9v101.6c0,15.2,12.1,27.3,27.3,27.3s27.3-12.1,27.3-27.3v-98.6c0-15.2,12.1-27.3,27.3-27.3h387.5c15.2,0,27.3,12.1,27.3,27.3v493c0,15.2-12.1,27.3-27.3,27.3H229.2c-15.2,0-27.3-12.1-27.3-27.3v-101.6c0-16.7-13.7-28.8-28.8-28.8s-28.8,13.7-28.8,28.8v98.6c0,44,34.9,78.9,78.9,78.9h407.2c44,0,67.9-34.9,67.9-78.9V78.9c-4.6-44-28.4-78.9-72.4-78.9Z" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1"
Text="加入房间" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="1,10,30,10"
Text="输入你收到的邀请码,加入朋友的房间。"
FontSize="15" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray3}" />
</Grid>
</local:MyCard>
</Grid>
<Grid x:Name="PanFinish" Visibility="Collapsed" HorizontalAlignment="Center" VerticalAlignment="Center" MinWidth="300">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="25" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="12">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
<ColumnDefinition Width="Auto" /> <!--Logo-->
<ColumnDefinition Width="13" />
<ColumnDefinition Width="1*" /> <!--文本区 ↓↓-->
<ColumnDefinition Width="Auto" /> <!--按钮 1-->
<ColumnDefinition Width="Auto" /> <!--按钮 2-->
<ColumnDefinition Width="25" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="21" />
<RowDefinition Height="Auto" /> <!--标题栏-->
<RowDefinition Height="Auto" /> <!--文本区-->
<RowDefinition Height="Auto" /> <!--按钮-->
<RowDefinition Height="21" />
</Grid.RowDefinitions>
<Path Grid.Column="1" Grid.Row="1" Height="28" Width="28" x:Name="ImgFinishLogo"
Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" RenderTransformOrigin="0.5,0.54"
Data="M845 547.45h65.54A400.6 400.6 0 0 0 712.7 201.77l-33.22 56.49C781.6 318.32 845 429.13 845 547.45zM347.72 253.92L316 196.58a401.21 401.21 0 0 0-207 350.87h65.54a335.66 335.66 0 0 1 173.18-293.53zM509.79 882.68a334 334 0 0 1-181.3-53.2L293 884.57a401.13 401.13 0 0 0 419.1 8.91L679 836.93a334.94 334.94 0 0 1-169.21 45.75z M821.51 625.1A108.64 108.64 0 0 0 752.2 650l-67.31-38.86a185.44 185.44 0 0 0 11.22-63.7c0-91.55-66.38-167.9-153.54-183.42V289a109.14 109.14 0 1 0-65.57 0v75c-87.16 15.53-153.54 91.87-153.54 183.42a185.46 185.46 0 0 0 11.22 63.7L267.39 650a109.17 109.17 0 1 0 35.81 55l64.47-37.23a186 186 0 0 0 284.23 0L716.38 705a109.13 109.13 0 1 0 105.13-79.9zM198.07 777.85a43.6 43.6 0 1 1 43.61-43.61 43.66 43.66 0 0 1-43.61 43.61z m311.72-636.53a43.61 43.61 0 1 1-43.61 43.61 43.65 43.65 0 0 1 43.61-43.61z m0 526.91a120.78 120.78 0 1 1 120.78-120.78 120.91 120.91 0 0 1-120.78 120.77z m311.72 109.62a43.6 43.6 0 1 1 43.61-43.61 43.65 43.65 0 0 1-43.61 43.61z" />
<TextBlock x:Name="LabFinishTitle" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1" Margin="0,3,0,0"
Text="已加入房间" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock x:Name="LabFinishDesc" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="1,9,10,10"
Text="描述文本。"
FontSize="14" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray2}" />
<local:MyButton x:Name="BtnFinishCopy" Grid.Column="4" Grid.Row="3" Margin="0,0,15,0" Text="复制邀请码" Padding="13,8" ColorType="Highlight" />
<local:MyButton x:Name="BtnFinishExit" Grid.Column="5" Grid.Row="3" Text="退出" Padding="13,8" />
</Grid>
</local:MyCard>
<local:MyCard Grid.Row="2" HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="8">
<StackPanel Orientation="Horizontal" Margin="3,0">
<StackPanel x:Name="BtnFinishPing" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="延迟" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="50" ToolTipService.VerticalOffset="40" ToolTipService.HorizontalOffset="4">
<Path IsHitTestVisible="False" Height="14" Width="14" Stretch="Uniform" Fill="#9C9C9C" Margin="13,0,8,0"
Data="M60.9 966.2A60.3 60.3 0 0 1 0.8 906.1v-90.1a60.3 60.3 0 0 1 60.1-60.1 60.3 60.3 0 0 1 60.1 60.1v90.1a60.2 60.2 0 0 1-60.1 60.1z m300.6 0a60.3 60.3 0 0 1-60.1-60.1V665.6a60.3 60.3 0 0 1 60.1-60.1 60.3 60.3 0 0 1 60.1 60.1v240.5a60.2 60.2 0 0 1-60.1 60.1z m300.6 0a60.3 60.3 0 0 1-60.1-60.1V425.1a60.3 60.3 0 0 1 60.1-60.1 60.3 60.3 0 0 1 60.1 60.1v481.0a60.3 60.3 0 0 1-60.1 60.1z m300.6 0a60.3 60.3 0 0 1-60.1-60.1V124.5a60.3 60.3 0 0 1 60.1-60.1 60.3 60.3 0 0 1 60.1 60.1v781.6a60.3 60.3 0 0 1-60.1 60.1z" />
<TextBlock x:Name="LabFinishPing" IsHitTestVisible="False" Text="15 ms" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0.5,13,0" />
</StackPanel>
<TextBlock Text="|" Opacity="0.2" Margin="0,8.8,0,8" RenderTransformOrigin="0.5,0.5">
<TextBlock.RenderTransform>
<ScaleTransform ScaleX="1.5" ScaleY="2.75" CenterX="0.5" CenterY="0.5" />
</TextBlock.RenderTransform>
</TextBlock>
<StackPanel x:Name="BtnFinishPlayer" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="房间内人数" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="50" ToolTipService.VerticalOffset="40" ToolTipService.HorizontalOffset="4">
<Path IsHitTestVisible="False" Height="18" Width="18" Stretch="Uniform" Fill="{StaticResource ColorBrushGray4}" Margin="13,0,8,0"
Data="m843.3,478.4c-.1-3.9-.2-7.7-.2-10.8,0-42.8-11.1-84.4-32-120.2-19.6-33.5-47.1-60.7-79.7-79,15-16.8,23.6-39.2,25-65.2,1.3-24.8-3.7-52.1-14.6-79-20.5-50.8-56-86.3-86.3-86.3s-25.1,4.1-37.5,23.5l-.4.7-.2.8c-4.1,16.6,3.9,33.4,20,41.7l.7.4h.8c34.9,5.6,50.6,38.7,53.5,65.3,3.3,30.7-7.8,67.2-40.1,80.1-7.4,1.1-9.9,7.7-11.5,12.1-.6,1.7-1.2,3.3-1.9,4.3l-.7,1v1.2c-3.4,27.8,19.6,39.8,46.3,53.6,41.4,21.4,93,48.1,93.1,144.9v.3c.3,4.3,0,9.9-.1,15.7-.6,17.9-1.4,40.2,10.3,52.4,5.5,5.7,13,8.6,22.5,8.7.7,0,1.4,0,2.1,0h0c8.1,0,14.7-2.6,19.8-7.9,12.7-13.1,11.9-39.4,11.4-58.6Z M204.7,295.9l.5-1.1v-30.1c0-3.9-2.1-6-3.3-7.1-.1-.1-.2-.2-.3-.3v-1.7l-8.9-9.2-.7-.4c-26.3-13.5-42.6-40.8-42.6-71.3s21.8-67.4,55.5-78.1c17-4.5,28.2-22.1,24.5-38.4v-.6c-.1,0-.4-.5-.4-.5-7.5-15.3-21.4-24.7-36.2-24.7s-5.1.3-7.7.8h-.2c-29.8,7.2-56.6,25.5-75.7,51.4-18.9,25.7-29.3,57.8-29.3,90.4s11.1,64.8,32.2,92.1C45.3,303.9,2.5,376.9,0,458.9v57.5s0,.2,0,.2c1.4,15.3,13.1,30.8,32.8,30.8s32.9-12.7,32.9-33.9v-43.3c0-76.2,45.9-139.2,114.3-157.1,10.5-.5,19.5-6.8,24.7-17.3Z M516,286.5c36.8-31.1,58.5-77.4,58.5-125.4C574.4,70.8,507.4,0,421.7,0s-152.7,70.8-152.7,161.2,20.4,95.1,56.4,125.6c-51.7,19.8-96.1,54.8-129,101.5-35.2,50.2-53.9,109.7-53.9,172v33.8c0,16.9,13.7,30.6,30.6,30.6h496.6c16.9,0,30.6-13.7,30.6-30.6v-33.8c0-61.4-19-120.6-54.9-171.3-32.9-46.4-78.6-82.5-129.5-102.4Zm-94.5-225.3c51.3,0,91.5,43.9,91.5,100s-41.9,100-91.5,100-91.5-43.9-91.5-100,40.2-100,91.5-100Zm218,502H203.8v-3.2c0-127,97.8-230.3,218-230.3s217.7,105.4,217.7,230.3v3.2Z" />
<TextBlock x:Name="LabFinishPlayer" IsHitTestVisible="False" Text="2  人" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0.5,13,0" />
</StackPanel>
<TextBlock Text="|" x:Name="LineFinishPort" Opacity="0.2" Margin="0,8.8,0,8" RenderTransformOrigin="0.5,0.5">
<TextBlock.RenderTransform>
<ScaleTransform ScaleX="1.5" ScaleY="2.75" CenterX="0.5" CenterY="0.5" />
</TextBlock.RenderTransform>
</TextBlock>
<StackPanel x:Name="BtnFinishPort" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="端口" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="50" ToolTipService.VerticalOffset="40" ToolTipService.HorizontalOffset="4">
<Path IsHitTestVisible="False" Height="16" Width="16" Stretch="Uniform" Fill="{StaticResource ColorBrushGray4}" Margin="13,0,7,0"
Data="m365,295.3c-15.1-3.6-36.5-1.8-39.6,17.5-1.2,12.4,0,107-.5,119.7.8,16.8-5.2,42.4,16.8,47.1,14.3,3.3,34.5,1.9,38.7-15.4,2.6-1.4.1-142.4,1-148.3-.7-10.9-6.2-17.8-16.4-20.6ZM234.1,311.6c-3.2-16.7-20-18.6-34.4-17.2-9.8.4-17.2,6.2-20,15.4-4.4,47.8-.2,97.3-1.6,144.8,0,16,9.8,26.6,24.6,26.1,14.4,1.4,29.1-2.9,31.7-19,2.2-8.8.8-63.9,1.1-74.1-1-25.3,2.1-50.6-1.5-75.9ZM521.4,300.6c-5.4-6.2-15.9-7.1-24.6-6.4-11.9-1-23,6.6-24.7,18.7-2.2,24.1-2,124-.2,148.1,2.6,19.7,24.1,22.4,40.1,18.4,11.9-2.4,16.6-15.2,16.3-27.1,0-33.6.1-69.3,0-103.1-1.2-15.1,4.2-37-6.9-48.5ZM708.8,194.2c.7-34.5-26.8-63.7-61.5-63.4-22.1-.1-52.4,0-75.6,0-13.4,1.1-8.7-12.1-9.6-20.9-1.6-30.6,7.5-67.2-17.5-90.9-11.7-11.9-27.4-18.4-44.3-18.4-64.8,0-129.7,0-194.5,0-37.7,1.4-76.5-3.1-113.8,2.2-48.1,14.7-46.7,55.3-45.4,97.3,0,8,.1,16.1,0,24.1.2,7-7.3,6.8-12.2,6.6-16,0-32,0-48,0-24.4-.7-51.3-1-68.6,18.4C5.8,161.2,0,176.1,0,194.7c0,0,0,350.9,0,350.9,0,22.9,5.5,41.7,16.8,57.5,19.2,27,45.9,40.7,79.5,40.7,37.4,0,77.4.1,129.9.1,42.5,0,85,0,127.5,0,11.2-1.3,273.6,2.4,278-1.8,46.1-9.1,77.1-46.8,77.1-93.8,0-117.8,0-237.9,0-354.1Zm-71-5.3c7.6.2,9.2,1.9,9.3,9.7,0,0,0,347.3,0,347.3,0,3.2.2,6.5-.3,9.9-2.8,19.3-18.9,32.3-38.5,31.9-4.5.4-508.9-.4-513.5,0-3.2,0-6.5.1-9.9-.4-19-2.9-31.8-17.8-31.8-37.1,0-117.9,0-233.9,0-350.9,0-9,2.3-10.3,10.9-10.3,0,0,131.2,0,131.2,0,1.6,0,3,0,4.5,0,0-1.5,0-2.7,0-4.3,0,0,0-115.7,0-115.7.1-8.3,1.9-10.1,10.3-10.1h280.3c8.3,0,10.1,1.8,10.1,10.3v114.1c0,1.9,0,3.7,0,5.6" />
<TextBlock x:Name="LabFinishPort" IsHitTestVisible="False" Text="12345" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0.5,13,0" />
</StackPanel>
<StackPanel x:Name="BtnFinishIp" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="服务器 IP(点击复制)" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="50" ToolTipService.VerticalOffset="40" ToolTipService.HorizontalOffset="4">
<Path IsHitTestVisible="False" Height="17" Width="17" Stretch="Uniform" Fill="{StaticResource ColorBrushGray4}" Margin="11,0,7,0"
Data="m346.4,692.8c-92.5,0-179.5-36-244.9-101.5C36,525.9,0,438.9,0,346.4S36,166.9,101.5,101.5C166.9,36,253.9,0,346.4,0s179.5,36,244.9,101.5c65.4,65.4,101.5,152.4,101.5,244.9s-36,179.5-101.5,244.9c-65.4,65.4-152.4,101.5-244.9,101.5Zm0-645.1c-164.7,0-298.7,134-298.7,298.7s134,298.7,298.7,298.7,298.7-134,298.7-298.7S511.1,47.7,346.4,47.7Zm13.8,473.4c-14.5,0-28.2-9.8-28.2-24.2V207.9c0-14.5,11.8-26.2,26.2-26.2h78.9c57.9,0,105.1,47.1,105.1,105.1s-47.1,105.1-105.1,105.1h-52.6v105.1c0,14.5-9.8,24.2-24.2,24.2Zm24.2-181.7h52.6c29,0,52.6-23.6,52.6-52.6s-20-49.2-46.5-52.3h-.4s-5.3-.4-5.3-.4h-53v105.2Zm-158.8,181.7c-14.5,0-28.2-9.8-28.2-24.2V207.9c0-14.5,11.8-26.2,26.2-26.2s26.2,11.8,26.2,26.2v289c0,14.5-9.8,24.2-24.2,24.2Z" />
<TextBlock x:Name="LabFinishIp" IsHitTestVisible="False" Text="6.0.0.1:12345" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray1}" Margin="0,0.5,13,0" />
</StackPanel>
</StackPanel>
</local:MyCard>
</Grid>
</Grid>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
</Grid>
</Grid>
</local:MyPageRight>
@@ -0,0 +1,959 @@
Imports System.Net.Sockets
Public Class PageLinkMain
'===============================
' 状态机与前端页面
'===============================
#Region "状态管理"
Public Enum LinkStates
Waiting
Loading
Failed
Finished
End Enum
Public Shared LinkState As LinkStates = LinkStates.Waiting
''' <summary>
''' 切换到指定的状态。
''' </summary>
Private Sub ChangeState(NewState As LinkStates)
If LinkState = NewState Then Return
Dim OldState = LinkState
LinkState = NewState
Log($"[Link] 主状态由 {GetStringFromEnum(OldState)} 变更为 {GetStringFromEnum(NewState)}")
'触发状态切换
RunInUi(
Sub()
Select Case NewState
Case LinkStates.Waiting
SwitchToWaiting(OldState)
Case LinkStates.Loading
SwitchToLoading(OldState)
Case LinkStates.Failed
SwitchToFailed(OldState)
Case LinkStates.Finished
SwitchToFinished(OldState)
End Select
End Sub)
End Sub
'让加载器的 成功/失败 事件触发状态切换
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, LinkLoader, AutoRun:=False)
AddHandler LinkLoader.OnStateChangedUi,
Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Finished
ChangeState(LinkStates.Finished)
Case LoadState.Failed
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDetail, "*"))
ChangeState(LinkStates.Failed)
End Select
End Sub
End Sub
'页面动画兼容
Private Sub UpdatePanelVisibility() Handles Me.PageEnter
FrmLinkMain.PanSelect.Visibility = If(LinkState = LinkStates.Waiting, Visibility.Visible, Visibility.Collapsed)
FrmLinkMain.PanFinish.Visibility = If(LinkState = LinkStates.Finished, Visibility.Visible, Visibility.Collapsed)
End Sub
#End Region
#Region "初始页面 (Waiting)"
'由任意状态切换到 Waiting
Private Sub SwitchToWaiting(OldState As LinkStates)
'加载器与进程状态
LinkLoader.Abort()
SyncLock LinkLoader.LockState
LinkLoader.State = LoadState.Waiting
End SyncLock
ProcessStop()
'页面切换
If OldState <> LinkStates.Finished Then
'从完成页面退出时,PageOnContentExit 结束会触发 PageEnter 事件,这会调用 UpdatePanelVisibility
'如果在现在提前调用了,会丢失完成页面的退出动画
UpdatePanelVisibility()
End If
PageOnContentExit()
End Sub
'===============================
' 页面 UI
'===============================
'创建
Private Sub Create_MouseLeftButtonUp() Handles PanSelectCreate.MouseLeftButtonUp
'输入端口号
Dim Port As String = MyMsgBoxInput("输入端口", $"在单人游戏的暂停菜单选择 {vbLQ}对局域网开放{vbRQ},然后输入端口数字。{vbCrLf}甚至可以输入其他游戏的端口……嗯……",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateInteger(1024, 65535)},
HintText:="端口号")
If Port Is Nothing Then Return
'基础信息
IsServerSide = True
ServerPort = Port
Dim GenerateRandomCode =
Function() As String
Dim Result As String = ""
For i = 1 To 5
Result &= RadixConvert(RandomInteger(0, 35), 10, 36)
Next
Return Result.Replace("O", "0").Replace("I", "1")
End Function
NetworkName = $"P{RadixConvert(ServerPort, 10, 16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode()
Log($"[Link] 尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
'启动
ChangeState(LinkStates.Loading)
End Sub
'加入
Private Shared LastCode As String = Nothing
''' <summary>
''' 输入邀请码,切换到联机页并立即加入房间。
''' </summary>
Public Shared Sub Join() Handles PanSelectJoin.MouseLeftButtonUp
Dim Code As String = MyMsgBoxInput("输入邀请码", "输入房主发给你的邀请码。",
HintText:=If(String.IsNullOrEmpty(LastCode), "", "使用上一次的邀请码:" & LastCode))
If Not String.IsNullOrEmpty(LastCode) AndAlso Code IsNot Nothing AndAlso Code = "" Then Code = LastCode
If Code Is Nothing Then Return
Join(Code)
End Sub
Public Sub JoinInternal(Code As String)
If Code Is Nothing Then Return
'基础格式校验
Code = Code.Between("【", "】").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正
Dim ValidateResult = ValidateCodeFormat(Code)
If ValidateResult IsNot Nothing Then
Hint(ValidateResult, HintType.Red)
Return
End If
'基础信息
IsServerSide = False
ServerPort = RadixConvert(Code.Substring(1, 4), 16, 10)
NetworkName = Code.Substring(0, 11)
NetworkSecret = Code.Substring(12, 5)
Log($"[Link] 尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
'启动
LastCode = Code
ChangeState(LinkStates.Loading)
End Sub
Public Shared Function ValidateCodeFormat(Code As String) As String
If Code Is Nothing Then Return "邀请码为空!"
Code = Code.Between("【", "】").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正
If Not (Code.Length >= 14 AndAlso Code(0) = "P"c AndAlso Code(5) = "-"c AndAlso Code(11) = "-"c) Then
If Code.StartsWithF("U/") Then 'HMCL
Return "请让房主使用 PCL 创建房间!"
ElseIf Code.Length = 10 Then 'PCL CE
Return "请让房主使用非社区版的 PCL 创建房间!"
Else
Return "邀请码有误,请让房主使用 PCL 创建房间!"
End If
End If
Return Nothing
End Function
'自动加入
''' <summary>
''' 切换到联机页并立即加入指定房间。
''' </summary>
Public Shared Sub Join(Code As String)
If LinkState <> LinkStates.Waiting Then
Hint("你已经在联机房间中了!", HintType.Red)
ElseIf FrmMain.PageCurrent = FormMain.PageType.Link Then
FrmLinkMain.JoinInternal(Code)
Else
AutoJoinCode = Code
FrmMain.PageChange(FormMain.PageType.Link, FormMain.PageSubType.LinkMain)
End If
End Sub
'在进入页面时自动尝试加入房间
Private Shared AutoJoinCode As String = Nothing
Private Sub PanSelectJoin_Loaded() Handles PanSelectJoin.Loaded
If AutoJoinCode Is Nothing Then Return
If LinkState = LinkStates.Waiting Then JoinInternal(AutoJoinCode)
AutoJoinCode = Nothing
End Sub
#End Region
#Region "加载页面 (Loading | Failed)"
'由 Waiting 或 Failed 状态切换到 Loading
Private Sub SwitchToLoading(OldState As LinkStates)
'清理变量
Peers = Nothing
FailCount = 0
'加载器与进程状态
LinkLoader.Start(IsForceRestart:=True)
'页面切换会由 Loader 调用 MyPageRight 来触发
'UI 更新
UpdateProgressBar(0)
LabLoadTitle.Text = If(IsServerSide, "创建房间中", "加入房间中")
UpdateLoadingPage("正在初始化……", "准备初始化")
End Sub
'由 Loading 状态切换到 Failed
Private Sub SwitchToFailed(OldState As LinkStates)
'加载器与进程状态
LinkLoader.Abort()
ProcessStop()
'UI 更新
UpdateProgressBar(1)
'显示错误信息
LabLoadTitle.Text = FailReason
Dim Brief As String = LinkLoader.Error.GetBrief
Dim InnerEx As Exception = LinkLoader.Error
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Loop
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDetail)
Log(LinkLoader.Error, LabLoadTitle.Text)
End Sub
'===============================
' 页面 UI
'===============================
Private Sub UpdateLoadingPage(Title As String, FailBrief As String)
If FailReason = FailBrief & "失败" Then Return
FailReason = FailBrief & "失败"
Log("[Link] 开始步骤:" & Title)
RunInUiWait(
Sub()
If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return
FrmLinkMain.LabLoadDesc.Text = Title
End Sub)
End Sub
Private FailReason As String = "准备初始化"
'取消加载
Private Sub BtnLoadCancel_Click() Handles BtnLoadCancel.Click
ChangeState(LinkStates.Waiting)
End Sub
'点击重试
Private Sub CardLoad_MouseLeftButtonUp() Handles CardLoad.MouseLeftButtonUp
ChangeState(LinkStates.Loading)
End Sub
'进度条
Private Sub UpdateProgressBar(Optional Value As Double = -1)
If Value = -1 Then Value = LinkLoader.Progress
Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
If Math.Round(Value - DisplayingProgress, 3) = 0 Then Return
If DisplayingProgress <= Value Then
Dim NewProgress As Double = If(Value = 1, 1, DisplayingProgress +
(Value - DisplayingProgress) ^ 2 * 0.5)
AniStart({
AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 200),
AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 200)
}, "Link Progress")
Else
ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
AniStop("Link Progress")
End If
End Sub
Private Sub CardLoad_SizeChanged() Handles CardLoad.SizeChanged
RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
End Sub
#End Region
#Region "完成页面 (Finished)"
'由 Loading 状态切换到 Finished
Private Sub SwitchToFinished(OldState As LinkStates)
'由于只可能从加载器的完成事件触发,不需要管加载器
UpdatePanelVisibility() '页面的实际切换会由 Loader 调用 MyPageRight 来触发
'UI 更新
If IsServerSide Then
LabFinishTitle.Text = "已创建房间"
LabFinishDesc.Text = $"把邀请码发给朋友,让大家加入房间吧!{vbCrLf}邀请码:{NetworkName}-{NetworkSecret}"
BtnFinishExit.Text = "关闭"
BtnFinishCopy.Visibility = Visibility.Visible
Copy() '立即复制邀请码
'下边栏
BtnFinishPort.Visibility = Visibility.Visible
LabFinishPort.Visibility = Visibility.Visible
BtnFinishIp.Visibility = Visibility.Collapsed
LabFinishIp.Visibility = Visibility.Collapsed
LabFinishPort.Text = ServerPort
Else
LabFinishTitle.Text = "已加入房间"
LabFinishDesc.Text = $"在多人游戏页面的最下方就能找到联机房间!{vbCrLf}注意:使用离线登录时不要手动输入 IP!"
BtnFinishExit.Text = "离开"
BtnFinishCopy.Visibility = Visibility.Collapsed
'下边栏
BtnFinishPort.Visibility = Visibility.Collapsed
LabFinishPort.Visibility = Visibility.Collapsed
LabFinishIp.Text = ClientAddress
BtnFinishIp.Visibility = Visibility.Visible
LabFinishIp.Visibility = Visibility.Visible
End If
Update() '立即刷新
End Sub
'===============================
' 页面 UI
'===============================
'退出
Private Sub BtnFinishExit_Click() Handles BtnFinishExit.Click
TryExit(False, False)
End Sub
''' <summary>
''' 退出联机。
''' 返回是否弹出了警告窗口并且玩家选择了取消。
''' </summary>
Public Function TryExit(Slient As Boolean, Closing As Boolean) As Boolean
If LinkState = LinkStates.Waiting OrElse LinkState = LinkStates.Failed Then Return False
If Not Slient Then
If IsServerSide AndAlso PeopleCount > 1 Then
If MyMsgBox("你确定要关闭联机房间吗?" & vbCrLf & "所有玩家都需要重新输入邀请码才可加入游戏!", "退出联机", "确定", "取消", IsWarn:=True) = 2 Then Return True
ElseIf Closing Then
If MyMsgBox(If(IsServerSide, "你确定要关闭联机房间吗?", "你确定要离开联机房间吗?"), "退出联机", "确定", "取消") = 2 Then Return True
End If
End If
ChangeState(LinkStates.Waiting)
Return False
End Function
'复制邀请码
Private Sub Copy() Handles BtnFinishCopy.Click
Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{NetworkName}-{NetworkSecret}】,即可加入联机房间!"
ClipboardSet(CodeText, False)
Setup.Set("LinkLastAutoJoinInviteCode", CodeText)
Hint("已复制邀请码!", HintType.Green)
End Sub
'复制 IP
Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
ClipboardSet(ClientAddress, False)
Hint("已复制服务器地址!", HintType.Green)
End Sub
#End Region
'===============================
' 后端
'===============================
''' <summary>
''' EasyTier 所在的文件夹路径,以 \ 结尾。
''' </summary>
Private PathEasyTier As String = PathAppdata & "EasyTier\"
''' <summary>
''' 当前是服务端还是客户端。
''' </summary>
Private IsServerSide As Boolean
''' <summary>
''' 服务端映射前的端口号。
''' </summary>
Private ServerPort As Integer
''' <summary>
''' 客户端映射后的端口号。
''' </summary>
Private ClientPort As Integer
''' <summary>
''' RPC 端口号。
''' </summary>
Private RPCPort As Integer
''' <summary>
''' 在客户端映射后的地址。
''' 除非已作为客户端启动 EasyTier,否则一直为 Nothing。
''' </summary>
Private ClientAddress As String = Nothing
''' <summary>
''' 网络信息。
''' </summary>
Private NetworkName As String, NetworkSecret As String
#Region "加载"
Private WithEvents LinkLoader As New LoaderCombo(Of Integer)("联机", {
New LoaderTask(Of Integer, Integer)("获取配置", AddressOf InitConfig) With {.Block = False, .ProgressWeight = 8},
New LoaderTask(Of Integer, List(Of NetFile))("准备下载联机模块", AddressOf InitPrepareDownload) With {.ProgressWeight = 2},
New LoaderDownload("下载联机模块", New List(Of NetFile)) With {.ProgressWeight = 40},
New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 50}
})
'1. 获取服务器配置
Private Sub InitConfig(Task As LoaderTask(Of Integer, Integer))
UpdateLoadingPage("正在联网获取配置……", "联网获取配置")
If VersionBranchMain <> "Official" Then
Throw New Exception($"$开源版无法联网获取配置。{vbCrLf}你可以在 PCL 官方版的缓存文件夹下查看 ServerConfig 的当前内容, 并在代码中进行相应修改。")
End If
ServerLoader.WaitForExit(LoaderToSyncProgress:=Task)
If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置")
If Not String.IsNullOrEmpty(ServerConfig("Link")("DisableReason")) Then '检查是否已禁用联机功能
Throw New Exception("$" & ServerConfig("Link")("DisableReason").ToString)
End If
End Sub
'2. 获取需要下载的文件
Private ServerVersion As Integer
Private Sub InitPrepareDownload(Task As LoaderTask(Of Integer, List(Of NetFile)))
'获取 CPU 架构
UpdateLoadingPage("正在获取 CPU 架构……", "获取 CPU 架构")
Dim Architecture As String = GetType(String).Assembly.GetName().ProcessorArchitecture
Select Case Architecture
Case Reflection.ProcessorArchitecture.X86
Architecture = "i686"
Case Reflection.ProcessorArchitecture.Amd64
Architecture = "x86_64"
Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64"
Case Else
Log($"[Link] CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!", LogLevel.Debug)
Architecture = "arm64"
End Select
Log("[Link] CPU 架构:" & Architecture)
Telemetry("联机开始")
'检查 EasyTier 版本
UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso
File.Exists(PathEasyTier & "Packet.dll")) Then
Setup.Set("LinkEasyTierVersion", -1)
End If
Dim LocalVersion As Integer = Setup.Get("LinkEasyTierVersion")
ServerVersion = ServerConfig("Link")("EasyTierVersion")
Dim RequiredFiles As New List(Of NetFile)
Log($"[Link] EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}")
If LocalVersion < ServerVersion Then
RequiredFiles.Add(New NetFile(
ServerConfig("Link")("Downloads").Select(Function(UrlEntry) UrlEntry.ToString.Replace("{arch}", Architecture)),
PathEasyTier & "EasyTier.zip",
New FileChecker(MinSize:=1024 * 1024 * 2)))
End If
'开始下载
UpdateLoadingPage("正在下载联机模块……", "下载联机模块")
Task.Output = RequiredFiles
End Sub
'3. 启动联机模块
Private Shared HostName As String
Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
'解压文件
UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
If File.Exists(PathEasyTier & "EasyTier.zip") Then
'解压
Dim ExtractPath As String = RequestTaskTempFolder()
ExtractFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName
Log("[Link] 联机模块解压时的临时路径:" & ExtractedPath)
CopyDirectory(ExtractedPath, PathEasyTier)
'重命名
File.Delete(PathEasyTier & "联机模块.exe")
Rename(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
File.Delete(PathEasyTier & "联机模块 CLI.exe")
Rename(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
'清理
File.Delete(PathEasyTier & "EasyTier.zip")
Setup.Set("LinkEasyTierVersion", ServerVersion)
End If
Task.Progress = 0.07
'获取节点列表
Dim Peers As List(Of String)
Dim CustomPeers As String = Setup.Get("LinkCustomPeer")
If String.IsNullOrWhiteSpace(CustomPeers) Then
Peers = GetOnlinePeers()
Else
Peers = CustomPeers.Split(",,".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList()
Log("[Link] 使用自定义节点")
End If
Task.Progress = 0.13
'获取空闲端口
UpdateLoadingPage("正在启动联机模块……", "启动联机模块")
Dim FreePorts = FindFreePorts(5, ServerPort)
ClientPort = FreePorts(0)
RPCPort = FreePorts(1)
Dim ListenersPort As Integer = FreePorts(2) '它会占用【当前、当前 +1、当前 +2】共三个端口
'获取启动参数
Dim Arguments As String = ServerConfig("Link")("Argument")
Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort}"
HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36)
If IsServerSide Then
Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}"
Else
Arguments += $" -d --hostname={HostName} --tcp-whitelist=0 --udp-whitelist=0"
'端口转发
ClientAddress = $"localhost:{ClientPort}"
Arguments += $" --port-forward tcp://[{IPAddress.IPv6Loopback}]:{ClientPort}/10.114.114.114:{ServerPort}"
Arguments += $" --port-forward udp://[{IPAddress.IPv6Loopback}]:{ClientPort}/10.114.114.114:{ServerPort}"
Arguments += $" --port-forward tcp://{IPAddress.Loopback}:{ClientPort}/10.114.114.114:{ServerPort}"
Arguments += $" --port-forward udp://{IPAddress.Loopback}:{ClientPort}/10.114.114.114:{ServerPort}"
End If
For Each Peer As String In Peers
Arguments += $" -p=""{Peer}"""
Next
Arguments += " --private-mode true" '老好人模式现在莫得用:If Not Setup.Get("LinkShareMode") Then
'启动进程
ProcessStart(Arguments)
Task.Progress = 0.15
'等待连接
Dim TimeoutCounter As Integer = 0
Do
Thread.Sleep(500) '为避免还没启动好先跑 CLI 了,先等半秒
'刷新信息
CheckCrash()
RefreshPeerLoader.WaitForExit(IsForceRestart:=True)
'查找目标节点
Dim Ping = GetPeerPing()
If Ping <> 0 Then
Log($"[Link] 已与目标建立连接,当前 Ping 为 {Ping:0.0}ms")
Telemetry("联机成功", "Server", IsServerSide, "Ping", Ping)
Exit Do '退出循环
End If
'更新进度
Dim LastProgress = Task.Progress
Dim PeerCount As Integer = If(Peers Is Nothing, -1, Peers.Count)
Select Case PeerCount
Case -1 'CLI 无返回
Task.Progress = MathClamp(Task.Progress + 0.02, 0.15, 0.25)
Case 0 'CLI 有返回,但未连接到任何节点
UpdateLoadingPage("正在连接到节点……", "连接节点")
Task.Progress = MathClamp(Task.Progress + 0.02, If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.99, 0.5))
Case Else '已连接到节点,但未连接到房主
UpdateLoadingPage("正在连接到房主……", "连接房主")
Task.Progress = MathClamp(Task.Progress + 0.02, Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.99)
End Select
'超时判定
If LastProgress <> Task.Progress Then
TimeoutCounter = 0
ElseIf TimeoutCounter < 30 * 2 Then
TimeoutCounter += 1
Else '进度停滞超过 30s
Select Case PeerCount
Case -1 'CLI 无返回
Panic("无法启动联机模块", "近期日志:" & vbCrLf & LogHistory.Join(vbCrLf))
Case 0 'CLI 有返回,但未连接到任何节点
Panic("无法连接到节点", $"请检查你的网络环境是否良好。")
Case Else '已连接到节点,但未连接到房主
Panic("无法连接到房主", $"可能的原因:{vbCrLf}- 你或者房主的网络环境不佳{vbCrLf}- 房主已关闭房间{vbCrLf}- 邀请码输错了")
End Select
End If
Loop Until Task.IsAborted
If Task.IsAborted Then Throw New ThreadInterruptedException
End Sub
''' <summary>
''' 从在线配置和 API 获取节点列表。
''' </summary>
Private Function GetOnlinePeers() As List(Of String)
Dim Peers As List(Of String) = ServerConfig("Link")("Peers").Select(Function(p) p.ToString).ToList()
Try
'从 API 获取节点列表
Dim BlackList As List(Of String) = ServerConfig("Link")("PeersBlackList").Select(Function(p) p.ToString).ToList() '黑名单
Dim CentralNodes As New List(Of String)
Dim RandomNodes As New List(Of Tuple(Of String, Double))
For Each Node As JObject In CType(GetJson(NetRequestByClientRetry("https://uptime.easytier.cn/api/nodes?page=1&per_page=200")), JObject)("data")("items")
'状态检查
If Node("protocol").ToString <> "tcp" Then Continue For
If Node("current_health_status").ToString <> "healthy" Then Continue For
If Not Node("is_active").ToObject(Of Boolean) Then Continue For
If Not Node("is_approved").ToObject(Of Boolean) Then Continue For
Dim Tags = Node("tags").Select(Function(t) t.ToString).ToList
If Not Tags.Contains("国内") Then Continue For
If Tags.Contains("即将下线") Then Continue For
Dim Address As String = Node("address").ToString
If BlackList.Contains(Address) Then Continue For
'添加节点
If Tags.Contains("MC") Then
CentralNodes.Add(Address)
Else
If Not Node("allow_relay").ToObject(Of Boolean) Then Continue For
If Node("usage_percentage").ToObject(Of Double) = 0 Then Continue For '或许节点有问题才导致是 0 负载
RandomNodes.Add(New Tuple(Of String, Double)(
Address,
Node("usage_percentage").ToObject(Of Double) * (103 - Node("health_percentage_24h").ToObject(Of Double)))) '负载,越低越好
End If
Next
RandomNodes = RandomNodes.OrderBy(Function(n) n.Item2).ToList()
Log($"[Link] 获取到 {CentralNodes.Count} 个中心节点,{RandomNodes.Count} 个随机节点")
'选择节点
Dim RandomCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
If RandomNodes.Count < RandomCount Then Throw New Exception($"可用的随机节点数量不足,需要 {RandomCount} 个,实际 {RandomNodes.Count} 个")
Peers = CentralNodes.Concat(RandomNodes.Take(RandomCount).Select(Function(n) n.Item1)).ToList()
Catch ex As Exception
Log(ex, "获取节点列表失败,联机质量可能受到影响", LogLevel.Hint)
End Try
Return Peers
End Function
#End Region
#Region "进程与日志"
''' <summary>
''' EasyTier Core 进程。
''' </summary>
Private Shared ProcessCore As Process
Private Shared ProcessOutputHandle As AutoResetEvent, ProcessErrorHandle As AutoResetEvent
''' <summary>
''' 若程序正在运行,则结束程序进程。
''' 即使失败也不会抛出异常。
''' </summary>
Public Shared Sub ProcessStop()
Try
'关闭未捕获的进程
For Each ProcessObject In Process.GetProcesses
If ProcessObject.Id = ProcessCore?.Id Then Continue For
If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For
Try
Log("[Link] 停止残留的联机模块,PID:" & ProcessObject.Id & ",进程名:" & ProcessObject.ProcessName)
ProcessObject.Kill()
ProcessObject.Close()
Catch exx As Exception
Log(exx, $"结束进程失败({ProcessObject.ProcessName},PID {ProcessObject.Id})")
End Try
Next
'关闭由自身启动的进程
If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then
Log("[Link] 停止所启动的联机模块,PID:" & ProcessCore.Id)
ProcessCore.Kill()
ProcessCore.Close()
ProcessCore = Nothing
End If
'释放资源
ProcessOutputHandle?.Dispose()
ProcessErrorHandle?.Dispose()
Catch ex As Exception
Log(ex, "停止联机模块失败")
End Try
End Sub
''' <summary>
''' 出现意外错误,给出错误信息并结束联机。
''' </summary>
Private Sub Panic(Brief As String, Detail As String)
If LinkState = LinkStates.Loading Then
FailReason = Brief
LinkLoader.Failed(New Exception(Detail))
Else
MyMsgBox(Detail, "联机出错:" & Brief, IsWarn:=True)
ChangeState(LinkStates.Waiting)
Telemetry("联机失败", "Exception", FilterUserName(Brief & ":" & Detail, "*"))
End If
End Sub
''' <summary>
''' 启动进程。
''' </summary>
Private Sub ProcessStart(Arguments As String)
Dim Info = New ProcessStartInfo With {
.FileName = PathEasyTier & "联机模块.exe",
.Arguments = Arguments,
.UseShellExecute = False,
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.StandardOutputEncoding = Encoding.UTF8,
.StandardErrorEncoding = Encoding.UTF8
}
Log("[Link] 正在启动 EasyTier:" & Arguments)
ProcessCore = New Process With {.StartInfo = Info}
Dim LogLineHandler =
Function(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent)
Try
If e.Data Is Nothing Then
Handle.[Set]()
Return Nothing
End If
ProcessLogLine(e.Data)
Catch unused As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 EasyTier 信息失败")
End Try
Return Nothing
End Function
ProcessOutputHandle = New AutoResetEvent(False)
AddHandler ProcessCore.OutputDataReceived, Function(sender, e) LogLineHandler(sender, e, ProcessOutputHandle)
ProcessErrorHandle = New AutoResetEvent(False)
AddHandler ProcessCore.ErrorDataReceived, Function(sender, e) LogLineHandler(sender, e, ProcessErrorHandle)
ProcessCore.Start()
ProcessCore.BeginOutputReadLine()
ProcessCore.BeginErrorReadLine()
End Sub
Private Sub ProcessLogLine(Line As String)
'记录日志
Log("[EasyTier] " & Line)
LogHistory.Enqueue(Line)
If LogHistory.Count >= 10 Then LogHistory.Dequeue()
'检查日志内容
If Line.ContainsF("new peer connection added", True) Then
Log("[Link] 已建立连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), LogLevel.Debug)
Update()
ElseIf Line.ContainsF("peer connection removed", True) Then
Log("[Link] 已断开连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), LogLevel.Debug)
Update()
End If
End Sub
Private LogHistory As New Queue(Of String)(10)
#End Region
#Region "CLI 节点信息获取"
Private Class Peer
''' <summary>
''' 该节点的类型。
''' </summary>
Public ReadOnly Type As Types
Public Enum Types
''' <summary>
''' 客户端。
''' </summary>
Client
''' <summary>
''' 服务器。
''' </summary>
Server
''' <summary>
''' 公共节点。
''' </summary>
Misc
''' <summary>
''' 自己,或者自己的重复(它可能返回多个自己)。
''' </summary>
Self
End Enum
''' <summary>
''' 与该节点的延迟 (ms)。
''' 若是自己则为 0。
''' </summary>
Public ReadOnly Ping As Double
''' <summary>
''' 名称。
''' </summary>
Public ReadOnly Name As String
''' <summary>
''' 连接方式。
''' </summary>
Public ReadOnly Cost As String
''' <summary>
''' 从 CLI 给出的信息分析对应的数据。
''' </summary>
Public Sub New(Info As JObject)
'类别
Dim PeerName = Info("hostname").ToString
If PeerName = HostName Then
Type = Types.Self
ElseIf PeerName.StartsWithF("Client") Then
Type = Types.Client
ElseIf Info("ipv4") = "10.114.114.114" Then '只允许这个 IP 作为房主,避免网络被多个房主搞炸的情况
Type = Types.Server
Else
Type = Types.Misc
End If
'基础信息
Ping = If(Info("lat_ms").ToString = "-", 0, Info("lat_ms").ToString)
Name = PeerName
Cost = Info("cost")
End Sub
Public Overrides Function ToString() As String
Return $"{Type} - {Name} - Ping {Ping:0.0}ms [{Cost}]"
End Function
End Class
''' <summary>
''' 当前的节点列表,使用 RefreshPeerLoader 来刷新。
''' 若尚未成功获取过则为 Nothing,但保证在加载完成后至少是一个列表。
''' </summary>
Private Peers As List(Of Peer) = Nothing
''' <summary>
''' 调用 EasyTier CLI 获取已连接节点信息。
''' 这会过滤掉尚未完成连接的其他节点以及自己。
''' 若在加载完成后连续获取失败 3 次,则会强制断开连接。
''' </summary>
Private RefreshPeerLoader As New LoaderTask(Of Integer, List(Of Peer))("EasyTier CLI", AddressOf RefreshPeer)
Private Sub RefreshPeer()
'| ipv4 | hostname | cost | lat(ms) | loss | rx | tx | tunnel | NAT | version |
'|-------------------|-----------------------|----------|---------|------|---------|---------|--------|----------------|----------------|
'| 10.114.114.1/24 | Client-RJ458A | Local | - | - | - | - | - | Unknown | 2.4.5-4c4d172e |
'| | PublicServer_公用服务器  | p2p | 48.40 | 0.0% | 875 B | 1.26 kB | tcp | NoPat | 2.4.5-4c4d172e |
'| 10.114.114.114/24 | Server-J6P6IW | p2p | 5.63 | 0.0% | 1.65 kB | 1.64 kB | udp | PortRestricted | 2.4.5-4c4d172e |
'| 10.114.114.114/24 | Server-J6PHIW (连接中) | relay(2) | 1000.00 | 0.0% | 0 B | 0 B | | PortRestricted | 2.4.5-4c4d172e |
Try
Dim CliResult = StartProcessAndGetOutput(PathEasyTier & "联机模块 CLI.exe", $"-o json -p 127.0.0.1:{RPCPort} peer", 2000, Encoding:=Encoding.UTF8, PrintLog:=False)
'解析
If Not CliResult.Contains("lat_ms") Then Throw New Exception("CLI 调用失败:" & vbCrLf & CliResult)
If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Log("[EasyTier] CLI 输出抽样:" & vbCrLf & CliResult)
Dim NewPeers As New List(Of Peer)
For Each Line As JObject In CType(GetJson(CliResult), JArray).Skip(1)
Try
Dim Peer = New Peer(Line)
If Peer.Type = Peer.Types.Self Then Continue For '自己
NewPeers.Add(Peer)
Catch exx As Exception
Log(exx, $"错误的信息行({Line})")
End Try
Next
'完成
Peers = NewPeers
FailCount = 0
Catch ex As Exception
Log(ex, "获取节点信息失败")
If LinkState = LinkStates.Finished Then
FailCount += 1
If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message)
End If
End Try
End Sub
''' <summary>
''' CLI 调用连续失败的次数。
''' </summary>
Private FailCount As Integer = 0
''' <summary>
''' 根据当前的节点列表获取 Ping 值。
''' 服务端会返回所有节点中最低的 Ping,客户端会返回服务端的 Ping。
''' 0 代表尚不可用。
''' </summary>
Private Function GetPeerPing() As Double
Dim Peer = GetTargetPeer()
If Peer Is Nothing Then Return 0
Return Peer.Ping
End Function
''' <summary>
''' 服务端会返回所有节点中 Ping 的那一个,客户端会返回服务端。
''' 若没有则为 Nothing。
''' </summary>
Private Function GetTargetPeer() As Peer
If Peers Is Nothing Then Return Nothing
Dim Targets As IEnumerable(Of Peer)
If IsServerSide Then
Targets = Peers.Where(Function(p) p.Ping > 0)
Else
Targets = Peers.Where(Function(p) p.Type = Peer.Types.Server AndAlso p.Ping > 0)
End If
If Not Targets.Any Then Return Nothing
'返回 Ping 大于 0 且最低的那个
Dim MinPing = Targets.Min(Function(p) p.Ping)
Return Targets.First(Function(p) p.Ping = MinPing)
End Function
''' <summary>
''' 获取当前房间中的人数,包括自己。
''' 0 代表不可用。
''' </summary>
Private ReadOnly Property PeopleCount As Integer
Get
If Peers Is Nothing Then Return 0
Return Peers.Where(Function(p) p.Type <> Peer.Types.Misc).Count() + 1 '加上自己
End Get
End Property
#End Region
#Region "定时任务"
'启动
Private IsTimerStarted As Boolean = False
Private Sub StartTimerThread() Handles Me.Loaded
If IsTimerStarted Then Return
RunInNewThread(
Sub()
Dim Counter As Integer = 0
Do While True
Try
Thread.Sleep(200)
Counter += 200
'每秒执行一次
If Counter >= 1000 Then
Counter = 0
Update()
End If
'每 200ms 更新进度条
If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
Catch ex As Exception
Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
Thread.Sleep(10000)
End Try
Loop
End Sub, "Link Timer")
End Sub
'每秒或进入页面时触发
Private BroadcastSocket As New Socket(SocketType.Dgram, ProtocolType.Udp)
Private Sub Update() Handles Me.Loaded
If LinkState <> LinkStates.Finished Then Return
'重新获取信息
SyncLock RefreshPeerLoader.LockState
If RefreshPeerLoader.State <> LoadState.Loading Then RefreshPeerLoader.Start(IsForceRestart:=True)
End SyncLock
'更新 Ping 与人数显示
If FrmMain.PageCurrent = FormMain.PageType.Link Then
RunInUi(
Sub()
Dim Ping As Double = GetPeerPing()
Dim RelayLayer As Integer = If(GetTargetPeer().Cost.RegexSeek("(?<=relay\()\d+") Is Nothing,
0, Val(GetTargetPeer().Cost.RegexSeek("(?<=relay\()\d+")) - 1)
'更新 Ping 显示
If Ping Mod 500 = 0 OrElse $"{Ping:0.0}" = "1.0" OrElse FailCount > 0 Then
LabFinishPing.Text = "连接中"
AniStop("Link Logo Rotation")
Else
LabFinishPing.Text =
If(RelayLayer > 0, If(RelayLayer > 1, $"中继 {RelayLayer} · ", "中继 · "), "") & '使用中继连接时显示 “中继” 前缀
If(Ping >= 10, $"{Ping:0} ms", $"{Ping:0.0} ms")
AniStart(AaRotateTransform(ImgFinishLogo, 500, 5000), "Link Logo Rotation") 'Logo 旋转动画
End If
'更新 Ping 的 Tooltip 显示
Dim Tooltip As String = If(IsServerSide, "网络延迟", "与房主的延迟")
If RelayLayer Then Tooltip &= If(IsServerSide,
$"(你的网络环境较差,正经过 {RelayLayer} 层中继,可能会有点卡)",
$"(你或者房主的网络环境较差,正经过 {RelayLayer} 层中继,可能会有点卡)")
BtnFinishPing.ToolTip = Tooltip
'更新人数显示
LabFinishPlayer.Text = PeopleCount & "  人"
End Sub)
End If
'检查核心状态
CheckCrash()
'检查节点状态
If Not Peers.Any Then
Panic("网络连接已断开", "请检查你的网络环境是否正常。")
Return
End If
If Not IsServerSide AndAlso Not Peers.Any(Function(p) p.Type = Peer.Types.Server) Then
MyMsgBox("房主已离开房间!", "联机结束")
ChangeState(LinkStates.Waiting)
Return
End If
'广播联机房间端口
If Not IsServerSide Then
Try
BroadcastSocket.SendTo(
Encoding.UTF8.GetBytes($"[MOTD]PCL 联机房间[/MOTD][AD]{ClientPort}[/AD]"),
SocketFlags.None,
New IPEndPoint(IPAddress.Loopback, 4445))
Catch ex As Exception
Log(ex, "广播联机房间端口失败")
End Try
End If
End Sub
''' <summary>
''' 检查联机模块是否崩溃。
''' </summary>
Private Sub CheckCrash()
If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then Return
Panic("联机模块已崩溃", "近期日志:" & vbCrLf & LogHistory.Join(vbCrLf))
End Sub
#End Region
End Class
File diff suppressed because it is too large. Load diff
@@ -18,8 +18,8 @@
End Sub
Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click
ClipboardSet(UniqueAddress)
Public Shared Sub CopyIdentify() Handles BtnDonateCopy.Click
ClipboardSet(Identify)
End Sub
Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput()
@@ -71,7 +71,7 @@
Public Shared Sub OnItemClick(Entry As HelpEntry)
Try
If Entry.IsEvent Then
ModEvent.TryStartEvent(Entry.EventType, Entry.EventData)
CustomEvent.Raise(Entry.EventType, Entry.EventData)
Else
EnterHelpPage(Entry)
End If
@@ -18,8 +18,10 @@
If Content = "" Then Throw New Exception("帮助 xaml 文件为空")
Try
'修改时应同时修改 PageLaunchRight.LoadContent
Content = HelpArgumentReplace(Content)
If Content.Contains("xmlns") Then Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Content = ArgumentReplace(Content, AddressOf EscapeXML)
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Me.Entry = Entry
PanCustom.Children.Clear()
@@ -150,14 +150,14 @@
Dim NewFolder As String = ""
'检查是否有下载任务
If HasDownloadingTask() Then
Hint("在下载任务进行时,无法添加游戏文件夹!", HintType.Critical)
Hint("在下载任务进行时,无法添加游戏文件夹!", HintType.Red)
Return
End If
Try
'获取输入
NewFolder = SelectFolder()
If NewFolder = "" Then Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Return
'要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
Dim DefaultName As String = If(SplitedNames.Last = ".minecraft", If(SplitedNames.Count >= 3, SplitedNames(SplitedNames.Count - 2), ""), SplitedNames.Last)
@@ -182,7 +182,7 @@
'检查文件夹权限
If Not CheckPermission(FolderPath) Then
If ShowHint Then
Hint("添加文件夹失败:PCL 没有访问该文件夹的权限!", HintType.Critical)
Hint("添加文件夹失败:PCL 没有访问该文件夹的权限!", HintType.Red)
Return
Else
Throw New Exception("PCL 没有访问文件夹的权限:" & FolderPath)
@@ -207,12 +207,12 @@
If Folder.Split(">")(1) = FolderPath Then
IsAdded = True
If Folder.Split(">")(0) = DisplayName Then
If ShowHint Then Hint("此文件夹已在列表中!", HintType.Info)
If ShowHint Then Hint("此文件夹已在列表中!", HintType.Blue)
Return
Else
Folders(i) = DisplayName & ">" & FolderPath
IsReplace = True
If ShowHint Then Hint("文件夹名称已更新为 " & DisplayName & " !", HintType.Finish)
If ShowHint Then Hint("文件夹名称已更新为 " & DisplayName & " !", HintType.Green)
End If
Exit For
End If
@@ -226,7 +226,7 @@
McFolderListLoader.Start(IsForceRestart:=True)
'提示
If IsReplace Then Return
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加!", HintType.Finish)
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加!", HintType.Green)
'检查是否为根目录整合包,自动关闭版本隔离
'1. 根目录中存在数个 Mod
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\")
@@ -257,7 +257,7 @@
Public Sub Create_Click()
'检查是否有下载任务
If HasDownloadingTask() Then
Hint("在下载任务进行时,无法创建游戏文件夹!", HintType.Critical)
Hint("在下载任务进行时,无法创建游戏文件夹!", HintType.Red)
Return
End If
If Not Directory.Exists(Path & ".minecraft\") Then
@@ -265,7 +265,7 @@
Directory.CreateDirectory(Path & ".minecraft\versions\")
Setup.Set("LaunchFolderSelect", "$.minecraft\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
Hint("新建 .minecraft 文件夹成功!", HintType.Finish)
Hint("新建 .minecraft 文件夹成功!", HintType.Green)
End If
McFolderListLoader.Start(IsForceRestart:=True)
End Sub
@@ -307,7 +307,7 @@
Next
'保存
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Finish)
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
@@ -336,10 +336,10 @@
Sub()
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Info)
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Blue)
DeleteDirectory(Folder.Path)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Finish)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Green)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint)
Finally
@@ -389,7 +389,7 @@
Next
'如果没有添加过,则添加进去(因为修改了默认项的名称)
If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Path)
Hint("文件夹名称已更新为 " & NewName & " !", HintType.Finish)
Hint("文件夹名称已更新为 " & NewName & " !", HintType.Green)
'保存
Setup.Set("LaunchFolders", Join(Folders.ToArray, "|"))
McFolderListLoader.Start(IsForceRestart:=True)
@@ -403,7 +403,7 @@
If Not e.RaiseByMouse OrElse Not sender.Checked Then Return
'检查是否有下载任务
If HasDownloadingTask(True) Then
Hint("在下载任务进行时,无法切换游戏文件夹!", HintType.Critical)
Hint("在下载任务进行时,无法切换游戏文件夹!", HintType.Red)
e.Handled = True
Return
End If
@@ -114,22 +114,7 @@
Log(ex, "将版本列表转换显示时失败", LogLevel.Feedback)
End Try
End Sub
Public Shared Function McVersionListItem(Version As McVersion) As MyListItem
Dim NewItem As New MyListItem With {.Title = Version.Name, .Info = Version.Info, .Height = 42, .Tag = Version, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
Try
If Version.Logo.EndsWith("PCL\Logo.png") Then
NewItem.Logo = Version.Path & "PCL\Logo.png" '修复老版本中,存储的自定义 Logo 使用完整路径,导致移动后无法加载的 Bug
Else
NewItem.Logo = Version.Logo
End If
Catch ex As Exception
Log(ex, "加载版本图标失败", LogLevel.Hint)
NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
End Try
NewItem.ContentHandler = AddressOf McVersionListContent
Return NewItem
End Function
Private Shared Sub McVersionListContent(sender As MyListItem, e As EventArgs)
Public Shared Sub McVersionListContent(sender As MyListItem, e As EventArgs)
Dim Version As McVersion = sender.Tag
'注册点击事件
AddHandler sender.Click, AddressOf Item_Click
@@ -225,10 +210,10 @@
IniClearCache(Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Version.Path)
Hint("版本 " & Version.Name & " 已永久删除!", HintType.Finish)
Hint("版本 " & Version.Name & " 已永久删除!", HintType.Green)
Else
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除到回收站!", HintType.Finish)
Hint("版本 " & Version.Name & " 已删除!", HintType.Green)
End If
Case 2
Return
@@ -24,7 +24,8 @@
{"HintMoreAdvancedSetup", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintIndieSetup", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintExportConfig", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemEula", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemEula", New SetupEntry(False, Source:=SetupSource.Registry)}, '仅老版本兼容,现已换用 SystemEulaVersion
{"SystemEulaVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"SystemCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLaunchCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLastVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
@@ -42,6 +43,7 @@
{"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)},
{"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)},
{"CacheConfig", New SetupEntry(0, Source:=SetupSource.Registry)},
{"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageVersion", New SetupEntry("", Source:=SetupSource.Registry)},
@@ -109,12 +111,10 @@
{"LaunchAdvanceGraphicCard", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LaunchRamType", New SetupEntry(0)},
{"LaunchRamCustom", New SetupEntry(15)},
{"LinkEula", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LinkName", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertTime", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertWarn", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkIoiVersion", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkShareMode", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkCustomPeer", New SetupEntry("")},
{"LinkEasyTierVersion", New SetupEntry(-1, Source:=SetupSource.Registry)},
{"ToolHelpChinese", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadThread", New SetupEntry(63, Source:=SetupSource.Registry)},
{"ToolDownloadSpeed", New SetupEntry(42, Source:=SetupSource.Registry)},
@@ -227,7 +227,7 @@
Me.Value = Value
Me.Source = Source
Me.Type = If(Value, New Object).GetType
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value)
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & Identify), Value)
Catch ex As Exception
Log(ex, "初始化 SetupEntry 失败", LogLevel.Feedback) '#5095 的 fallback
End Try
@@ -241,6 +241,14 @@
Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
[Set](Key, Value, SetupDict(Key), ForceReload, Version)
End Sub
''' <summary>
''' 写入某个未经加密的设置项。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Sub SetSafe(Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止写入加密设置项:" & Key)
[Set](Key, Version, ForceReload, Version)
End Sub
Private Sub [Set](Key As String, Value As Object, E As SetupEntry, ForceReload As Boolean, Version As McVersion)
Try
@@ -258,7 +266,7 @@
If E.Encoded Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & UniqueAddress)
Value = SecretEncrypt(Value, "PCL" & Identify)
Catch ex As Exception
Log(ex, "加密设置失败:" & Key, LogLevel.Developer)
End Try
@@ -303,9 +311,17 @@
''' 获取某个设置项的值。
''' </summary>
Public Function [Get](Key As String, Optional Version As McVersion = Nothing)
If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key) With {.Source = Key}
If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
Return [Get](Key, SetupDict(Key), Version)
End Function
''' <summary>
''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Function GetSafe(Key As String, Optional Version As McVersion = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止读取加密设置项:" & Key)
Return [Get](Key, Version)
End Function
Private Function [Get](Key As String, E As SetupEntry, Version As McVersion)
'获取强制值
Dim Force As String = ForceValue(Key)
@@ -383,7 +399,7 @@
SourceValue = E.DefaultValue
Else
Try
SourceValue = SecretDecrypt(SourceValue, "PCL" & UniqueAddress)
SourceValue = SecretDecrypt(SourceValue, "PCL" & Identify)
Catch ex As Exception
Log(ex, "解密设置失败:" & Key, LogLevel.Developer)
SourceValue = E.DefaultValue
@@ -403,8 +419,6 @@
#If BETA Then
If Key = "UiLauncherTheme" Then Return "0"
#End If
If Key = "UiHiddenPageLink" Then Return True
If Key = "UiHiddenSetupLink" Then Return True
Return Nothing
End Function
@@ -601,8 +615,7 @@
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
FrmSetupUI.HintCustom.EventType = ""
FrmSetupUI.HintCustom.EventData = ""
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.None)
Case 2 '联网
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
@@ -610,8 +623,8 @@
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
FrmSetupUI.HintCustom.EventType = "打开网页"
FrmSetupUI.HintCustom.EventData = "https://github.com/Meloong-Git/PCL/discussions/2528"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.打开网页)
CustomEventService.SetEventData(FrmSetupUI.HintCustom, "https://github.com/Meloong-Git/PCL/discussions/2528")
Case 3 '预设
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Visible
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
@@ -41,9 +41,9 @@
<local:MyComboBoxItem Content="隔离所有版本" ToolTip="不同版本之间的存档、Mod、资源包等均不互通。&#xa;这会导致不同原版版本间的存档不能共用,所以一般不推荐。" />
</local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角">
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -86,14 +86,14 @@
</local:MyComboBox>
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="1" Margin="50,0,0,0" x:Name="TextArgumentWindowWidth" Tag="LaunchArgumentWindowWidth" Width="60" HorizontalContentAlignment="Center" Text="854">
<local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="9999" />
<local:ValidateInteger Min="1" Max="99999" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<TextBlock x:Name="LabArgumentWindowMiddle" Visibility="Collapsed" Grid.Column="2" Text=" × " VerticalAlignment="Center" FontSize="18" />
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="3" Width="60" HorizontalContentAlignment="Center" x:Name="TextArgumentWindowHeight" Tag="LaunchArgumentWindowHeight" Text="480"
ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
<local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="9999" />
<local:ValidateInteger Min="1" Max="99999" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
@@ -240,13 +240,13 @@
ToolTip="还原" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1"
Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</StackPanel>
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,除非有确定把握,否则请不要修改。&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。" MaxLength="4000"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,除非有确定把握,否则请不要修改。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" MaxLength="4000"
Height="100" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" VerticalScrollBarVisibility="Auto" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;你可以用替换标记来动态改变其内容或实现相对路径,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left">
@@ -93,7 +93,7 @@
JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化启动设置")
Hint("已初始化启动设置!", HintType.Finish, False)
Hint("已初始化启动设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化启动设置失败", LogLevel.Msgbox)
End Try
@@ -170,7 +170,7 @@
Try
File.Delete(PathAppdata & "CustomSkin.png")
RadioSkinType0.SetChecked(True, True)
Hint("离线皮肤已清空!", HintType.Finish)
Hint("离线皮肤已清空!", HintType.Green)
Catch ex As Exception
Log(ex, "清空离线皮肤失败", LogLevel.Msgbox)
End Try
@@ -468,7 +468,7 @@ PreFin:
'手动选择
Private Sub BtnArgumentJavaSelect_Click(sender As Object, e As EventArgs) Handles BtnArgumentJavaSelect.Click
If JavaSearchLoader.State = LoadState.Loading Then
Hint("正在搜索 Java,请稍候!", HintType.Critical)
Hint("正在搜索 Java,请稍候!", HintType.Red)
Return
End If
'选择 Java
@@ -489,7 +489,7 @@ PreFin:
Setup.Set("LaunchArgumentJavaAll", JavaNewList.ToString(Newtonsoft.Json.Formatting.None))
'重新加载列表
JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已将该 Java 加入 Java 列表!", HintType.Finish)
Hint("已将该 Java 加入 Java 列表!", HintType.Green)
Catch ex As Exception
Log(ex, "该 Java 存在异常,无法使用", LogLevel.Msgbox, "异常的 Java")
Return
@@ -498,7 +498,7 @@ PreFin:
'自动查找
Private Sub BtnArgumentJavaSearch_Click(sender As Object, e As EventArgs) Handles BtnArgumentJavaSearch.Click
If JavaSearchLoader.State = LoadState.Loading Then
Hint("正在搜索 Java,请稍候!", HintType.Critical)
Hint("正在搜索 Java,请稍候!", HintType.Red)
Return
End If
RunInThread(
@@ -506,9 +506,9 @@ PreFin:
Hint("正在搜索 Java!")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If Not JavaList.Any() Then
Hint("未找到可用的 Java!", HintType.Critical)
Hint("未找到可用的 Java!", HintType.Red)
Else
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Green)
End If
End Sub)
End Sub
@@ -5,31 +5,31 @@
d:DesignWidth="152" AnimatedControl="PanItem">
<StackPanel Margin="0,12,0,0" x:Name="PanItem">
<local:MyListItem x:Name="ItemLaunch" IsScaleAnimationEnabled="False" Checked="True" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="启动" Type="RadioBox"
LogoScale="1" Logo="M924.009688 527.92367C875.975633 601.905321 808.729835 663.317138 733.564477 712.920073 726.302532 832.878385 665.670459 944.569541 567.084624 1015.075229 558.826862 1020.965578 549.065982 1024 539.239339 1024 533.048367 1024 526.829211 1022.806899 520.929468 1020.373725 505.663413 1014.023046 494.709431 1000.278899 491.966239 983.941872 484.67611 940.755376 465.361028 892.899817 436.876917 844.546349 404.954422 853.283229 373.980771 860.385468 344.970569 865.420917 342.227376 865.92822 339.484183 866.144294 336.75978 866.144294 324.142972 866.144294 311.920734 861.174606 302.855046 852.061945L172.807046 721.685138C161.768514 710.637211 156.789431 694.863853 159.466862 679.466275 164.502312 650.390312 171.576367 619.341505 180.27567 587.362642 132.100697 558.822165 84.376661 539.450716 41.302899 532.151193 25.00345 529.370422 11.287486 518.41644 4.98378 503.103413-1.319927 487.809174 0.662312 470.316624 10.254092 456.826128 80.581284 357.958459 191.971817 297.185468 311.591927 289.857761 361.053945 214.495119 422.31545 147.061431 496.081028 98.895853 636.030826 7.54378 802.350972 0 974.730569 0 1001.223046 0 1022.680073 21.494606 1022.680073 48.034055 1022.680073 213.997211 1015.061138 387.72022 924.009688 527.92367ZM558.122275 918.528C601.506055 876.187009 631.784514 822.328367 645.81989 763.744294 602.680367 785.86833 558.563817 804.553982 515.067303 819.989138 533.358385 853.161101 548.023193 886.267303 558.122275 918.528ZM106.566459 465.807266C138.705028 475.915743 171.717284 490.627523 204.804697 508.937394 220.192881 465.337541 238.803376 421.117651 260.871046 377.865394 202.493651 391.947743 148.822899 422.282569 106.566459 465.807266ZM548.398972 179.444257C395.794789 279.09167 294.681835 493.94378 258.522422 671.678239L352.749211 766.121101C530.00455 729.877138 744.283596 628.510532 843.667963 475.474202 912.557798 369.39156 924.742459 236.562789 926.527413 96.387523 786.699743 98.172477 654.227963 110.385321 548.398972 179.444257ZM687.071119 416.617688C642.93578 416.617688 607.161541 380.74011 607.161541 336.492037 607.161541 292.234569 642.93578 256.37578 687.071119 256.37578 731.206459 256.37578 766.971303 292.234569 766.971303 336.492037 766.971303 380.74011 731.206459 416.617688 687.071119 416.617688ZM67.222312 858.008661C77.171083 825.118532 107.646826 801.171963 143.702899 801.171963 187.838239 801.171963 223.603083 837.040147 223.603083 881.297615 223.603083 917.438239 199.722275 948.017321 166.926092 957.975486L52.46356 992.763303C50.998018 993.204844 49.438532 993.458495 47.813284 993.458495 38.973064 993.458495 31.823853 986.290495 31.823853 977.431486 31.823853 975.806239 32.058716 974.237358 32.519046 972.771817L67.222312 858.008661Z">
LogoScale="0.8" Logo="M52.1,164.5c-1.4,0-3.1-0.5-4.2-1.3c-2.6-1.7-4-4.2-4-7V43.8c0-2.9,1.6-5.8,4.1-7c1.2-0.8,2.7-1.2,4.1-1.2c1.5,0,2.9,0.4,4.2,1.2L153.1,93c0,0,0.1,0,0.1,0.1c2.6,1.7,4,4.2,4,7c0,3-1.7,5.8-4.2,7.1l-96.8,56.2C55.1,164,53.5,164.5,52.1,164.5z M60.4,142.1l72.1-42.1L60.4,58.2V142.1z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="0" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemUI" IsScaleAnimationEnabled="False" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="个性化"
Logo="M106 755a59 59 0 0 1-12 9c-12 7-25 8-38 5-1-0-2-0-2-0-27-10-56 11-53 40 24 224 378 233 468 10a39 39 0 0 0-8-42l-178-176a39 39 0 0 0-27-11c-89 0-121 39-134 119l-0 3c-4 26-7 35-12 41zM393 814c-66 112-240 117-295 33a130 130 0 0 0 41-16 140 140 0 0 0 28-23c20-21 26-40 33-83l0-3c6-39 11-50 42-52L393 814z m66-91a84 84 0 0 0 120 0l4-4 13-13c14-14 31-31 49-50 50-52 101-107 149-162a2797 2797 0 0 0 68-81C1008 233 1066 118 990 59c-67-52-177 2-336 130a2562 2562 0 0 0-88 74 3940 3940 0 0 0-159 148 4043 4043 0 0 0-62 62l-4 5c-32 33-32 87 0 120l120 121z m56-55l-120-121a7 7 0 0 1-0-10l4-4a3967 3967 0 0 1 61-61 3865 3865 0 0 1 156-145 2486 2486 0 0 1 86-72c63-50 118-88 163-110 42-21 68-24 76-18 4 3 2 25-18 66-22 46-63 105-118 173-20 25-42 52-66 79a4180 4180 0 0 1-146 159 4313 4313 0 0 1-66 67c-2 2-7 2-9 0z" Type="RadioBox">
<local:MyListItem x:Name="ItemLink" IsScaleAnimationEnabled="False" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="联机" Type="RadioBox"
LogoScale="0.77" Logo="M512 817c-48.601 0-88-39.399-88-88s39.399-88 88-88 88 39.399 88 88-39.399 88-88 88zM237.671 565.74C308.335 474.58 397.369 429 504.774 429c118.433 0 214.225 55.421 287.377 166.264l-53.407 30.369c-13.84 7.87-31.362 4.367-41.114-8.219-50.291-64.911-114.577-97.367-192.856-97.367-86.851 0-156.835 40.318-209.95 120.953l-47.995-28.02c-15.263-8.91-20.412-28.507-11.502-43.77a32 32 0 0 1 2.344-3.47zM107.691 419.47C205.24 278.491 337.805 208 505.379 208c178.77 0 317.694 80.224 416.772 240.672l-56.54 31.73c-13.686 7.68-30.922 4.303-40.697-7.975C735.581 360.213 629.07 303.009 505.38 300.815 373.997 298.485 261.637 362.88 168.3 494l-50.116-28.505c-15.362-8.738-20.732-28.275-11.994-43.637a32 32 0 0 1 1.5-2.387z" >
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="1" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemSystem" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="其他" Type="RadioBox"
Logo="M511 995a128 128 0 0 1-57-13L70 791a126 126 0 0 1-70-113V311a126 126 0 0 1 15-60V248c1-2 3-5 5-8a127 127 0 0 1 49-42L454 13a128 128 0 0 1 112 0l383 190a126 126 0 0 1 72 113v360a126 126 0 0 1-70 115L568 984c-17 7-37 11-57 11z m42-470v370l360-178c14-7 23-21 23-38v-335L554 524zM85 330v347a42 42 0 0 0 23 38l360 178V523L85 330zM135 260l375 189 137-65L286 188 135 260z m245-118l363 197 150-71-365-180a42 42 0 0 0-37 0l-111 53z">
<local:MyListItem x:Name="ItemUI" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="个性化" Type="RadioBox"
LogoScale="0.9" Logo="M764.0 0.0a215.4 215.4 0 0 0-76.2 13.9l-9.0 3.6c-49.1 20.7-88.5 30.5-115.4 30.5-27.0 0-66.4-9.8-116.6-31.0a217.5 217.5 0 0 0-72.1-16.7l-9.1-0.3-3.8-0.0-8.6 0.3-4.2 0.2A160.7 160.7 0 0 0 250.4 45.3l-219.3 212.4a102.3 102.3 0 0 0-11.2 134.2l106.3 144.5 3.3 4.3a102.4 102.4 0 0 0 112.8 31.6l5.6-2.1V883.2a140.7 140.7 0 0 0 140.7 140.7h372.1l5.6-0.1a140.7 140.7 0 0 0 135.1-140.6l-0.0-318.6 1.1 0.7a102.3 102.3 0 0 0 141.9-44.2l70.9-144.3a102.3 102.3 0 0 0-20.6-118.6L875.8 45.3A160.7 160.7 0 0 0 764.0 0.0z m-357.3 111.4C468.4 137.6 520.5 150.6 563.1 150.6c42.4 0 94.5-12.9 156.1-38.9A112.5 112.5 0 0 1 764.0 102.4c15.1 0 29.6 5.8 40.5 16.4L1023.9 331.4l-70.9 144.3-93.0-65.6a38.3 38.3 0 0 0-60.5 31.3V883.2a38.3 38.3 0 0 1-38.3 38.3H388.8a38.3 38.3 0 0 1-38.3-38.3V445.1a38.3 38.3 0 0 0-61.6-30.4l-80.0 61.2L102.3 331.3l219.3-212.4a58.3 58.3 0 0 1 35.5-16.2L362.1 102.4l6.3 0.1a115.1 115.1 0 0 1 38.2 8.8z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="2" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLink" IsScaleAnimationEnabled="False" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="联机" Type="RadioBox"
LogoScale="0.75" Logo="M512 817c-48.601 0-88-39.399-88-88s39.399-88 88-88 88 39.399 88 88-39.399 88-88 88zM237.671 565.74C308.335 474.58 397.369 429 504.774 429c118.433 0 214.225 55.421 287.377 166.264l-53.407 30.369c-13.84 7.87-31.362 4.367-41.114-8.219-50.291-64.911-114.577-97.367-192.856-97.367-86.851 0-156.835 40.318-209.95 120.953l-47.995-28.02c-15.263-8.91-20.412-28.507-11.502-43.77a32 32 0 0 1 2.344-3.47zM107.691 419.47C205.24 278.491 337.805 208 505.379 208c178.77 0 317.694 80.224 416.772 240.672l-56.54 31.73c-13.686 7.68-30.922 4.303-40.697-7.975C735.581 360.213 629.07 303.009 505.38 300.815 373.997 298.485 261.637 362.88 168.3 494l-50.116-28.505c-15.362-8.738-20.732-28.275-11.994-43.637a32 32 0 0 1 1.5-2.387z" >
<local:MyListItem x:Name="ItemSystem" IsScaleAnimationEnabled="False" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="其他" Type="RadioBox"
LogoScale="0.8" Logo="M364 0h-273C40 0 0 40 0 91v273C0 414 40 455 91 455h273C414 455 455 414 455 364V91C455 40 414 0 364 0zM341 341H113V113h227v227zM933 0h-273C609 0 568 40 568 91v273c0 50 40 91 91 91h273C983 455 1024 414 1024 364V91c0-50-40-91-90-91zM910 341h-227V113h227v227zM364 568h-273C40 568 0 609 0 659v273c0 50 40 91 91 91h273C414 1024 455 983 455 932v-273C455 609 414 568 364 568zM341 910H113v-227h227v227zM933 568h-273c-50 0-91 40-91 91v273c0 50 40 91 91 91h273c50 0 90-40 90-91v-273c0-50-40-90-90-90zM910 910h-227v-227h227v227z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="3" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
@@ -126,17 +126,19 @@
FrmMain.PageRight = Target
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit()
AniStart({
AaCode(Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
AaCode(
Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
End Sub
#End Region
@@ -6,32 +6,32 @@
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard Margin="0,15" Title="HiPer">
<StackPanel Margin="25,40,25,20" Orientation="Vertical">
<local:MyCheckBox Text="在索引码还有 5 分钟到期时提醒我" x:Name="CheckHiperCertWarn" Tag="LinkHiperCertWarn" Height="22" />
<local:MyButton x:Name="BtnHiperLog" Height="35" MinWidth="140" Text="查看日志" Padding="13,0" Margin="0,10,20,0" HorizontalAlignment="Left" />
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="IOI">
<StackPanel Margin="25,40,25,20">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="玩家名" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextLinkName" Grid.Row="0" Grid.ColumnSpan="2" Tag="LinkName" Grid.Column="1">
<local:MyTextBox.ValidateRules>
<local:ValidateNullable />
<local:ValidateNullOrWhiteSpace />
<local:ValidateLength Max="20" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
</StackPanel>
<local:MyCard Margin="0,15" Title="高级设置" IsSwapped="True" CanSwap="True">
<Grid Margin="25,40,25,22">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="15" />
<RowDefinition Height="35" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义节点" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextCustomPeer" Tag="LinkCustomPeer" Grid.Column="1" MaxHeight="28"
ToolTip="覆盖 PCL 所选择的节点,仅连接此处填写的节点。&#xa;如果你自己搭建了 EasyTier 节点,你可以用这个设置让 PCL 连接它。&#xa;&#xa;使用逗号分隔多个节点,例如:&#xa;tcp://public.easytier.cn:11010,tcp://public2.easytier.cn:54321&#xa;&#xa;房主和加入者必须连接到至少一个相同节点,才能互相连上。" />
<local:MyCheckBox Text="老好人模式" x:Name="CheckShareMode" Grid.Row="1" Tag="LinkShareMode" Height="22" Visibility="Collapsed"
ToolTip="启动联机后,用你的网络帮助其他玩家建立连接、降低延迟!&#xa;即使你不开启,开启了这个选项的其他玩家也会帮助你,不过,人人为我,我为人人嘛……" />
<StackPanel Orientation="Horizontal" Grid.Row="2" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text=" 光荣地贡献节点!" ColorType="Highlight"
ToolTip="联机功能全靠社区的各位无私贡献的节点才能存在!&#xa;如果你有空闲的服务器,欢迎搭建一个共享节点,人人为我,我为人人嘛……&#xa;&#xa;你可以在 EasyTier 的【搭建共享节点】文档中查看搭建方式,搭建好后点击这里提交。&#xa;PCL 会自动选取节点进行连接。"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://uptime.easytier.cn/submit" />
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text="节点状态"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://uptime.easytier.cn/" />
</StackPanel>
</Grid>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
@@ -1,4 +1,4 @@
Class PageSetupLink
Public Class PageSetupLink
Private Shadows IsLoaded As Boolean = False
@@ -17,18 +17,18 @@
End Sub
Public Sub Reload()
TextLinkName.Text = Setup.Get("LinkName")
CheckHiperCertWarn.Checked = Setup.Get("LinkHiperCertWarn")
CheckShareMode.Checked = Setup.Get("LinkShareMode")
TextCustomPeer.Text = Setup.Get("LinkCustomPeer")
End Sub
'初始化
Public Sub Reset()
Try
Setup.Reset("LinkName")
Setup.Reset("LinkHiperCertWarn")
Setup.Reset("LinkShareMode")
Setup.Reset("LinkCustomPeer")
Log("[Setup] 已初始化联机页设置")
Hint("已初始化联机页设置!", HintType.Finish, False)
Hint("已初始化联机页设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化联机页设置失败", LogLevel.Msgbox)
End Try
@@ -37,14 +37,11 @@
End Sub
'将控件改变路由到设置改变
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLinkName.ValidatedTextChanged
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckHiperCertWarn.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckShareMode.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Sub BtnHiperLog_Click(sender As Object, e As EventArgs) Handles BtnHiperLog.Click
End Sub
End Class
@@ -85,7 +85,7 @@
Setup.Reset("SystemSystemTelemetry")
Log("[Setup] 已初始化启动器页设置")
Hint("已初始化启动器页设置!", HintType.Finish, False)
Hint("已初始化启动器页设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化启动器页设置失败", LogLevel.Msgbox)
End Try
@@ -136,7 +136,7 @@
'识别码/解锁码替代入口
Private Sub BtnSystemIdentify_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemIdentify.Click
PageOtherAbout.CopyUniqueAddress()
PageOtherAbout.CopyIdentify()
End Sub
Private Sub BtnSystemUnlock_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemUnlock.Click
DonateCodeInput()
@@ -225,7 +225,8 @@
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载地址" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextCustomNet" Tag="UiCustomNet" Grid.Column="1" MaxHeight="28">
<local:MyTextBox x:Name="TextCustomNet" Tag="UiCustomNet" Grid.Column="1" MaxHeight="28"
ToolTip="你可以用替换标记动态改变网址,以传入参数或变量。&#xa;在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateNullable />
<local:ValidateHttp />
@@ -252,6 +253,7 @@
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" Visibility="Collapsed" />
<local:MyComboBoxItem Content="杂志主页(作者:CreeperIsASpy)" />
<local:MyComboBoxItem Content="PCL GitHub 仪表盘(作者:Deep-Dark-Forest)" />
<local:MyComboBoxItem Content="Minecraft 更新摘要(作者:pynickle,部分由 AI 生成)" />
</local:MyComboBox>
</Grid>
</StackPanel>
@@ -279,14 +281,14 @@
</Grid.RowDefinitions>
<TextBlock Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="2" Text="下载" x:Name="CheckHiddenPageDownload" Tag="UiHiddenPageDownload" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Visibility="Collapsed" Text="联机" x:Name="CheckHiddenPageLink" Tag="UiHiddenPageLink" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Text="设置" x:Name="CheckHiddenPageSetup" Tag="UiHiddenPageSetup" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="4" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Text="联机" x:Name="CheckHiddenPageLink" Tag="UiHiddenPageLink" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="4" Text="设置" x:Name="CheckHiddenPageSetup" Tag="UiHiddenPageSetup" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="5" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="设置 子页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="2" Text="启动" x:Name="CheckHiddenSetupLaunch" Tag="UiHiddenSetupLaunch" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" Text="个性化" x:Name="CheckHiddenSetupUI" Tag="UiHiddenSetupUi" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="4" Text="其他" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="5" Text="联机" x:Name="CheckHiddenSetupLink" Tag="UiHiddenSetupLink" Visibility="Collapsed" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" Text="联机" x:Name="CheckHiddenSetupLink" Tag="UiHiddenSetupLink" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="4" Text="个性化" x:Name="CheckHiddenSetupUI" Tag="UiHiddenSetupUi" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="5" Text="其他" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" />
<TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="更多 子页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="2" Text="帮助" x:Name="CheckHiddenOtherHelp" Tag="UiHiddenOtherHelp" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="3" Text="关于与鸣谢" x:Name="CheckHiddenOtherAbout" Tag="UiHiddenOtherAbout" />
@@ -162,7 +162,7 @@
Setup.Reset("UiHiddenOtherTest")
Log("[Setup] 已初始化个性化设置!")
Hint("已初始化个性化设置", HintType.Finish, False)
Hint("已初始化个性化设置", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化个性化设置失败", LogLevel.Msgbox)
End Try
@@ -215,7 +215,7 @@
If MyMsgBox("即将删除背景图片文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
DeleteDirectory(Path & "PCL\Pictures")
BackgroundRefresh(False, True)
Hint("背景图片已清空!", HintType.Finish)
Hint("背景图片已清空!", HintType.Green)
End If
End Sub
''' <summary>
@@ -238,10 +238,10 @@
If Not Pic.Any() Then
If Refresh Then
If FrmMain.ImgBack.Visibility = Visibility.Collapsed Then
If IsHint Then Hint("未检测到可用背景图片!", HintType.Critical)
If IsHint Then Hint("未检测到可用背景图片!", HintType.Red)
Else
FrmMain.ImgBack.Visibility = Visibility.Collapsed
If IsHint Then Hint("背景图片已清除!", HintType.Finish)
If IsHint Then Hint("背景图片已清除!", HintType.Green)
End If
End If
If Not IsNothing(FrmSetupUI) Then FrmSetupUI.BackgroundRefreshUI(False, 0)
@@ -253,7 +253,7 @@
FrmMain.ImgBack.Background = New MyBitmap(Address)
Setup.Load("UiBackgroundSuit", True)
FrmMain.ImgBack.Visibility = Visibility.Visible
If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("刷新背景图片失败,该图片文件可能并非标准格式。" & vbCrLf &
@@ -338,7 +338,7 @@ Refresh:
Try
File.Delete(Path & "PCL\Logo.png")
RadioLogoType1.SetChecked(True, True)
Hint("标题栏图片已清空!", HintType.Finish)
Hint("标题栏图片已清空!", HintType.Green)
Catch ex As Exception
Log(ex, "清空标题栏图片失败", LogLevel.Msgbox)
End Try
@@ -381,7 +381,7 @@ Refresh:
'删除文件
Try
DeleteDirectory(Path & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Finish)
Hint("背景音乐已删除!", HintType.Green)
Catch ex As Exception
Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
End Try
@@ -410,7 +410,7 @@ Refresh:
If MyMsgBox("当前已存在布局文件,继续生成教学文件将会覆盖现有布局文件!", "覆盖确认", "继续", "取消", IsWarn:=True) = 2 Then Return
End If
WriteFile(Path & "PCL\Custom.xaml", GetResources("Custom"))
Hint("教学文件已生成!", HintType.Finish)
Hint("教学文件已生成!", HintType.Green)
OpenExplorer(Path & "PCL\Custom.xaml")
Catch ex As Exception
Log(ex, "生成教学文件失败", LogLevel.Feedback)
@@ -418,7 +418,7 @@ Refresh:
End Sub
Private Sub BtnCustomRefresh_Click() Handles BtnCustomRefresh.Click
FrmLaunchRight.ForceRefresh()
Hint("已刷新主页!", HintType.Finish)
Hint("已刷新主页!", HintType.Green)
End Sub
Private Sub BtnCustomTutorial_Click(sender As Object, e As EventArgs) Handles BtnCustomTutorial.Click
MyMsgBox("1. 点击 生成教学文件 按钮,这会在 PCL 文件夹下生成 Custom.xaml 布局文件。" & vbCrLf &
@@ -523,7 +523,7 @@ Refresh:
'顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If
@@ -536,7 +536,7 @@ Refresh:
If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
Dim AvaliableCount As Integer = 0
@@ -1,6 +1,4 @@
Imports System.Threading.Tasks
Public Class PageSpeedLeft
Public Class PageSpeedLeft
Private Const WatcherInterval As Integer = 300
'初始化
@@ -96,7 +94,7 @@ Public Class PageSpeedLeft
AddHandler Tb.MouseLeftButtonDown,
Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
Hint("已复制错误详情!", HintType.Finish)
Hint("已复制错误详情!", HintType.Green)
End Sub
Card.Children.Add(Tb)
#End Region
@@ -262,7 +262,7 @@
<local:MyButton Grid.Column="0" x:Name="BtnAdvancedImport" MinWidth="140" Text="读取配置" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton Grid.Column="1" x:Name="BtnAdvancedExport" MinWidth="140" Text="保存配置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" MinWidth="140" Text="整合包制作指南" Padding="13,0" Margin="0,0,20,0" x:Name="BtnAdvancedHelp"
EventType="打开帮助" />
local:CustomEventService.EventType="打开帮助" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -22,7 +22,8 @@ Public Class PageVersionExport
Private Sub PageVersionExport_Loaded() Handles Me.Loaded
AniControlEnabled += 1
If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面
BtnAdvancedHelp.EventData = If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json")
CustomEventService.SetEventData(BtnAdvancedHelp,
If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
@@ -35,7 +36,7 @@ Public Class PageVersionExport
TextExportVersion.HintText = "1.0.0"
CheckAdvancedInclude.Checked = False
CheckAdvancedModrinth.Checked = False
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetDefaultDescription()
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetVersionDescription()
ResetConfigOverrides()
ReloadAllSubOptions()
RefreshAllOptionsUI()
@@ -341,7 +342,7 @@ Public Class PageVersionExport
ConfigLines.AddRange(GetExtraFileLines())
'结束
WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
Hint("已保存配置文件:" & ConfigPath, HintType.Finish)
Hint("已保存配置文件:" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath)
Catch ex As Exception
Log(ex, "保存配置失败", LogLevel.Msgbox)
@@ -378,7 +379,7 @@ Public Class PageVersionExport
ExtraFiles = Nothing
End If
'结束
Hint("已读取配置文件:" & ConfigPath, HintType.Finish)
Hint("已读取配置文件:" & ConfigPath, HintType.Green)
Catch ex As Exception
Log(ex, "读取配置失败", LogLevel.Msgbox)
End Try
@@ -517,13 +518,13 @@ Public Class PageVersionExport
If Directory.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
Else
Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Critical)
Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Red)
End If
Else
If File.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
Else
Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Critical)
Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Red)
End If
End If
Next
@@ -306,7 +306,7 @@
If Result.Any Then
MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果")
Else
Hint("Mod 检查完成,未发现任何问题!", HintType.Finish)
Hint("Mod 检查完成,未发现任何问题!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "进行 Mod 检查时出错", LogLevel.Feedback)
@@ -340,7 +340,7 @@
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'检查回收站:回收站中的文件有错误的文件名
If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
Hint("请先将文件从回收站还原,再尝试安装!", HintType.Critical)
Hint("请先将文件从回收站还原,再尝试安装!", HintType.Red)
Return True
End If
'获取并检查目标版本
@@ -362,9 +362,9 @@ Install:
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Finish)
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green)
End If
'刷新列表
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod Then
@@ -570,7 +570,7 @@ Install:
If IsSuccessful Then
RefreshBars()
Else
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Red)
ReloadModList(True)
End If
LoaderRun(LoaderFolderRunType.UpdateOnly)
@@ -643,14 +643,14 @@ Install:
Try
For Each Entry As McMod In ModList
If File.Exists(Entry.Path) Then
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Else
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.Path}", LogLevel.Debug)
End If
Next
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", LogLevel.Debug)
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
@@ -676,14 +676,14 @@ Install:
Case 0 '一般是由于 Mod 文件被占用,然后玩家主动取消
Log($"[Mod] 没有 Mod 被成功更新")
Case 1
Hint($"已成功更新 {FinishedFileNames.Single}!", HintType.Finish)
Hint($"已成功更新 {FinishedFileNames.Single}!", HintType.Green)
Case Else
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod!", HintType.Finish)
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod!", HintType.Green)
End Select
Case LoadState.Failed
Hint("Mod 更新失败:" & Loader.Error.GetBrief(), HintType.Critical)
Hint("Mod 更新失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted
Hint("Mod 更新已中止!", HintType.Info)
Hint("Mod 更新已中止!", HintType.Blue)
Case Else
Return
End Select
@@ -739,7 +739,7 @@ Install:
If IsShiftPressed Then
File.Delete(ModEntity.Path)
Else
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
@@ -760,7 +760,7 @@ Install:
Next
RefreshBars()
If Not IsSuccessful Then
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Red)
ReloadModList(True)
ElseIf PanList.Children.Count = 0 Then
ReloadModList(True) '删除了全部文件
@@ -771,15 +771,15 @@ Install:
If Not IsSuccessful Then Return
If IsShiftPressed Then
If ModList.Count = 1 Then
Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Finish)
Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Green)
Else
Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Finish)
Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Green)
End If
Else
If ModList.Count = 1 Then
Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Finish)
Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Green)
Else
Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Finish)
Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Green)
End If
End If
Catch ex As OperationCanceledException
@@ -30,7 +30,7 @@
BtnFolderMods.Visibility = If(PageVersionLeft.Version.Modable, Visibility.Visible, Visibility.Collapsed)
'刷新版本显示
PanDisplayItem.Children.Clear()
ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version)
ItemVersion = PageVersionLeft.Version.ToListItem
ItemVersion.IsHitTestVisible = False
PanDisplayItem.Children.Add(ItemVersion)
FrmMain.PageNameRefresh()
@@ -169,7 +169,7 @@
Log(ex, "重命名版本 json 失败")
End Try
'刷新与提示
Hint("重命名成功!", HintType.Finish)
Hint("重命名成功!", HintType.Green)
PageVersionLeft.Version = New McVersion(NewName).Load()
If Not IsNothing(McVersionCurrent) AndAlso McVersionCurrent.Equals(PageVersionLeft.Version) Then WriteIni(PathMcFolder & "PCL.ini", "Version", NewName)
Reload()
@@ -263,7 +263,7 @@
If SavePath = "" Then Return
'检查中断(等玩家选完弹窗指不定任务就结束了呢……)
If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试!", HintType.Critical)
Hint("请在当前启动任务结束后再试!", HintType.Red)
Return
End If
'生成脚本
@@ -284,13 +284,13 @@
Try
'忽略文件检查提示
If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Info)
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Blue)
Return
End If
'重复任务检查
For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
Hint("正在处理中,请稍候!", HintType.Critical)
Hint("正在处理中,请稍候!", HintType.Red)
Return
Next
'启动
@@ -299,11 +299,11 @@
Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Critical)
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Hint(Loader.Name & "已取消!", HintType.Blue)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
@@ -329,10 +329,10 @@
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Green)
Else
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Finish)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Green)
End If
Case 2
Return
@@ -34,9 +34,9 @@
ToolTip="与其余关闭隔离的版本共享存档、Mod 等文件。&#xa;若存在多个安装了 Mod 的版本,可能会由于 Mod 冲突而导致崩溃。" ToolTipService.HorizontalOffset="100"/>
</local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则跟随全局设置的值。&#xa;支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号" HintText="跟随全局设置" MaxLength="100" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;若留空,则跟随全局设置的值。">
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;若留空,则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -209,13 +209,13 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Java 虚拟机参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置"
Height="100" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" VerticalScrollBarVisibility="Auto" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;你可以用替换标记来动态改变其内容或实现相对路径,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="VersionAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,5,0,0" />
<StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left">
@@ -98,7 +98,7 @@
JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置")
Hint("已初始化版本独立设置!", HintType.Finish, False)
Hint("已初始化版本独立设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化版本独立设置失败", LogLevel.Msgbox)
End Try
@@ -206,8 +206,7 @@
<SubType>Designer</SubType>
</ApplicationDefinition>
<Compile Include="Controls\Behaviors\ClipboardInterceptor.vb" />
<Compile Include="Controls\IMyRadio.vb" />
<Compile Include="Controls\Interfaces.vb" />
<Compile Include="Controls\Behaviors\Interfaces.vb" />
<Compile Include="Controls\MyComboBox.vb" />
<Compile Include="Controls\MyComboBoxItem.vb" />
<Compile Include="Controls\MyCard.vb" />
@@ -307,21 +306,12 @@
<Compile Include="Pages\PageLaunch\PageLoginNideSkin.xaml.vb">
<DependentUpon>PageLoginNideSkin.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLink\PageLinkFeedback.xaml.vb">
<DependentUpon>PageLinkFeedback.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLink\PageLinkHiper.xaml.vb">
<DependentUpon>PageLinkHiper.xaml</DependentUpon>
<Compile Include="Pages\PageLink\PageLinkMain.xaml.vb">
<DependentUpon>PageLinkMain.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageOther\PageOtherHelpDetail.xaml.vb">
<DependentUpon>PageOtherHelpDetail.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLink\PageLinkIoi.xaml.vb">
<DependentUpon>PageLinkIoi.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLink\PageLinkLeft.xaml.vb">
<DependentUpon>PageLinkLeft.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionExport.xaml.vb">
<DependentUpon>PageVersionExport.xaml</DependentUpon>
</Compile>
@@ -576,11 +566,7 @@
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</None>
<Page Include="Pages\PageLink\PageLinkFeedback.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageLink\PageLinkHiper.xaml">
<Page Include="Pages\PageLink\PageLinkMain.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
@@ -588,14 +574,6 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageLink\PageLinkIoi.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageLink\PageLinkLeft.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageVersion\PageVersionExport.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
@@ -955,6 +933,8 @@
<ItemGroup>
<None Include="Resources\System.Net.Http.Formatting.dll" />
</ItemGroup>
<ItemGroup />
<ItemGroup>
<Resource Include="Images\Heads\EasyTier.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
+50 -94
View File
@@ -53,99 +53,66 @@
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 1:打开网页、弹出窗口" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
<local:MyCard Title="自定义事件" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="将按钮的 EventType 属性设为 打开网页,然后在 EventData 属性中写入网址,即可通过点击按钮打开网页。" />
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Height="35" HorizontalAlignment="Left" Padding="20,0,20,0"
Text="打开 Minecraft Wiki" EventType="打开网页" EventData="https://zh.minecraft.wiki/" />
<TextBlock TextWrapping="Wrap" Margin="0,10,0,10"
<TextBlock TextWrapping="Wrap" Margin="0,10,0,10"
Text="或者将 EventType 属性改为 弹出窗口,然后在 EventData 属性中写入弹窗的标题与内容……" />
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="显示一个弹窗" EventType="弹出窗口" EventData="这是标题|标题与内容以竖线间隔。\n你也可以直接在其中换行。" />
<TextBlock TextWrapping="Wrap" Margin="0,10,0,0"
<TextBlock TextWrapping="Wrap" Margin="0,10,0,0"
Text="local:MyTextButton 同样可以设置 EventType 与 EventData 让它具有特定功能。" />
<local:MyTextButton Margin="0,8,0,0" HorizontalAlignment="Center"
Text="点击打开知乎" EventType="打开网页" EventData="https://www.zhihu.com/" />
</StackPanel>
<local:MyTextButton Margin="0,8,0,0" HorizontalAlignment="Center"
Text="点击打开哔哩哔哩" EventType="打开网页" EventData="https://www.bilibili.com/" />
<TextBlock TextWrapping="Wrap" Margin="0,30,0,0"
Text="自定义事件的详细用法请参考下方的页面。" />
<local:MyListItem Margin="-5,4,-5,5"
EventType="打开帮助" EventData="个性化/自定义事件.json" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 2:启动游戏" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="将 EventType 设置为 启动游戏,EventData 设置为具体的游戏版本,即可通过点击按钮启动游戏。如果当前游戏文件夹没有该版本,则无法启动。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动 Minecraft 1.12.2" EventType="启动游戏" EventData="1.12.2" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" />
<local:MyButton Margin="0,4,0,0" Width="250" Height="35"
Text="启动 1.20.1 并进入 Hypixel" EventType="启动游戏" EventData="1.20.1|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 中填写 \current,表示启动当前被选中的游戏版本,同样可以在后面填写服务器 IP。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动当前选中版本并进入 Hypixel" EventType="启动游戏" EventData="\current|mc.hypixel.net" ToolTip="启动当前版本" />
</StackPanel>
<local:MyCard Title="替换标记" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,10">
<local:MyListItem Margin="-5,0,-5,8"
EventType="打开帮助" EventData="个性化/替换标记.json" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 3:执行命令" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="将 EventType 设置为 执行命令(或 打开文件),EventData 设置为文件路径,即可点击打开特定文件或启动程序。" />
<local:MyButton Margin="0,4,0,8" Width="200" Height="35"
Text="打开记事本" EventType="执行命令" EventData="notepad.exe" />
<TextBlock TextWrapping="Wrap" Margin="0,4,0,0"
Text="如果能在 PCL 文件夹中找到该文件,则会优先打开 PCL 文件夹中的文件。当然,你可以使用例如 C:\ 开头的绝对路径。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="此外,PCL 会将文件中的 “花括号 path” 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" />
<local:MyButton Margin="0,4,0,10" Width="200" Height="35"
Text="打开 PCL 日志" EventType="执行命令" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="就像为游戏指定服务器 IP 一样,你也可以在 EventData 的竖线后为程序添加启动参数。" />
<local:MyButton Margin="0,4,0,0" Width="200" Height="35"
Text="定位游戏启动脚本" EventType="执行命令" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xA;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
</StackPanel>
<local:MyCard Title="进阶:高级自定义事件" Margin="0,0,0,15" CanSwap="True" IsSwapped="{variable:TutorialCardSwap:True}">
<StackPanel Margin="25,40,23,10">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="你可以让一个控件触发多个事件。下方的例子展示了连续触发多个事件搭配 {variable} 替换标记的效果。" />
<local:MyButton Height="35" HorizontalAlignment="Left" Padding="20,0,20,0" Margin="0,0,0,10"
Text="隐藏下方的百度 Logo" Visibility="{variable:TutorialVisibility1:Visible}">
<local:CustomEventService.Events>
<local:CustomEventCollection>
<local:CustomEvent Type="修改变量" Data="TutorialVisibility1|Collapsed|-" />
<local:CustomEvent Type="修改变量" Data="TutorialVisibility2|Visible|-" />
<local:CustomEvent Type="修改变量" Data="TutorialCardSwap|False|-" />
<local:CustomEvent Type="刷新页面" Data="-" />
</local:CustomEventCollection>
</local:CustomEventService.Events>
</local:MyButton>
<local:MyButton Height="35" HorizontalAlignment="Left" Padding="20,0,20,0" Margin="0,0,0,10"
Text="再次显示 Logo 并折叠卡片" Visibility="{variable:TutorialVisibility2:Collapsed}">
<local:CustomEventService.Events>
<local:CustomEventCollection>
<local:CustomEvent Type="修改变量" Data="TutorialVisibility1|Visible|-" />
<local:CustomEvent Type="修改变量" Data="TutorialVisibility2|Collapsed|-" />
<local:CustomEvent Type="修改变量" Data="TutorialCardSwap|True|-" />
<local:CustomEvent Type="刷新页面" Data="-" />
</local:CustomEventCollection>
</local:CustomEventService.Events>
</local:MyButton>
<local:MyImage Height="50" HorizontalAlignment="Left" Margin="0,0,0,10" Visibility="{variable:TutorialVisibility1:Visible}"
Source="https://www.baidu.com/img/flexible/logo/pc/result.png" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 4:其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock Margin="0,4,0,6" FontWeight="Bold"
Text="EventType 共有以下种类:" />
<TextBlock Margin="0,0,0,4"
Text="· 打开网页、启动游戏、打开文件:已在上方的卡片中介绍" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="查看 PCL 源代码" EventType="打开网页" EventData="https://github.com/Meloong-Git/PCL/blob/main/Plain%20Craft%20Launcher%202/FormMain.xaml.vb"/>
<TextBlock Margin="0,0,0,4"
Text="· 今日人品、清理垃圾、内存优化、安装整合包:触发对应功能" />
<TextBlock Margin="0,0,0,4"
Text="· 复制文本:将 EventData 中的内容复制到剪贴板" />
<TextBlock Margin="0,0,0,4"
Text="· 刷新主页:点击重新加载主页。如果主页文件为联网更新,这会重新下载主页内容" />
<TextBlock Margin="0,0,0,4"
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件&#xa;      EventData 中也能可选地指定文件名或目标文件夹,格式为:链接|文件名|文件夹" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
<TextBlock Margin="0,4,0,4"
Text="· 打开帮助:跳转到 EventData 对应的帮助文件(输入相对 Help 文件夹的路径)"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/>
<TextBlock Margin="0,4,0,4"
Text="· 切换页面:强制切换到 PCL 的某一页面(尝试切换到不太对头的页面会出现不可预知的 Bug)&#xa;      EventData 为 页面种类|次要页面种类(PageType|PageSubType,例如 1|1)&#xa;      点击上方的 查看 PCL 源代码 按钮,在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到下载页面" EventType="切换页面" EventData="1|1"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到启动器设置" EventType="切换页面" EventData="3|2"/>
<TextBlock Margin="0,4,0,4"
Text="· 下载版本:切换到 EventData 对应的 Minecraft 下载页面"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="下载 Minecraft 1.12.2" EventType="下载版本" EventData="1.12.2"/>
<TextBlock Margin="0,4,0,4"
Text="· 修改设置:将 PCL 的特定设置修改为特定值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="将窗口改为半透明" EventType="修改设置" EventData="UiLauncherTransparent|400"/>
</StackPanel>
</local:MyCard>
<local:MyCard Title="StackPanel 横向布局" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<local:MyCard Title="横向布局" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="你需要使用 StackPanel 在一行里塞下多个按钮。你可以仅在这个教学卡片的基础上稍作调整,来实现自己的按钮布局。" />
@@ -183,7 +150,7 @@
Logo="pack://application:,,,/images/Blocks/Grass.png"
EventType="打开帮助" EventData="帮助/自定义帮助.json" Type="Clickable" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="EventType、EventData 与按钮几乎一致,唯一不同的是,列表项不支持联网加载帮助文件。" />
Text="EventType、EventData 与按钮几乎一致。唯一不同的是,列表项不支持联网加载帮助文件。" />
</StackPanel>
</local:MyCard>
@@ -246,17 +213,6 @@
</StackPanel>
</local:MyCard>
<local:MyCard Title="替换标记" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在花括号 {} 中写入特定内容,PCL 会在加载时对其进行替换。&#xa;例如,path 会被替换为 PCL 可执行文件所在文件夹({path}),用于在 EventData 中指定特定文件,或是加载图片。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="你也可以使用替换标记来获取随机内容:cave 会被替换为一条随机的回声洞内容,hint 则是 “你知道吗” 的内容。" />
<TextBlock TextWrapping="Wrap" Margin="10,6,0,5" Foreground="{DynamicResource ColorBrush3}"
Text="你知道吗:{hint}" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="进阶:Grid 布局" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Binary file not shown.
Binary file not shown.