This commit is contained in:
龙腾猫跃
2026-03-24 22:53:27 +08:00
parent 43963f8f7c
commit 6a140ce5b9
72 changed files with 28308 additions and 27967 deletions
+1 -1
View File
@@ -365,7 +365,7 @@
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" /> <Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" /> <Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="160" /> <Setter Property="MaxDropDownHeight" Value="320" />
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="ComboBox"> <ControlTemplate TargetType="ComboBox">
+12 -18
View File
@@ -73,7 +73,7 @@ Public Class Application
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用") MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Else Else
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用") MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "") Settings.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\" PathTemp = IO.Path.GetTempPath() & "PCL\"
End If End If
End Try End Try
@@ -114,7 +114,7 @@ WaitRetry:
ServicePointManager.EnableDnsRoundRobin = True ServicePointManager.EnableDnsRoundRobin = True
ServicePointManager.ReusePort = True ServicePointManager.ReusePort = True
'设置初始窗口 '设置初始窗口
If Setup.Get("UiLauncherLogo") Then If Settings.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If End If
@@ -138,12 +138,6 @@ WaitRetry:
If Is32BitSystem Then If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
End If End If
'设置初始化
Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert")
Setup.Load("ToolDownloadSpeed")
'计时 '计时
Log("[Start] 第一阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms") Log("[Start] 第一阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeMs() ApplicationStartTick = GetTimeMs()
@@ -228,36 +222,36 @@ WaitRetry:
'控件模板事件 '控件模板事件
Private Sub MyIconButton_Click(sender As Object, e As EventArgs) Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
Select Case Setup.Get("LoginType") Select Case Settings.Get("LoginType")
Case McLoginType.Ms Case McLoginType.Ms
'微软 '微软
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
MsJson.Remove(sender.Tag) MsJson.Remove(sender.Tag)
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0 If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent) FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
Case McLoginType.Legacy Case McLoginType.Legacy
'离线 '离线
Dim Names As New List(Of String) Dim Names As New List(Of String)
Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨")) Names.AddRange(Settings.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(sender.Tag) Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨")) Settings.Set("LoginLegacyName", Names.Join("¨"c))
FrmLoginLegacy.ComboName.ItemsSource = Names FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "") FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else Case Else
'第三方 '第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType")) Dim Token As String = GetStringFromEnum(Settings.Get("LoginType"))
Dim Dict As New Dictionary(Of String, String) Dim Dict As New Dictionary(Of String, String)
Dim Names As New List(Of String) Dim Names As New List(Of String)
Dim Passs As New List(Of String) Dim Passs As New List(Of String)
If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨")) If Not Settings.Get("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get("Login" & Token & "Email").ToString.Split("¨"))
If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨")) If Not Settings.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get("Login" & Token & "Pass").ToString.Split("¨"))
For i = 0 To Names.Count - 1 For i = 0 To Names.Count - 1
Dict.Add(Names(i), Passs(i)) Dict.Add(Names(i), Passs(i))
Next Next
Dict.Remove(sender.Tag) Dict.Remove(sender.Tag)
Setup.Set("Login" & Token & "Email", Join(Dict.Keys, "¨")) Settings.Set("Login" & Token & "Email", Dict.Keys.Join("¨"c))
Setup.Set("Login" & Token & "Pass", Join(Dict.Values, "¨")) Settings.Set("Login" & Token & "Pass", Dict.Values.Join("¨"c))
Select Case Token Select Case Token
Case "Nide" Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys FrmLoginNide.ComboName.ItemsSource = Dict.Keys
@@ -1,18 +1,17 @@
Public Module LazyLoadBehavior Public Class LazyLoadBehavior
''' <summary> ''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。 ''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
''' </summary> ''' </summary>
<Runtime.CompilerServices.Extension()> Public Shared Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
Public Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
obj.SetValue(IsInViewportProperty, value) obj.SetValue(IsInViewportProperty, value)
End Sub End Sub
Private ReadOnly IsInViewportProperty As DependencyProperty = Private Shared ReadOnly IsInViewportProperty As DependencyProperty =
DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior), DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged)) New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
Private Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs) Private Shared Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
Dim Element = TryCast(d, FrameworkElement) Dim Element = TryCast(d, FrameworkElement)
If Element Is Nothing OrElse e.NewValue Is Nothing Then Return If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
@@ -36,7 +35,7 @@
AddHandler Element.LayoutUpdated, Handler AddHandler Element.LayoutUpdated, Handler
End Sub End Sub
Private Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer Private Shared Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
While d IsNot Nothing While d IsNot Nothing
If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer) If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
d = VisualTreeHelper.GetParent(d) d = VisualTreeHelper.GetParent(d)
@@ -44,4 +43,4 @@
Return Nothing Return Nothing
End Function End Function
End Module End Class
@@ -2,6 +2,7 @@
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyCheckBox Public Class MyCheckBox
Implements ISettingControl
'基础 '基础
@@ -72,7 +73,7 @@ Public Class MyCheckBox
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid) }, "MyCheckBox Scale " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck) AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray5"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -85,7 +86,7 @@ Public Class MyCheckBox
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid) }, "MyCheckBox Scale " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck) AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -99,11 +100,11 @@ Public Class MyCheckBox
If Checked Then If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
Else Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End If End If
End Sub End Sub
@@ -178,18 +179,18 @@ Public Class MyCheckBox
Else Else
'不可用 '不可用
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut) AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray5 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut) AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid) }, "MyCheckBox TextColor " & Uuid)
End If End If
Else Else
'无动画 '无动画
AniStop("MyCheckBox TextColor " & Uuid) AniStop("MyCheckBox TextColor " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid) AniStop("MyCheckBox BorderColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
End If End If
End Sub End Sub
Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -203,11 +204,27 @@ Public Class MyCheckBox
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误 If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
AniStart({ AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut) AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid) }, "MyCheckBox TextColor " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut) AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Checked = Boolean.Parse(NewValue)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Checked.ToString
End Function
Private Sub SaveSetting() Handles Me.Change
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -1,5 +1,6 @@
Public Class MyComboBox Public Class MyComboBox
Inherits ComboBox Inherits ComboBox
Implements ISettingControl
Public Event TextChanged(sender As Object, e As TextChangedEventArgs) Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
'基础 '基础
@@ -137,4 +138,44 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent() If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent()
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Dim TargetItem = Items.OfType(Of DependencyObject)().FirstOrDefault(Function(i) Val(If(SettingService.GetValue(i), -1)) = NewValue)
If TargetItem IsNot Nothing Then
SelectedItem = TargetItem
ElseIf Items.Count > NewValue Then
SelectedIndex = NewValue
Else
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项", LogLevel.Debug)
SelectedIndex = -1
SelectedItem = Nothing
'Dim Key As String = SettingService.GetKey(Me)
'Dim DefaultValue = Settings.GetDefault(Key)
'If DefaultValue = NewValue Then
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,这可能是因为程序版本太老了", LogLevel.Hint)
'Else
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,已重置该设置", LogLevel.Debug)
' Settings.Reset(Key)
' RefreshSetting(DefaultValue)
'End If
End If
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
If SelectedItem Is Nothing Then Return Nothing
If TypeOf SelectedItem Is DependencyObject Then
Return Val(If(SettingService.GetValue(SelectedItem), SelectedIndex))
Else
Return SelectedIndex
End If
End Function
Private Sub SaveSetting() Handles Me.SelectionChanged
If SelectedItem Is Nothing Then Return
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -99,10 +99,10 @@ Public Class MyHint
End Property End Property
Public Property RelativeSetup As String = "" Public Property RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed If CanClose AndAlso Settings.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.SetSafe(RelativeSetup, True) Settings.SetSafe(RelativeSetup, True)
AniDispose(Me, False) AniDispose(Me, False)
End Sub End Sub
@@ -7,7 +7,7 @@
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon) If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If End If
'对父级设置透明度 '对父级设置透明度
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4 CType(Parent, ContextMenu).Opacity = Settings.Get("UiLauncherTransparent") / 1000 + 0.4
End Sub End Sub
'基础 '基础
@@ -129,7 +129,7 @@
RaiseEvent PageEnter() RaiseEvent PageEnter()
Select Case PageState Select Case PageState
Case PageStates.Empty Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
'如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting '如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child)) TriggerEnterAnimation(PanAlways, If(PanContent, Child))
@@ -142,7 +142,7 @@
End If End If
Case PageStates.ContentExit Case PageStates.ContentExit
'和上面的一样,但是不管 PanAlways '和上面的一样,但是不管 PanAlways
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(If(PanContent, Child)) TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
@@ -318,9 +318,9 @@
Case PageStates.LoaderExit Case PageStates.LoaderExit
PageState = PageStates.ContentExit PageState = PageStates.ContentExit
End Select End Select
Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)") If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Interrupt)")
'运行结束 '运行结束
'需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit '需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
Select Case PageState Select Case PageState
@@ -2,7 +2,7 @@
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyRadioBox Public Class MyRadioBox
Implements IMyRadio Implements IMyRadio, ISettingControl
'基础 '基础
@@ -116,7 +116,7 @@ Public Class MyRadioBox
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6) AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid) }, "MyRadioBox Dot " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck) AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray5")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid) }, "MyRadioBox BorderColor " & Uuid)
Else Else
'由有变无 '由有变无
@@ -128,7 +128,7 @@ Public Class MyRadioBox
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2) AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid) }, "MyRadioBox Dot " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck) AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray5")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid) }, "MyRadioBox BorderColor " & Uuid)
End If End If
Else Else
@@ -141,13 +141,13 @@ Public Class MyRadioBox
ShapeDot.Height = 9 ShapeDot.Height = 9
ShapeDot.Opacity = 1 ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0) ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
Else Else
ShapeDot.Width = 0 ShapeDot.Width = 0
ShapeDot.Height = 0 ShapeDot.Height = 0
ShapeDot.Opacity = 0 ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0) ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End If End If
End Sub End Sub
@@ -209,15 +209,15 @@ Public Class MyRadioBox
Radiobox_MouseLeaveAnimation() Radiobox_MouseLeaveAnimation()
Else Else
'不可用 '不可用
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray4 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray5 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid) AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
End If End If
Else Else
'无动画 '无动画
AniStop("MyRadioBox BorderColor " & Uuid) AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid) AniStop("MyRadioBox TextColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
End If End If
End Sub End Sub
Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -227,14 +227,30 @@ Public Class MyRadioBox
Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误 If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If IsLoaded AndAlso AniControlEnabled = 0 Then If IsLoaded AndAlso AniControlEnabled = 0 Then
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid) AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
Else Else
AniStop("MyRadioBox BorderColor " & Uuid) AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid) AniStop("MyRadioBox TextColor " & Uuid)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Checked = NewValue = SettingService.GetValue(Me)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return If(Checked, SettingService.GetValue(Me), Nothing)
End Function
Private Sub SaveSetting() Handles Me.Check
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -1,4 +1,5 @@
Public Class MySlider Public Class MySlider
Implements ISettingControl
'基础 '基础
@@ -188,4 +189,20 @@
End If End If
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Value = Val(NewValue)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Value
End Function
Private Sub SaveSetting() Handles Me.Change
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
+25 -1
View File
@@ -1,5 +1,6 @@
Public Class MyTextBox Public Class MyTextBox
Inherits TextBox Inherits TextBox
Implements ISettingControl
'自定义属性 '自定义属性
@@ -44,7 +45,13 @@
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public Shared Event ValidateChanged(sender As Object, e As EventArgs) Public Shared Event ValidateChanged(sender As Object, e As EventArgs)
Public ChangedEventList As New List(Of RoutedEventHandler) Private _ChangedEventList As List(Of RoutedEventHandler)
Public ReadOnly Property ChangedEventList As List(Of RoutedEventHandler)
Get
If _ChangedEventList Is Nothing Then _ChangedEventList = New List(Of RoutedEventHandler)
Return _ChangedEventList
End Get
End Property
Public Custom Event ValidatedTextChanged As RoutedEventHandler Public Custom Event ValidatedTextChanged As RoutedEventHandler
AddHandler(value As RoutedEventHandler) AddHandler(value As RoutedEventHandler)
ChangedEventList.Add(value) ChangedEventList.Add(value)
@@ -295,4 +302,21 @@
Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
If e.Key = Key.Enter Then RaiseCustomEvent() If e.Key = Key.Enter Then RaiseCustomEvent()
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Text = NewValue
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Text
End Function
Private Sub SaveSetting() Handles Me.ValidatedTextChanged
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -4,7 +4,7 @@
Private Initializer As Func(Of T) Private Initializer As Func(Of T)
Public Sub New(Initializer As Func(Of T)) Public Sub New(Initializer As Func(Of T))
Me.Initializer = Initializer Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init) LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
End Sub End Sub
''' <summary> ''' <summary>
@@ -34,7 +34,7 @@ Public Class MyVirtualizingElement
Private Initializer As Func(Of FrameworkElement) Private Initializer As Func(Of FrameworkElement)
Public Sub New(Initializer As Func(Of FrameworkElement)) Public Sub New(Initializer As Func(Of FrameworkElement))
Me.Initializer = Initializer Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init) LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
End Sub End Sub
''' <summary> ''' <summary>
+211 -75
View File
@@ -11,8 +11,15 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 383 Then 'Release 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
FeatureCount += 15
BugCount += 16
End If
If LastVersion < 381 Then 'Release 2.12.2 If LastVersion < 381 Then 'Release 2.12.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法搜索 CurseForge 上的社区资源"))
FeatureCount += 3 FeatureCount += 3
BugCount += 13 BugCount += 13
End If End If
@@ -133,8 +140,16 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 382 Then 'Snapshot 2.12.3 If LastVersion < 384 Then 'Snapshot 2.12.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:降低游戏的内存占用"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
FeatureCount += 21
BugCount += 14
End If
If LastVersion < 382 Then 'Snapshot 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
@@ -337,12 +352,12 @@ Public Class FormMain
If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") & If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
",详见完整更新日志") ",详见完整更新日志")
End If End If
Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ") Dim Content As String = "· " & ContentList.Join(vbCrLf & "· ")
'输出更新日志 '输出更新日志
RunInNewThread( RunInNewThread(
Sub() Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.com/a/LTCat?tab=feed") OpenWebsite("https://meloong.com/afd/a/LTCat?tab=feed")
End If End If
End Sub, "UpdateLog Output") End Sub, "UpdateLog Output")
End Sub End Sub
@@ -356,7 +371,7 @@ Public Class FormMain
FrmLaunchLeft = New PageLaunchLeft FrmLaunchLeft = New PageLaunchLeft
FrmLaunchRight = New PageLaunchRight FrmLaunchRight = New PageLaunchRight
'版本号改变 '版本号改变
Dim LastVersion As Integer = Setup.Get("SystemLastVersionReg") Dim LastVersion As Integer = Settings.Get("SystemLastVersionReg")
If LastVersion < VersionCode Then If LastVersion < VersionCode Then
'触发升级 '触发升级
UpgradeSub(LastVersion) UpgradeSub(LastVersion)
@@ -365,21 +380,21 @@ Public Class FormMain
DowngradeSub(LastVersion) DowngradeSub(LastVersion)
End If End If
'版本隔离设置迁移 '版本隔离设置迁移
If Setup.IsUnset("LaunchArgumentIndieV2") Then If Not Settings.HasSaved("LaunchArgumentIndieV2") Then
If Not Setup.IsUnset("LaunchArgumentIndie") Then If Settings.HasSaved("LaunchArgumentIndie") Then
Log("[Start] 从老 PCL 迁移版本隔离") Log("[Start] 从老 PCL 迁移版本隔离")
Setup.Set("LaunchArgumentIndieV2", Setup.Get("LaunchArgumentIndie")) Settings.Set("LaunchArgumentIndieV2", Settings.Get("LaunchArgumentIndie"))
ElseIf Not Setup.IsUnset("LaunchVersionSelect") Then ElseIf HasIniKey("Setup", "LaunchVersionSelect") Then
Log("[Start] 从老 PCL 升级,但此前未调整版本隔离,使用老的版本隔离默认值") Log("[Start] 从老 PCL 升级,但此前未调整版本隔离,使用老的版本隔离默认值")
Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndie")) Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndie"))
Else Else
Log("[Start] 全新的 PCL,使用新的版本隔离默认值") Log("[Start] 全新的 PCL,使用新的版本隔离默认值")
Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndieV2")) Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2"))
End If End If
End If End If
'刷新主题 '刷新主题
ThemeCheckAll(False) ThemeCheckAll(False)
Setup.Load("UiLauncherTheme") ThemeRefresh(Settings.Get("UiLauncherTheme"))
'注册拖拽事件(不能直接加 Handles,否则没用;#6340) '注册拖拽事件(不能直接加 Handles,否则没用;#6340)
[AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True) [AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
[AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True) [AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
@@ -418,12 +433,10 @@ Public Class FormMain
End Sub End Sub
Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
ApplicationStartTick = GetTimeMs() ApplicationStartTick = GetTimeMs()
Handle = New Interop.WindowInteropHelper(Me).Handle Handle = New WindowInteropHelper(Me).Handle
'读取设置 '读取设置
Setup.Load("UiBackgroundOpacity") UpdateBackgroundAndTitleBar()
Setup.Load("UiBackgroundBlur") PageSetupUI.HiddenRefresh()
Setup.Load("UiLogoType")
Setup.Load("UiHiddenPageDownload")
PageSetupUI.BackgroundRefresh(False, True) PageSetupUI.BackgroundRefresh(False, True)
MusicRefreshPlay(False, True) MusicRefreshPlay(False, True)
'扩展按钮 '扩展按钮
@@ -449,8 +462,8 @@ Public Class FormMain
'加载窗口 '加载窗口
ThemeRefreshMain() ThemeRefreshMain()
Try Try
Height = Setup.Get("WindowHeight") Height = Settings.Get("WindowHeight")
Width = Setup.Get("WindowWidth") Width = Settings.Get("WindowWidth")
Catch ex As Exception '修复 #2019 Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", LogLevel.Hint) Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
Height = MinHeight + 100 Height = MinHeight + 100
@@ -471,7 +484,7 @@ Public Class FormMain
HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc)) HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
AniStart({ AniStart({
AaCode(Sub() AniControlEnabled -= 1, 50), AaCode(Sub() AniControlEnabled -= 1, 50),
AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100), AaOpacity(Me, Settings.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaCode( AaCode(
@@ -489,15 +502,15 @@ Public Class FormMain
Sub() Sub()
'EULA 提示 'EULA 提示
Const EulaVersion As Integer = 2 Const EulaVersion As Integer = 2
If Setup.Get("SystemEulaVersion") < EulaVersion Then If Settings.Get("SystemEulaVersion") < EulaVersion Then
Select Case MyMsgBox( Select Case MyMsgBox(
If(Setup.Get("SystemEulaVersion") = 0, If(Settings.Get("SystemEulaVersion") = 0,
"在使用 PCL 前,请先阅读用户协议与免责声明。", "在使用 PCL 前,请先阅读用户协议与免责声明。",
$"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"), $"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"),
"协议授权", "同意", "拒绝", "查看用户协议与免责声明", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1 Case 1
Setup.Set("SystemEulaVersion", EulaVersion) Settings.Set("SystemEulaVersion", EulaVersion)
Case 2 Case 2
EndProgram(False) EndProgram(False)
End Select End Select
@@ -527,15 +540,15 @@ Public Class FormMain
End Sub End Sub
'根据打开次数触发的事件 '根据打开次数触发的事件
Private Sub RunCountSub() Private Sub RunCountSub()
Setup.Set("SystemCount", Setup.Get("SystemCount") + 1) Settings.Set("SystemCount", Settings.Get("SystemCount") + 1)
#If Not BETA Then #If Not BETA Then
Select Case Setup.Get("SystemCount") Select Case Settings.Get("SystemCount")
Case 1 Case 1
MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf & MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf & "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明") "如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
End Select End Select
If Setup.Get("SystemCount") >= 99 Then If Settings.Get("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf & MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
"隐藏主题 铁杆粉 已解锁!", "提示") "隐藏主题 铁杆粉 已解锁!", "提示")
@@ -546,46 +559,44 @@ Public Class FormMain
'升级与降级事件 '升级与降级事件
Private Sub UpgradeSub(LastVersionCode As Integer) Private Sub UpgradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode) Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode)
Setup.Set("SystemLastVersionReg", VersionCode) Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号 '检查有记录的最高版本号
Dim LowerVersionCode As Integer Dim LowerVersionCode As Integer
#If BETA Then #If BETA Then
LowerVersionCode = Setup.Get("SystemHighestBetaVersionReg") LowerVersionCode = Settings.Get("SystemHighestBetaVersionReg")
If LowerVersionCode < VersionCode Then If LowerVersionCode < VersionCode Then
Setup.Set("SystemHighestBetaVersionReg", VersionCode) Settings.Set("SystemHighestBetaVersionReg", VersionCode)
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode) Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If End If
#Else #Else
LowerVersionCode = Setup.Get("SystemHighestAlphaVersionReg") LowerVersionCode = Settings.Get("SystemHighestAlphaVersionReg")
If LowerVersionCode < VersionCode Then If LowerVersionCode < VersionCode Then
Setup.Set("SystemHighestAlphaVersionReg", VersionCode) Settings.Set("SystemHighestAlphaVersionReg", VersionCode)
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode) Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If End If
#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) If Settings.Get("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称 '修改主题设置项名称
If LowerVersionCode <= 207 Then If LowerVersionCode <= 207 Then
Dim UnlockedTheme As New List(Of String) From {"2"} Dim UnlockedTheme As New List(Of String) From {"2"}
UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide").ToString.Split("|"))) UnlockedTheme.AddRange(New List(Of String)(Settings.Get("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))) UnlockedTheme.AddRange(New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|")))
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme.Distinct.ToList, "|")) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Distinct.ToList.Join("|"c))
End If End If
'重置欧皇彩 '重置欧皇彩
If LastVersionCode <= 115 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then If LastVersionCode <= 115 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("13") UnlockedTheme.Remove("13")
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf & MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
"多谢各位的理解啦!", "重新解锁提醒") "多谢各位的理解啦!", "重新解锁提醒")
End If End If
'重置滑稽彩 '重置滑稽彩
If LastVersionCode <= 152 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then If LastVersionCode <= 152 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("12") UnlockedTheme.Remove("12")
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf & MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
"多谢各位的理解啦!", "重新解锁提醒") "多谢各位的理解啦!", "重新解锁提醒")
End If End If
@@ -600,28 +611,28 @@ Public Class FormMain
End If End If
'解除帮助页面的隐藏 '解除帮助页面的隐藏
If LastVersionCode <= 205 Then If LastVersionCode <= 205 Then
Setup.Set("UiHiddenOtherHelp", False) Settings.Set("UiHiddenOtherHelp", False)
Log("[Start] 已解除帮助页面的隐藏") Log("[Start] 已解除帮助页面的隐藏")
End If End If
'单向迁移微软登录结果(#4836) '单向迁移微软登录结果(#4836)
If Not Setup.Get("CacheMsV2Migrated") Then If Not Settings.Get("CacheMsV2Migrated") Then
Setup.Set("CacheMsV2Migrated", True) Settings.Set("CacheMsV2Migrated", True)
Setup.Set("CacheMsV2OAuthRefresh", Setup.Get("CacheMsOAuthRefresh")) Settings.Set("CacheMsV2OAuthRefresh", Settings.Get("CacheMsOAuthRefresh"))
Setup.Set("CacheMsV2Access", Setup.Get("CacheMsAccess")) Settings.Set("CacheMsV2Access", Settings.Get("CacheMsAccess"))
Setup.Set("CacheMsV2ProfileJson", Setup.Get("CacheMsProfileJson")) Settings.Set("CacheMsV2ProfileJson", Settings.Get("CacheMsProfileJson"))
Setup.Set("CacheMsV2Uuid", Setup.Get("CacheMsUuid")) Settings.Set("CacheMsV2Uuid", Settings.Get("CacheMsUuid"))
Setup.Set("CacheMsV2Name", Setup.Get("CacheMsName")) Settings.Set("CacheMsV2Name", Settings.Get("CacheMsName"))
Log("[Start] 已从老版本迁移微软登录结果") Log("[Start] 已从老版本迁移微软登录结果")
End If End If
'Mod 命名设置迁移 'Mod 命名设置迁移
If Not Setup.IsUnset("ToolDownloadTranslate") AndAlso Setup.IsUnset("ToolDownloadTranslateV2") Then If Settings.HasSaved("ToolDownloadTranslate") AndAlso Not Settings.HasSaved("ToolDownloadTranslateV2") Then
Setup.Set("ToolDownloadTranslateV2", Setup.Get("ToolDownloadTranslate") + 1) Settings.Set("ToolDownloadTranslateV2", Settings.Get("ToolDownloadTranslate") + 1)
Log("[Start] 已从老版本迁移 Mod 命名设置") Log("[Start] 已从老版本迁移 Mod 命名设置")
End If End If
'重置 JVM 参数设置 '重置 JVM 参数设置
If LastVersionCode <= 381 AndAlso Not Setup.IsUnset("LaunchAdvanceJvm") AndAlso If LastVersionCode <= 381 AndAlso Settings.HasSaved("LaunchAdvanceJvm") AndAlso
Setup.Get("LaunchAdvanceJvm").ToString.Replace("-XX:+UseG1GC ", "").Replace("-XX:-UseAdaptiveSizePolicy ", "").Trim = Setup.GetDefault("LaunchAdvanceJvm") Then Settings.Get("LaunchAdvanceJvm").ToString.Replace("-XX:+UseG1GC ", "").Replace("-XX:-UseAdaptiveSizePolicy ", "").Trim = Settings.GetDefault("LaunchAdvanceJvm") Then
Setup.Reset("LaunchAdvanceJvm") Settings.Reset("LaunchAdvanceJvm")
Log("[Start] 已重置 JVM 参数设置") Log("[Start] 已重置 JVM 参数设置")
End If End If
'输出更新日志 '输出更新日志
@@ -631,7 +642,7 @@ Public Class FormMain
End Sub End Sub
Private Sub DowngradeSub(LastVersionCode As Integer) Private Sub DowngradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode) Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode)
Setup.Set("SystemLastVersionReg", VersionCode) Settings.Set("SystemLastVersionReg", VersionCode)
End Sub End Sub
#End Region #End Region
@@ -655,7 +666,7 @@ Public Class FormMain
Sub() Sub()
Log("[System] 正在强行停止任务") Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList() For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort() Task.Interrupt()
Next Next
End Sub, "强行停止下载任务") End Sub, "强行停止下载任务")
End If End If
@@ -730,8 +741,8 @@ Public Class FormMain
Public IsSizeSaveable As Boolean = False Public IsSizeSaveable As Boolean = False
Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
If IsSizeSaveable Then If IsSizeSaveable Then
Setup.Set("WindowHeight", Height) Settings.Set("WindowHeight", Height)
Setup.Set("WindowWidth", Width) Settings.Set("WindowWidth", Width)
End If End If
RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight) RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
PanForm.Width = BorderForm.ActualWidth + 0.001 PanForm.Width = BorderForm.ActualWidth + 0.001
@@ -746,6 +757,131 @@ Public Class FormMain
WindowState = WindowState.Minimized WindowState = WindowState.Minimized
End Sub End Sub
'背景图片与标题栏
Public Shared Sub UpdateBackgroundAndTitleBar(Value) '从设置更新
If FrmMain Is Nothing OrElse Not FrmMain.IsLoaded Then Return
FrmMain.UpdateBackgroundAndTitleBar()
End Sub
Public Sub UpdateBackgroundAndTitleBar()
Log("[FormMain] 从设置更新背景图片与标题栏样式")
'背景图片透明度
ImgBack.Opacity = Settings.Get("UiBackgroundOpacity") / 1000
'背景图片模糊
Dim BlurRadius As Double = Settings.Get("UiBackgroundBlur") + 1
If BlurRadius = 1 Then
ImgBack.Effect = Nothing
Else
ImgBack.Effect = New Effects.BlurEffect With {.Radius = BlurRadius}
End If
ImgBack.Margin = New Thickness(-BlurRadius / 1.8)
'背景图片适应方式
Dim BackgroundType As Integer = Settings.Get("UiBackgroundSuit")
If ImgBack.Background IsNot Nothing Then
Dim Brush As ImageBrush = CType(ImgBack.Background, ImageBrush)
If BackgroundType = 0 Then
'智能:当图片较小时平铺,较大时适应
If Brush.ImageSource.Width < PanMain.ActualWidth / 2 AndAlso Brush.ImageSource.Height < PanMain.ActualHeight / 2 Then
BackgroundType = 4 '平铺
Else
BackgroundType = 2 '适应
End If
End If
Brush.Stretch = Stretch.UniformToFill
Brush.TileMode = TileMode.None
Brush.Viewport = New Rect(0, 0, 1, 1)
Brush.ViewportUnits = BrushMappingMode.RelativeToBoundingBox
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Center
Select Case BackgroundType
Case 1 '中
Brush.Stretch = Stretch.None
Case 3 '拉伸
Brush.Stretch = Stretch.Fill
Case 4 '平铺
Brush.Stretch = Stretch.None
Brush.TileMode = TileMode.Tile
Brush.Viewport = New Rect(0, 0, Brush.ImageSource.Width, Brush.ImageSource.Height)
Brush.ViewportUnits = BrushMappingMode.Absolute
Case 2 '适应
Case 5 '左上
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Top
Case 6 '右上
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Top
Case 7 '左下
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Bottom
Case 8 '右下
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Bottom
Case 9 '左
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Center
Case 10 '右
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Center
Case 11 '上
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Top
Case 12 '下
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Bottom
End Select
End If
'标题栏显示类型
Select Case Settings.Get("UiLogoType")
Case 0 '无
ShapeTitleLogo.Visibility = Visibility.Collapsed
LabTitleLogo.Visibility = Visibility.Collapsed
ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then 'TODO: 和 FrmSetupUI 解耦
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Visible
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 1 '默认
ShapeTitleLogo.Visibility = Visibility.Visible
LabTitleLogo.Visibility = Visibility.Collapsed
ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 2 '文本
ShapeTitleLogo.Visibility = Visibility.Collapsed
LabTitleLogo.Visibility = Visibility.Visible
ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Visible
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 3 '图片
ShapeTitleLogo.Visibility = Visibility.Collapsed
LabTitleLogo.Visibility = Visibility.Collapsed
ImageTitleLogo.Visibility = Visibility.Visible
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
ImageTitleLogo.Source = Path & "PCL\Logo.png"
Catch ex As Exception
ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", LogLevel.Msgbox)
End Try
End Select
FrmSetupUI?.CardLogo.TriggerForceResize()
'标题栏文本
LabTitleLogo.Text = Settings.Get("UiLogoText")
'标题栏文本是否居左
PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Settings.Get("UiLogoLeft") AndAlso Settings.Get("UiLogoType") = 0, 0, 1), GridUnitType.Star)
End Sub
#End Region #End Region
#Region "窗体事件" #Region "窗体事件"
@@ -837,13 +973,13 @@ Public Class FormMain
Log(ex, "切回窗口时出错", LogLevel.Feedback) Log(ex, "切回窗口时出错", LogLevel.Feedback)
End Try End Try
'读取剪贴板,自动加入联机房间 '读取剪贴板,自动加入联机房间
Return 'UNDONE: 联机复活赛 Return 'TODO: 联机复活赛
If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机 If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
If PageCurrent = PageType.Link Then Return '已在联机界面 If PageCurrent = PageType.Link Then Return '已在联机界面
Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本 Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本
If Setup.Get("LinkLastAutoJoinInviteCode") = Code Then Return If Settings.Get("LinkLastAutoJoinInviteCode") = Code Then Return
If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码 If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码
Setup.Set("LinkLastAutoJoinInviteCode", Code) Settings.Set("LinkLastAutoJoinInviteCode", Code)
RunInThread( RunInThread(
Sub() Sub()
If MyMsgBox("嘿,是否使用复制的邀请码加入房间?", "加入联机房间", "加入", "取消") = 2 Then Return '防止弹窗阻碍主线程,所以必须放在工作线程 If MyMsgBox("嘿,是否使用复制的邀请码加入房间?", "加入联机房间", "加入", "取消") = 2 Then Return '防止弹窗阻碍主线程,所以必须放在工作线程
@@ -917,10 +1053,10 @@ Public Class FormMain
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return Return
End If End If
Setup.Set("VersionServerLogin", 4, Instance:=Target) Settings.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Instance:=Target) Settings.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Instance:=Target)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Instance:=Target) Settings.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Instance:=Target)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Instance:=Target) Settings.Set("VersionServerAuthName", "LittleSkin 登录", Instance:=Target)
Else Else
'第三方 Authlib 服务器 '第三方 Authlib 服务器
If MyMsgBox($"是否要在版本 {Target.Name} 中开启第三方登录?" & vbCrLf & If MyMsgBox($"是否要在版本 {Target.Name} 中开启第三方登录?" & vbCrLf &
@@ -928,10 +1064,10 @@ Public Class FormMain
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return Return
End If End If
Setup.Set("VersionServerLogin", 4, Instance:=Target) Settings.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", AuthlibServer, Instance:=Target) Settings.Set("VersionServerAuthServer", AuthlibServer, Instance:=Target)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Instance:=Target) Settings.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Instance:=Target)
Setup.Set("VersionServerAuthName", "", Instance:=Target) Settings.Set("VersionServerAuthName", "", Instance:=Target)
End If End If
If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceSetup Then If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceSetup Then
'正在服务器选项页,需要刷新设置项显示 '正在服务器选项页,需要刷新设置项显示
@@ -983,14 +1119,14 @@ Public Class FormMain
If FilePathList.Count > 1 Then If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件 '必须要求全部为 jar 文件
For Each File In FilePathList For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").Lower) Then
Hint("一次请只拖入一个文件!", HintType.Red) Hint("一次请只拖入一个文件!", HintType.Red)
Return Return
End If End If
Next Next
End If End If
'主页 '主页
Dim Extension As String = FilePath.AfterLast(".").ToLower Dim Extension As String = FilePath.AfterLast(".").Lower
If Extension = "xaml" Then If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为主页加载") Log("[System] 文件后缀为 XAML,作为主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then If File.Exists(Path & "PCL\Custom.xaml") Then
@@ -1001,7 +1137,7 @@ Public Class FormMain
CopyFile(FilePath, Path & "PCL\Custom.xaml") CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi( RunInUi(
Sub() Sub()
Setup.Set("UiCustomType", 1) Settings.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh() FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Green) Hint("已加载主页自定义文件!", HintType.Green)
End Sub) End Sub)
@@ -1614,7 +1750,7 @@ Public Class FormMain
'关闭 Minecraft '关闭 Minecraft
Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
Try Try
If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Abort() If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Interrupt()
For Each Watcher In McWatcherList For Each Watcher In McWatcherList
Watcher.Kill() Watcher.Kill()
Next Next
@@ -8,7 +8,12 @@ Public Module ModAnimation
''' <summary> ''' <summary>
''' 动画速度。最大为 200。 ''' 动画速度。最大为 200。
''' </summary> ''' </summary>
Public AniSpeed As Double = 1 Public ReadOnly Property AniSpeed As Double
Get
Dim Setting = PCL.Settings.Get("SystemDebugAnim")
Return If(Setting >= 30, 200, MathClamp(Setting * 0.1 + 0.1, 0.1, 3))
End Get
End Property
''' <summary> ''' <summary>
''' 动画组列表。 ''' 动画组列表。
''' </summary> ''' </summary>
+156 -52
View File
@@ -14,13 +14,13 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.12.3" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.12.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.12.3." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.12.4." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换 Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 381 'Release Public Const VersionCode As Integer = 383 'Release
#Else #Else
Public Const VersionCode As Integer = 382 'Snapshot Public Const VersionCode As Integer = 384 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -56,10 +56,6 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Lang As String = "zh_CN" Public Lang As String = "zh_CN"
''' <summary> ''' <summary>
''' 设置对象。
''' </summary>
Public Setup As New ModSetup
''' <summary>
''' 程序的打开计时。 ''' 程序的打开计时。
''' </summary> ''' </summary>
Public ApplicationStartTick As Long = GetTimeMs() Public ApplicationStartTick As Long = GetTimeMs()
@@ -86,11 +82,11 @@ Public Module ModBase
''' <summary> ''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。 ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary> ''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799 Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.Upper.First & ":\" '#3799
''' <summary> ''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。 ''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary> ''' </summary>
Public PathTemp As String = If(Setup.Get("SystemSystemCache") = "", IO.Path.GetTempPath() & "PCL\", Setup.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\" Public PathTemp As String = If(Settings.Get("SystemSystemCache") = "", IO.Path.GetTempPath() & "PCL\", Settings.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
''' <summary> ''' <summary>
''' AppData 中的 PCL 文件夹路径,以 \ 结尾。 ''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
''' </summary> ''' </summary>
@@ -416,17 +412,13 @@ Public Module ModBase
Loading Loading
Finished Finished
Failed Failed
Aborted Interrupted
End Enum End Enum
''' <summary> ''' <summary>
''' 执行返回值。 ''' 执行返回值。
''' </summary> ''' </summary>
Public Enum ProcessReturnValues Public Enum ProcessReturnValues
''' <summary>
''' 执行成功,或进程被中断。
''' </summary>
Aborted = -1
''' <summary> ''' <summary>
''' 执行成功。 ''' 执行成功。
''' </summary> ''' </summary>
@@ -620,7 +612,8 @@ Public Module ModBase
Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False) Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
Try Try
Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True) Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
SubKey?.DeleteValue(Key) If SubKey?.GetValue(Key) Is Nothing Then Return
SubKey.DeleteValue(Key)
Catch ex As Exception Catch ex As Exception
Log(ex, "删除注册表出错:" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer)) Log(ex, "删除注册表出错:" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer))
If ThrowException Then Throw If ThrowException Then Throw
@@ -1253,11 +1246,11 @@ Re:
End If End If
If Not String.IsNullOrEmpty(Hash) Then If Not String.IsNullOrEmpty(Hash) Then
If Hash.Length < 35 Then 'MD5 If Hash.Length < 35 Then 'MD5
If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath) If Hash.Lower <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
ElseIf Hash.Length = 64 Then 'SHA256 ElseIf Hash.Length = 64 Then 'SHA256
If Hash.ToLowerInvariant <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath) If Hash.Lower <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
Else 'SHA1 (40) Else 'SHA1 (40)
If Hash.ToLowerInvariant <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath) If Hash.Lower <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
End If End If
End If End If
If IsJson Then If IsJson Then
@@ -1287,7 +1280,7 @@ Re:
'解压 gz(gz 不需要考虑编码) '解压 gz(gz 不需要考虑编码)
If CompressFilePath.EndsWithF(".gz", True) Then If CompressFilePath.EndsWithF(".gz", True) Then
Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress) Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
Using decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), Using decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).Lower.Replace(".tar", "").Replace(".gz", ""),
FileMode.OpenOrCreate, FileAccess.Write) FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte() Dim data As Integer = stream.ReadByte()
While data <> -1 While data <> -1
@@ -1332,7 +1325,7 @@ Re:
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
If Not Directory.Exists(Path) Then Return 0 If Not Directory.Exists(Path) Then Return 0
If Not Path.EndsWithF("\") Then Path &= "\" If Not Path.EndsWithF("\") Then Path &= "\"
If Path.EndsWith(":\") OrElse If Path.EndsWithF(":\") OrElse
Path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse Path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
Path = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse Path = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
Path = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030 Path = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
@@ -1416,17 +1409,25 @@ RetryDir:
''' <summary> ''' <summary>
''' 若路径长度大于指定值,则将长路径转换为短路径。 ''' 若路径长度大于指定值,则将长路径转换为短路径。
''' 如果路径不存在,则返回原始路径。
''' </summary> ''' </summary>
Public Function ShortenPath(LongPath As String) As String Public Function ShortenPath(Raw As String) As String
If LongPath.Length <= 200 OrElse LongPath.StartsWithF("http", True) Then Return LongPath If Raw.Length <= 200 OrElse Raw.StartsWithF("http", True) Then Return Raw
If Not Directory.Exists(LongPath) AndAlso Not File.Exists(LongPath) Then Return LongPath If Not Directory.Exists(Raw) AndAlso Not File.Exists(Raw) Then Return Raw
Dim ShortPath As New StringBuilder(260) Dim PathToShorten As String, Ignored As String
GetShortPathName(LongPath.Replace("/", "\"), ShortPath, 260) '第一个参数也会在调用后被修改,使用 Replace 后不会影响原始字符串 If Not Directory.Exists(Raw) AndAlso Raw.EndsWithF(".jar", True) Then '只能缩短文件夹部分,必须保留 jar 文件名,否则会导致 Forge 1.20.1 无法通过文件名识别模块名
ShortenPath = ShortPath.ToString PathToShorten = GetPathFromFullPath(Raw)
If String.IsNullOrEmpty(ShortenPath) Then Return LongPath Ignored = GetFileNameFromPath(Raw)
Else
PathToShorten = Raw
Ignored = ""
End If
Dim ShortPathBuffer As New StringBuilder(260)
GetShortPathNameW(PathToShorten.Replace("/", "\"), ShortPathBuffer, 260)
Dim DirShortPath As String = ShortPathBuffer.ToString()
If String.IsNullOrEmpty(DirShortPath) Then Return Raw
Return If(String.IsNullOrEmpty(Ignored), DirShortPath, IO.Path.Combine(DirShortPath, Ignored))
End Function End Function
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (lpszLongPath As String, lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer Private Declare Unicode Function GetShortPathNameW Lib "kernel32" Alias "GetShortPathNameW" (lpszLongPath As String, lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer
#End Region #End Region
@@ -1493,7 +1494,7 @@ RetryDir:
Ex = Ex.InnerException Ex = Ex.InnerException
Loop Loop
DescList = DescList.Distinct.ToList DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ") Dim Desc As String = DescList.Join(vbCrLf & "→ ")
'构造输出信息 '构造输出信息
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList) Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
@@ -1501,7 +1502,7 @@ RetryDir:
Return UsualReason & "详细错误:" & DescList.First Return UsualReason & "详细错误:" & DescList.First
Else Else
DescList.Reverse() '让最深层错误在最左边 DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " ← ") Return DescList.Join(" ← ")
End If End If
End Function End Function
Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
@@ -1584,7 +1585,7 @@ RetryDir:
''' </summary> ''' </summary>
<Extension> Public Function Capitalize(word As String) As String <Extension> Public Function Capitalize(word As String) As String
If String.IsNullOrEmpty(word) Then Return word If String.IsNullOrEmpty(word) Then Return word
Return word.Substring(0, 1).ToUpperInvariant() & word.Substring(1).ToLowerInvariant() Return word.Substring(0, 1).Upper() & word.Substring(1).Lower()
End Function End Function
''' <summary> ''' <summary>
@@ -1604,7 +1605,24 @@ RetryDir:
''' <summary> ''' <summary>
''' 连接字符串。 ''' 连接字符串。
''' </summary> ''' </summary>
<Extension> Public Function Join(List As IEnumerable, Split As Char) As String
Dim Builder As New StringBuilder
Dim IsFirst As Boolean = True
For Each Element In List
If IsFirst Then
IsFirst = False
Else
Builder.Append(Split)
End If
If Element IsNot Nothing Then Builder.Append(Element)
Next
Return Builder.ToString
End Function
''' <summary>
''' 连接字符串。
''' </summary>
<Extension> Public Function Join(List As IEnumerable, Split As String) As String <Extension> Public Function Join(List As IEnumerable, Split As String) As String
If Split.IsSingle Then Return List.Join(Split(0))
Dim Builder As New StringBuilder Dim Builder As New StringBuilder
Dim IsFirst As Boolean = True Dim IsFirst As Boolean = True
For Each Element In List For Each Element In List
@@ -1622,7 +1640,7 @@ RetryDir:
''' 若原始字符串为空,则返回 {""}。 ''' 若原始字符串为空,则返回 {""}。
''' </summary> ''' </summary>
<Extension> Public Function Split(FullStr As String, SplitStr As String) As String() <Extension> Public Function Split(FullStr As String, SplitStr As String) As String()
If SplitStr.Length = 1 Then If SplitStr.IsSingle Then
Return FullStr.Split(SplitStr(0)) Return FullStr.Split(SplitStr(0))
Else Else
Return FullStr.Split({SplitStr}, StringSplitOptions.None) Return FullStr.Split({SplitStr}, StringSplitOptions.None)
@@ -1795,6 +1813,19 @@ RetryDir:
End Try End Try
End Function End Function
''' <summary>
''' 等效 ToLowerInvariant。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)> Public Function Lower(Str As String) As String
Return Str.ToLowerInvariant()
End Function
''' <summary>
''' 等效 ToUpperInvariant。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)> Public Function Upper(Str As String) As String
Return Str.ToUpperInvariant()
End Function
'转义 '转义
''' <summary> ''' <summary>
''' 为字符串进行 XML 转义。 ''' 为字符串进行 XML 转义。
@@ -1887,8 +1918,8 @@ RetryDir:
If String.IsNullOrEmpty(Source) OrElse String.IsNullOrEmpty(Query) Then Return 0 If String.IsNullOrEmpty(Source) OrElse String.IsNullOrEmpty(Query) Then Return 0
Dim qp As Integer = 0, lenSum As Double = 0 Dim qp As Integer = 0, lenSum As Double = 0
Dim str As New StringBuilder(Source.Length) Dim str As New StringBuilder(Source.Length)
str.Append(Source.ToLower().Replace(" ", "")) str.Append(Source.Lower().Replace(" ", ""))
Query = Query.ToLower().Replace(" ", "") Query = Query.Lower().Replace(" ", "")
Dim sourceLength As Integer = str.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存 Dim sourceLength As Integer = str.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
If queryLength = 0 Then Return 0 If queryLength = 0 Then Return 0
Do While qp < queryLength Do While qp < queryLength
@@ -1977,6 +2008,7 @@ RetryDir:
''' <summary> ''' <summary>
''' 进行多段文本加权搜索,获取相似度较高的数项结果。 ''' 进行多段文本加权搜索,获取相似度较高的数项结果。
''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。 ''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。
''' 这会修改 Entries 中每项的 Similarity 与 AbsoluteRight 字段。
''' </summary> ''' </summary>
''' <param name="MaxBlurCount">返回的最大模糊结果数。</param> ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param> ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
@@ -1997,14 +2029,7 @@ RetryDir:
If Entry.AbsoluteRight OrElse Entry.Similarity >= MinBlurSimilarity Then Candidates.Add(Entry) If Entry.AbsoluteRight OrElse Entry.Similarity >= MinBlurSimilarity Then Candidates.Add(Entry)
Next Next
'按照相似度进行排序 '按照相似度进行排序
Candidates = Candidates.SortByComparison( Candidates = Candidates.SortByComparison(Function(Left, Right) If(Left.AbsoluteRight <> Right.AbsoluteRight, Left.AbsoluteRight, Left.Similarity > Right.Similarity))
Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
Else
Return Left.Similarity > Right.Similarity
End If
End Function)
'返回结果 '返回结果
Dim BlurCount As Integer = 0 Dim BlurCount As Integer = 0
For Each Entry In Candidates For Each Entry In Candidates
@@ -2319,6 +2344,22 @@ NextElement:
Return Arr?.Count > 0 Return Arr?.Count > 0
End Function End Function
''' <summary> ''' <summary>
''' 判断这是否是仅有一个元素的集合。
''' </summary>
<Extension> Public Function IsSingle(Of T)(Source As IEnumerable(Of T)) As Boolean
If Source Is Nothing Then
Return False
ElseIf TypeOf Source Is IList(Of T) Then
Return DirectCast(Source, IList(Of T)).Count = 1
Else
Using Enumerator = Source.GetEnumerator()
If Not Enumerator.MoveNext() Then Return False
If Enumerator.MoveNext() Then Return False
Return True
End Using
End If
End Function
''' <summary>
''' 对集合的每个元素执行指定操作。 ''' 对集合的每个元素执行指定操作。
''' </summary> ''' </summary>
<Extension> Public Function ForEach(Of T)(Collection As IEnumerable(Of T), Action As Action(Of T)) As IEnumerable(Of T) <Extension> Public Function ForEach(Of T)(Collection As IEnumerable(Of T), Action As Action(Of T)) As IEnumerable(Of T)
@@ -2548,6 +2589,58 @@ NextElement:
End If End If
End Sub End Sub
''' <summary>
''' 选择所有最大值对应的对象。
''' 若没有元素则返回空列表。
''' </summary>
<Extension> Public Function MaxByAll(Of T, C As IComparable(Of C))(Source As IEnumerable(Of T), Selector As Func(Of T, C)) As List(Of T)
Dim Results As New List(Of T)
Using Enumerator = Source.GetEnumerator()
If Not Enumerator.MoveNext() Then Return Results
Dim MaxItem As T = Enumerator.Current
Dim MaxValue As C = Selector(MaxItem)
Results.Add(MaxItem)
While Enumerator.MoveNext()
Dim CurrentItem = Enumerator.Current
Dim CurrentValue = Selector(CurrentItem)
Dim Comparison = CurrentValue.CompareTo(MaxValue)
If Comparison > 0 Then
MaxValue = CurrentValue
Results.Clear()
Results.Add(CurrentItem)
ElseIf Comparison = 0 Then
Results.Add(CurrentItem)
End If
End While
End Using
Return Results
End Function
''' <summary>
''' 选择所有最小值对应的对象。
''' 若没有元素则返回空列表。
''' </summary>
<Extension> Public Function MinByAll(Of T, C As IComparable(Of C))(List As IEnumerable(Of T), Selector As Func(Of T, C)) As List(Of T)
Dim Results As New List(Of T)
Using Enumerator = List.GetEnumerator()
If Not Enumerator.MoveNext() Then Return Results
Dim MinItem As T = Enumerator.Current
Dim MinValue As C = Selector(MinItem)
Results.Add(MinItem)
While Enumerator.MoveNext()
Dim CurrentItem = Enumerator.Current
Dim CurrentValue = Selector(CurrentItem)
Dim Comparison = CurrentValue.CompareTo(MinValue)
If Comparison < 0 Then
MinValue = CurrentValue
Results.Clear()
Results.Add(CurrentItem)
ElseIf Comparison = 0 Then
Results.Add(CurrentItem)
End If
End While
End Using
Return Results
End Function
''' <summary> ''' <summary>
''' 选择最大值对应的对象。 ''' 选择最大值对应的对象。
''' 若没有元素则返回 Nothing。 ''' 若没有元素则返回 Nothing。
@@ -2683,7 +2776,7 @@ NextElement:
Try Try
Location = Location.Replace("/", "\").Trim(" "c, """"c) Location = Location.Replace("/", "\").Trim(" "c, """"c)
Log("[System] 正在打开资源管理器:" & Location) Log("[System] 正在打开资源管理器:" & Location)
If Location.EndsWith("\") Then If Location.EndsWithF("\") Then
StartProcess(Location) StartProcess(Location)
Else Else
StartProcess("explorer", $"/select,""{Location}""") StartProcess("explorer", $"/select,""{Location}""")
@@ -2883,7 +2976,7 @@ Retry:
'类型检查 '类型检查
Using Reader As New XamlXmlReader(Stream) Using Reader As New XamlXmlReader(Stream)
While Reader.Read() While Reader.Read()
For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider)} For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider), GetType(SettingService)}
If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 类型。") If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 类型。")
If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 值。") If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 值。")
Next Next
@@ -2940,11 +3033,22 @@ Retry:
Return formattedText.Width Return formattedText.Width
End Function End Function
''' <summary>
''' 将布尔值转换为 Visibility。True 转换为 Visible,False 转换为 Collapsed。
''' </summary>
<Extension> Public Function ToVisibility(IsVisible As Boolean) As Visibility
Return If(IsVisible, Visibility.Visible, Visibility.Collapsed)
End Function
#End Region #End Region
#Region "Debug" #Region "Debug"
Public ModeDebug As Boolean = False Public ReadOnly Property ModeDebug As Boolean
Get
Return Settings.Get("SystemDebugMode")
End Get
End Property
'Log 'Log
Public Enum LogLevel Public Enum LogLevel
@@ -3217,7 +3321,7 @@ Retry:
'遥测 '遥测
Public Sub Telemetry([Event] As String, ParamArray Datas As String()) Public Sub Telemetry([Event] As String, ParamArray Datas As String())
If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测 If Not Settings.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址 If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
If VersionBranchName = "Debug" Then Return '开发版本不上传遥测 If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
RunInNewThread( RunInNewThread(
@@ -3237,10 +3341,10 @@ Retry:
'获取当前的堆栈信息 '获取当前的堆栈信息
Public Function GetStackTrace() As String Public Function GetStackTrace() As String
Dim Stack As New StackTrace() Return (New StackTrace).GetFrames().Skip(1).
Return Join(Stack.GetFrames().Skip(1).Select(Function(f) f.GetMethod). Select(Function(f) f.GetMethod).
Select(Function(f) f.Name & "(" & Join(f.GetParameters.Select(Function(p) p.ToString).ToList, ", ") & ") - " & f.Module.ToString).ToList, Select(Function(f) $"{f.Name}({f.GetParameters.Select(Function(p) p.ToString).Join(", ")}) - {f.Module}").
vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf) Join(vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf)
End Function End Function
#End Region #End Region
@@ -88,7 +88,7 @@
Set(value As LoadState) Set(value As LoadState)
If _State = value Then Return If _State = value Then Return
Dim OldState = _State Dim OldState = _State
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000)) If value = LoadState.Finished AndAlso Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value _State = value
If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变:{GetStringFromEnum(value)}") If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变:{GetStringFromEnum(value)}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
@@ -149,7 +149,7 @@
Case LoadState.Waiting Case LoadState.Waiting
Return 0 Return 0
Case LoadState.Loading Case LoadState.Loading
Return If(_Progress = -1, 0.02, _Progress) Return If(_Progress = -1, 0, _Progress)
Case Else Case Else
Return 1 Return 1
End Select End Select
@@ -170,7 +170,7 @@
'状态变化 '状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
Public MustOverride Sub Abort() Public MustOverride Sub Interrupt()
Public MustOverride Sub Failed(Ex As Exception) Public MustOverride Sub Failed(Ex As Exception)
'等待结束 '等待结束
@@ -187,7 +187,7 @@
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Aborted Then ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
@@ -210,7 +210,7 @@
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Aborted Then ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
@@ -241,16 +241,16 @@
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。 ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。
''' </summary> ''' </summary>
Public ReadOnly Property IsAborted As Boolean Public ReadOnly Property IsInterrupted As Boolean
Get Get
Return IsAbortedWithThread(Thread.CurrentThread) Return IsInterruptedWithThread(Thread.CurrentThread)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。 ''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。
''' </summary> ''' </summary>
Public Function IsAbortedWithThread(Thread As Thread) As Boolean Public Function IsInterruptedWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted
End Function End Function
''' <summary> ''' <summary>
''' 在输入相同时使用原有结果的超时,单位为毫秒。 ''' 在输入相同时使用原有结果的超时,单位为毫秒。
@@ -305,7 +305,7 @@
'确认是否开始加载 '确认是否开始加载
If ShouldStart(Input, IsForceRestart) Then If ShouldStart(Input, IsForceRestart) Then
'输入不同或失败,开始加载 '输入不同或失败,开始加载
If State = LoadState.Loading Then TriggerThreadAbort() If State = LoadState.Loading Then TriggerThreadInterrupt()
Me.Input = Input Me.Input = Input
SyncLock LockState SyncLock LockState
State = LoadState.Loading State = LoadState.Loading
@@ -321,7 +321,7 @@
IsForceRestarting = IsForceRestart IsForceRestarting = IsForceRestart
If ModeDebug AndAlso Not LogBlackList.Contains(Name) 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) LoadDelegate(Me)
If IsAborted Then If IsInterrupted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer) Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Return Return
End If End If
@@ -331,18 +331,18 @@
LastFinishedTime = GetTimeMs() '未中断,本次输出有效 LastFinishedTime = GetTimeMs() '未中断,本次输出有效
Catch ex As CancelledException Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted '如果线程是因为判断到 IsInterrupted 而提前中止,则代表已有新线程被重启,此时不应当改为 Interrupted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted '如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Interrupted
If Not IsAborted Then State = LoadState.Aborted If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As Exception Catch ex As Exception
Failed(ex) Failed(ex)
End Try End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority} End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
Try Try
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsInterrupted
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试 Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
Thread.Sleep(500) Thread.Sleep(500)
LastRunningThread.Start() LastRunningThread.Start()
@@ -351,20 +351,20 @@
Public Overrides Sub Failed(ex As Exception) Public Overrides Sub Failed(ex As Exception)
[Error] = ex [Error] = ex
SyncLock LockState SyncLock LockState
If IsAborted OrElse State >= LoadState.Finished Then Return If IsInterrupted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer) Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
TriggerThreadAbort() TriggerThreadInterrupt()
End Sub End Sub
Public Overrides Sub Abort() Public Overrides Sub Interrupt()
SyncLock LockState SyncLock LockState
If State <> LoadState.Loading Then Return If State <> LoadState.Loading Then Return
State = LoadState.Aborted State = LoadState.Interrupted
End SyncLock End SyncLock
TriggerThreadAbort() TriggerThreadInterrupt()
End Sub End Sub
Private Sub TriggerThreadAbort() Private Sub TriggerThreadInterrupt()
If LastRunningThread Is Nothing Then Return If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt() LastRunningThread.Interrupt()
@@ -451,11 +451,11 @@
End If End If
RunInThread(AddressOf Update) RunInThread(AddressOf Update)
End Sub End Sub
Public Overrides Sub Abort() Public Overrides Sub Interrupt()
'改变状态 '改变状态
SyncLock LockState SyncLock LockState
If State = LoadState.Loading OrElse State = LoadState.Waiting Then If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Aborted State = LoadState.Interrupted
Else Else
Return Return
End If End If
@@ -464,7 +464,7 @@
Sub() Sub()
'中断加载器 '中断加载器
For Each Loader In Loaders For Each Loader In Loaders
Loader.Abort() Loader.Interrupt()
Next Next
End Sub) End Sub)
End Sub End Sub
@@ -475,7 +475,7 @@
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
For Each Loader In Loaders For Each Loader In Loaders
Loader.Abort() Loader.Interrupt()
Next Next
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
End Sub End Sub
@@ -493,9 +493,9 @@
Case LoadState.Finished Case LoadState.Finished
'正常结束,触发刷新 '正常结束,触发刷新
Update() Update()
Case LoadState.Aborted Case LoadState.Interrupted
'被中断,这个任务也中断 '被中断,这个任务也中断
Abort() Interrupt()
Case LoadState.Failed Case LoadState.Failed
'完蛋,出错了 '完蛋,出错了
Failed(New Exception(Loader.Name & "失败", Loader.Error)) Failed(New Exception(Loader.Name & "失败", Loader.Error))
@@ -505,7 +505,7 @@
''' 触发一次更新,以启动新加载器或完成。 ''' 触发一次更新,以启动新加载器或完成。
''' </summary> ''' </summary>
Private Sub Update() Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Return If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Interrupted Then Return
Dim IsFinished As Boolean = True Dim IsFinished As Boolean = True
Dim Blocked As Boolean = False Dim Blocked As Boolean = False
Dim Input As Object = Me.Input Dim Input As Object = Me.Input
@@ -607,7 +607,7 @@ Restart:
'若单个任务已中止,或全部任务已完成,则刷新并移除 '若单个任务已中止,或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Aborted) Then (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
FrmSpeedLeft?.TaskRefresh(Task) FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task) LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表") Log($"[Taskbar] {Task.Name} 已移出任务列表")
+69 -23
View File
@@ -160,7 +160,7 @@ RequestFinished:
NetRequestByLoader = ReadFile(Temp) NetRequestByLoader = ReadFile(Temp)
File.Delete(Temp) File.Delete(Temp)
Finally Finally
NewTask.Abort() NewTask.Interrupt()
End Try End Try
End Function End Function
@@ -208,7 +208,7 @@ RequestFinished:
Catch ex As Exception Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex) Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex)
Finally Finally
NewTask.Abort() NewTask.Interrupt()
End Try End Try
End Sub End Sub
@@ -238,7 +238,7 @@ RequestFinished:
End If End If
'写入 Headers '写入 Headers
For Each Header In If(Headers, New Dictionary(Of String, String)) For Each Header In If(Headers, New Dictionary(Of String, String))
If Header.Key.ToLower = "content-type" Then If Header.Key.Lower = "content-type" Then
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value) Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
Else Else
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value) Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
@@ -307,8 +307,10 @@ RequestFinished:
''' 返回请求时应使用的 IP。若解析失败,则返回 Nothing。 ''' 返回请求时应使用的 IP。若解析失败,则返回 Nothing。
''' </summary> ''' </summary>
Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationToken) As String Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationToken) As String
'若一分钟内已失败过,则不再重复尝试解析,以减少断网时的 Exception 数量
Dim Host = Request.RequestUri.Host Dim Host = Request.RequestUri.Host
'不对部分有严格 SNI 限制的域名进行 DNS 解析(#8295)
If {"mojang.com", "minecraft.net", "minecraftservices.com"}.Any(Function(h) Host.ContainsF(h, True)) Then Return Nothing
'若一分钟内已失败过,则不再重复尝试解析,以减少断网时的 Exception 数量
SyncLock DNSFailureRecord.SyncRoot SyncLock DNSFailureRecord.SyncRoot
If DNSFailureRecord.ContainsKey(Host) Then If DNSFailureRecord.ContainsKey(Host) Then
If Date.Now - DNSFailureRecord(Host) < New TimeSpan(0, 1, 0) Then If Date.Now - DNSFailureRecord(Host) < New TimeSpan(0, 1, 0) Then
@@ -399,7 +401,11 @@ RequestFinished:
''' <summary> ''' <summary>
''' 最大线程数。 ''' 最大线程数。
''' </summary> ''' </summary>
Public NetTaskThreadLimit As Integer Public ReadOnly Property NetTaskThreadLimit As Integer
Get
Return Settings.Get("ToolDownloadThread") + 1
End Get
End Property
''' <summary> ''' <summary>
''' 速度下限。 ''' 速度下限。
''' </summary> ''' </summary>
@@ -407,7 +413,27 @@ RequestFinished:
''' <summary> ''' <summary>
''' 速度上限。若无限制则为 -1。 ''' 速度上限。若无限制则为 -1。
''' </summary> ''' </summary>
Public NetTaskSpeedLimitHigh As Long = -1 Public ReadOnly Property NetTaskSpeedLimitHigh As Long
Get
If _NetTaskSpeedLimitHigh Is Nothing Then
Dim Setting = PCL.Settings.Get("ToolDownloadSpeed")
If Setting <= 14 Then
_NetTaskSpeedLimitHigh = (Setting + 1) * 0.1 * 1024 * 1024L
ElseIf Setting <= 31 Then
_NetTaskSpeedLimitHigh = (Setting - 11) * 0.5 * 1024 * 1024L
ElseIf Setting <= 41 Then
_NetTaskSpeedLimitHigh = (Setting - 21) * 1024 * 1024L
Else
_NetTaskSpeedLimitHigh = -1
End If
End If
Return _NetTaskSpeedLimitHigh.Value
End Get
End Property
Private _NetTaskSpeedLimitHigh As Long? = Nothing
Public Sub UpdateNetTaskSpeedLimitHigh(Value As Integer)
_NetTaskSpeedLimitHigh = Nothing
End Sub
''' <summary> ''' <summary>
''' 基于限速,当前可以下载的剩余量。 ''' 基于限速,当前可以下载的剩余量。
''' </summary> ''' </summary>
@@ -917,7 +943,7 @@ StartSingleThreadDownload:
Dim Source As NetSource = GetSource() Dim Source As NetSource = GetSource()
If Source Is Nothing Then Return Nothing If Source Is Nothing Then Return Nothing
Dim TargetUrl As String = Source.Url Dim TargetUrl As String = Source.Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("meloong.com") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing
'寻找最大碎片 '寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程 'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
@@ -1053,7 +1079,7 @@ NotSupportRange:
End If End If
'开始下载 '开始下载
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult() ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000)) If Settings.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
Dim ResponseBytes As Byte() = New Byte(16384) {} Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成 While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
@@ -1145,7 +1171,7 @@ SourceBreak:
If IsMergeFailure OrElse IsRangeNotSupported OrElse If IsMergeFailure OrElse IsRangeNotSupported OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("(404)") 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("未能解析") 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,所以不应因此禁用下载源 ((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.Contains("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429,所以不应因此禁用下载源
(Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then (Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
'当一个下载源有多个线程在下载时,只选择其中一个线程进行后续处理 '当一个下载源有多个线程在下载时,只选择其中一个线程进行后续处理
Dim IsThisFail As Boolean = False Dim IsThisFail As Boolean = False
@@ -1323,7 +1349,7 @@ Retry:
Log($"[Download] {LocalName}:已失败,当前状态 {State}") Log($"[Download] {LocalName}:已失败,当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() InterruptInternal()
For Each Task In Tasks For Each Task In Tasks
Task.OnFileFail(Me) Task.OnFileFail(Me)
Next Next
@@ -1331,9 +1357,9 @@ Retry:
''' <summary> ''' <summary>
''' 下载中断。 ''' 下载中断。
''' </summary> ''' </summary>
Public Sub Abort(AbortedTask As LoaderDownload) Public Sub Interrupt(InterruptedTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载 '从特定任务中移除,如果它还属于其他任务,则继续下载
Tasks.Remove(AbortedTask) Tasks.Remove(InterruptedTask)
If Tasks.Any Then Return If Tasks.Any Then Return
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
@@ -1341,9 +1367,9 @@ Retry:
Log($"[Download] {LocalName}:已中断,当前状态 {State}") Log($"[Download] {LocalName}:已中断,当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() InterruptInternal()
End Sub End Sub
Private Sub AbortInternal() Private Sub InterruptInternal()
On Error Resume Next On Error Resume Next
Reset() Reset()
Interlocked.Decrement(NetManager.FileRemain) Interlocked.Decrement(NetManager.FileRemain)
@@ -1488,7 +1514,7 @@ FinishExCatch:
Next Next
If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!") If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!")
File.LocalPath = File.LocalPath.Replace("/", "\") File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath) If Not File.LocalPath.Lower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath)
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath) If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath)
Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹 Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹
Next Next
@@ -1591,7 +1617,7 @@ Retry:
'目标文件已存在 '目标文件已存在
If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath
'在设置中禁用了复制 '在设置中禁用了复制
If Setup.Get("SystemDebugSkipCopy") Then Return Nothing If Settings.Get("SystemDebugSkipCopy") Then Return Nothing
'没有可用的检查规则,只能开始下载 '没有可用的检查规则,只能开始下载
If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing
'大致判断文件类别 '大致判断文件类别
@@ -1620,7 +1646,7 @@ Retry:
'版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹 '版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder, For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").ToLower, SearchOption.TopDirectoryOnly) "*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").Lower, SearchOption.TopDirectoryOnly)
'快速进行大小校验 '快速进行大小校验
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
@@ -1682,7 +1708,7 @@ Retry:
For Each File In Files For Each File In Files
If File.State <> NetState.Interrupted Then Continue For If File.State <> NetState.Interrupted 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 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) Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}({s.Url})").Join(vbCrLf)
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & [Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf &
"各下载源的错误如下:" & vbCrLf & Detail, [Error]) "各下载源的错误如下:" & vbCrLf & Detail, [Error])
'上报 '上报
@@ -1696,24 +1722,24 @@ Retry:
End SyncLock End SyncLock
'中断所有文件 '中断所有文件
For Each TaskFile In Files For Each TaskFile In Files
TaskFile.Abort(Me) TaskFile.Interrupt(Me)
Next Next
'在退出同步锁后再进行日志输出 '在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String) Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList For Each Ex As Exception In ExList
ErrOutput.Add(Ex.GetDetail()) ErrOutput.Add(Ex.GetDetail())
Next Next
Log("[Download] " & Join(ErrOutput.Distinct.ToArray, vbCrLf)) Log("[Download] " & ErrOutput.Distinct.Join(vbCrLf))
End Sub End Sub
Public Overrides Sub Abort() Public Overrides Sub Interrupt()
SyncLock LockState SyncLock LockState
If State >= LoadState.Finished Then Return If State >= LoadState.Finished Then Return
State = LoadState.Aborted State = LoadState.Interrupted
End SyncLock End SyncLock
Log("[Download] " & Name & " 已取消!") Log("[Download] " & Name & " 已取消!")
'中断所有文件 '中断所有文件
For Each TaskFile In Files For Each TaskFile In Files
TaskFile.Abort(Me) TaskFile.Interrupt(Me)
Next Next
End Sub End Sub
@@ -2023,4 +2049,24 @@ Retry:
}.Any(Function(k) Detail.ContainsF(k, True)) }.Any(Function(k) Detail.ContainsF(k, True))
End Function End Function
''' <summary>
''' 设置是否应当在正版登录时校验 SSL 证书。
''' </summary>
Public Sub ShouldValidateSslCertificateOnLogin(Enabled As Boolean)
ServicePointManager.ServerCertificateValidationCallback =
Function(Sender, Certificate, Chain, Failure)
Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest)
If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证
'基于 #3018 和 #5879,只在访问正版登录 API 时跳过证书验证
Log($"[System] 未通过 SSL 证书验证({Failure}),提供的证书为 {Certificate?.Subject},URL:{Request?.Address}", LogLevel.Debug)
If Request Is Nothing Then
Return Not Enabled
ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then
Return Not Enabled '根据设置决定是否忽略错误
Else
Return False
End If
End Function
End Sub
End Module End Module
@@ -208,7 +208,7 @@ Public Class ValidateExceptSame
If Str Is Nothing Then Return ErrorMessage.Replace("%", "null") If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")
For Each Ch As String In Excepts For Each Ch As String In Excepts
If IgnoreCase Then If IgnoreCase Then
If Str.ToLower = Ch.ToLower Then Return ErrorMessage.Replace("%", Ch) If Str.Lower = Ch.Lower Then Return ErrorMessage.Replace("%", Ch)
Else Else
If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写 If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写
End If End If
@@ -218,6 +218,27 @@ Public Class ValidateExceptSame
End Class End Class
''' <summary>
''' 必须为特定字符串。
''' </summary>
Public Class ValidateSame
Inherits Validate
Public Property Required As String
Public Property ErrorMessage As String
Public Property IgnoreCase As Boolean = False
Public Sub New()
End Sub
Public Sub New(Required As String, Optional ErrorMessage As String = "输入内容有误", Optional IgnoreCase As Boolean = False)
Me.Required = Required
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Overrides Function Validate(Str As String) As String
Return If(String.Compare(Str, Required, IgnoreCase) = 0, "", ErrorMessage)
End Function
End Class
''' <summary> ''' <summary>
''' 对文件夹名的粗略的特化检测。 ''' 对文件夹名的粗略的特化检测。
''' </summary> ''' </summary>
@@ -355,7 +376,7 @@ Public Class ValidateFolderPath
'检查开头 '检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return "" If Str.Upper = Drive.Name Then Return ""
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
Next Next
Return "文件夹路径头存在错误!" Return "文件夹路径头存在错误!"
@@ -60,23 +60,24 @@
If Line = "" Then Continue For If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨") For Each EntryData As String In Line.Split("¨")
Dim Entry = New CompDatabaseEntry Dim Entry = New CompDatabaseEntry
Dim SplitedLine = EntryData.Split("|") Dim Splited = EntryData.Split("|")
If SplitedLine(0).StartsWithF("@") Then Entry.Popularity = Val(Splited(0))
If Splited(1).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "") Entry.ModrinthSlug = Splited(1).Replace("@", "")
ElseIf SplitedLine(0).EndsWithF("@") Then ElseIf Splited(1).EndsWithF("@") Then
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@") Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf SplitedLine(0).Contains("@") Then ElseIf Splited(1).Contains("@") Then
Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0) Entry.CurseForgeSlug = Splited(1).Split("@")(0)
Entry.ModrinthSlug = SplitedLine(0).Split("@")(1) Entry.ModrinthSlug = Splited(1).Split("@")(1)
Else Else
Entry.CurseForgeSlug = SplitedLine(0) Entry.CurseForgeSlug = Splited(1)
Entry.ModrinthSlug = Nothing Entry.ModrinthSlug = Nothing
End If End If
Entry.WikiId = i Entry.WikiId = i
If SplitedLine.Count >= 2 Then If Splited.Count >= 3 Then
Entry.ChineseName = SplitedLine(1) Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 * If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*", Entry.ChineseName = Entry.ChineseName.Replace("*",
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})") $" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
@@ -106,9 +107,13 @@
''' Modrinth Slug(例如 advanced-solar-panels)。 ''' Modrinth Slug(例如 advanced-solar-panels)。
''' </summary> ''' </summary>
Public ModrinthSlug As String = Nothing Public ModrinthSlug As String = Nothing
''' <summary>
''' MC 百科的浏览量逆序排行,1 代表浏览量最低。
''' </summary>
Public Popularity As Integer
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & ", Rank " & Popularity
End Function End Function
End Class End Class
@@ -161,9 +166,9 @@
''' </summary> ''' </summary>
Public ReadOnly Website As String Public ReadOnly Website As String
''' <summary> ''' <summary>
''' 最后一次更新的时间。可能为 Nothing。 ''' 最后一次更新的时间。
''' </summary> ''' </summary>
Public ReadOnly LastUpdate As Date? = Nothing Public ReadOnly LastUpdate As Date
''' <summary> ''' <summary>
''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量! ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量!
''' </summary> ''' </summary>
@@ -242,7 +247,7 @@
RawName = Data("RawName") RawName = Data("RawName")
Description = Data("Description") Description = Data("Description")
Website = Data("Website") Website = Data("Website")
If Data.ContainsKey("LastUpdate") Then LastUpdate = Data("LastUpdate") LastUpdate = Data("LastUpdate")
DownloadCount = Data("DownloadCount") DownloadCount = Data("DownloadCount")
If Data.ContainsKey("ModLoaders") Then If Data.ContainsKey("ModLoaders") Then
ModLoaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), CompModLoaderType)).ToList ModLoaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), CompModLoaderType)).ToList
@@ -396,7 +401,7 @@
Slug = Data("slug") Slug = Data("slug")
RawName = Data("title") RawName = Data("title")
Description = Data("description") Description = Data("description")
LastUpdate = Data("date_modified") LastUpdate = If(Data("date_modified"), Data("updated"))
DownloadCount = Data("downloads") DownloadCount = Data("downloads")
LogoUrl = Data("icon_url") LogoUrl = Data("icon_url")
If LogoUrl = "" Then LogoUrl = Nothing If LogoUrl = "" Then LogoUrl = Nothing
@@ -521,7 +526,7 @@
Json("RawName") = RawName Json("RawName") = RawName
Json("Description") = Description Json("Description") = Description
Json("Website") = Website Json("Website") = Website
If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags) Json("Tags") = New JArray(Tags)
@@ -583,10 +588,10 @@
'获取 Mod 加载器描述 '获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders) Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt) If Settings.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
Select Case ModLoadersForDesc.Count Select Case ModLoadersForDesc.Count
Case 0 Case 0
If ModLoaders.Count = 1 Then If ModLoaders.IsSingle Then
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString ModLoaderDescriptionPart = ModLoaders.Single.ToString
Else Else
@@ -601,7 +606,7 @@
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso (NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso (NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then (NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Settings.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意" ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = "" ModLoaderDescriptionPart = ""
Else Else
@@ -614,12 +619,12 @@
Function() Function()
Dim NewItem As New MyCompItem With {.Tag = Me} Dim NewItem As New MyCompItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo) ApplyLogoToMyImage(NewItem.PathLogo)
Dim Title = GetControlTitle(True) Dim Titles = GetControlTitle(True)
NewItem.Title = Title.Key NewItem.Title = Titles.Title
If Title.Value = "" Then If Titles.SubTitle = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw) CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else Else
NewItem.SubTitle = Title.Value NewItem.SubTitle = Titles.SubTitle
End If End If
NewItem.Tags = Tags NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "") NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
@@ -642,14 +647,7 @@
NewItem.LabVersion.Text = ModLoaderDescriptionFull NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth") NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True) NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabDownload.Text = NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿", If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount)) If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
@@ -664,7 +662,7 @@
Img.FallbackSource = DlSourceModGet(LogoUrl) Img.FallbackSource = DlSourceModGet(LogoUrl)
End If End If
End Sub End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String) Public Function GetControlTitle(HasModLoaderDescription As Boolean) As (Title As String, SubTitle As String)
'检查下列代码时可以参考 #1567 的测试例 '检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName Dim Title As String = RawName
Dim SubtitleList As List(Of String) Dim SubtitleList As List(Of String)
@@ -672,18 +670,18 @@
'没有中文翻译 '没有中文翻译
'将所有名称分段 '将所有名称分段
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
If NameLists.Count = 1 Then GoTo NoSubtitle If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记 '查找其中的缩写、Forge/Fabric 等版本标记
SubtitleList = New List(Of String) SubtitleList = New List(Of String)
Dim NormalNameList = New List(Of String) Dim NormalNameList = New List(Of String)
For Each Name In NameLists For Each Name In NameLists
Dim LowerName As String = Name.ToLower Dim LowerName As String = Name.Lower
If Name.ToUpper = Name AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then If Name = Name.Upper AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
'缩写 '缩写
SubtitleList.Add(Name) SubtitleList.Add(Name)
ElseIf (LowerName.Contains("forge") OrElse LowerName.Contains("fabric") OrElse LowerName.Contains("quilt")) AndAlso ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso
Not RegexCheck(LowerName.Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母 Not RegexCheck(LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母
'Forge/Fabric 等版本标记 'Forge/Fabric 等版本标记
SubtitleList.Add(Name) SubtitleList.Add(Name)
Else Else
@@ -698,8 +696,8 @@
Else Else
'有中文翻译 '有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix '尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix '检查时注意 Carpet(它没有中文译名,但有 Suffix)和 “汤姆存储 - 星的奇妙优化 (Tom's balabala)”
Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ") Title = If(TranslatedName.Contains(" ("), TranslatedName.BeforeFirst(" ("), TranslatedName.BeforeLast(" - "))
Dim Suffix As String = "" Dim Suffix As String = ""
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ") If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
Dim EnglishName As String = TranslatedName Dim EnglishName As String = TranslatedName
@@ -709,8 +707,8 @@
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If SubtitleList.Count > 1 AndAlso If SubtitleList.Count > 1 AndAlso
Not SubtitleList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版 Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.ToUpper = SubtitleList.Last) Then '不是缩写 Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.Upper = SubtitleList.Last) Then '不是缩写
SubtitleList = New List(Of String) From {EnglishName} '使用原名 SubtitleList = New List(Of String) From {EnglishName} '使用原名
End If End If
'添加后缀 '添加后缀
@@ -722,25 +720,25 @@
If SubtitleList.Any Then If SubtitleList.Any Then
For Each Ex In SubtitleList For Each Ex In SubtitleList
Dim IsModLoaderDescription As Boolean = Dim IsModLoaderDescription As Boolean =
Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt") Ex.Lower.Contains("neoforge") OrElse Ex.Lower.Contains("forge") OrElse Ex.Lower.Contains("fabric") OrElse Ex.Lower.Contains("quilt")
'是否显示 ModLoader 信息 '是否显示 ModLoader 信息
If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
'去除 “Forge/Fabric” 这一无意义提示 '去除 “Forge/Fabric” 这一无意义提示
If Ex.Length < 16 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For If Ex.Length < 16 AndAlso Ex.Lower.Contains("fabric") AndAlso Ex.Lower.Contains("forge") Then Continue For
'将 “Forge” 等提示改为 “Forge 版” '将 “Forge” 等提示改为 “Forge 版”
If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
Ex.ToLower.Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then Ex.Lower.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版" Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
End If End If
'将 “forge” 等词语的首字母大写 '将 “forge” 等词语的首字母大写
Ex = Ex.Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt") Ex = Ex.Replace("neoforge", "NeoForge").Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
Subtitle &= " | " & Ex.Trim Subtitle &= " | " & Ex.Trim
Next Next
Else Else
NoSubtitle: NoSubtitle:
Subtitle = "" Subtitle = ""
End If End If
Return New KeyValuePair(Of String, String)(Title, Subtitle) Return (Title, Subtitle)
End Function End Function
'辅助函数 '辅助函数
@@ -757,7 +755,7 @@ NoSubtitle:
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r) Result.Append(r)
Next Next
Return Result.ToString.ToLower Return Result.ToString.Lower
End Function End Function
'来自不同的网站 '来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False If FromCurseForge = Project.FromCurseForge Then Return False
@@ -766,8 +764,7 @@ NoSubtitle:
'若不为光影,则要求 MC 版本一致 '若不为光影,则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False If Type <> CompType.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False
'最近更新时间差距在一周以内 '最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 Then Return False
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -842,21 +839,13 @@ NoSubtitle:
''' </summary> ''' </summary>
Public GameVersion As String = Nothing Public GameVersion As String = Nothing
''' <summary> ''' <summary>
''' 搜索的文本内容。 ''' 搜索的初始内容。
''' </summary> ''' </summary>
Public SearchText As String = Nothing Public SearchText As String = Nothing
''' <summary> ''' <summary>
''' 在进行中文搜索时,CurseForge 的替代搜索文本。
''' 由于 CurseForge API 在有任意关键词未匹配的时候就不显示结果,所以不能使用与 Modrinth 相同的算法。
''' </summary>
Public CurseForgeAltSearchText As String = Nothing
''' <summary>
''' 允许的来源。 ''' 允许的来源。
''' </summary> ''' </summary>
Public Source As CompSourceType = CompSourceType.Any Public Source As CompSourceType = CompSourceType.Any
''' <summary>
''' 构造函数。
''' </summary>
Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer) Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer)
Me.Type = Type Me.Type = Type
Me.Storage = Storage Me.Storage = Storage
@@ -866,14 +855,12 @@ NoSubtitle:
'构造请求 '构造请求
''' <summary> ''' <summary>
''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。 ''' 获取对应的 CurseForge API 请求链接。
''' </summary> ''' </summary>
Public Function GetCurseForgeAddress() As String Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0 If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
'应用筛选参数 '应用筛选参数
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}" Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={COMP_PAGE_SIZE}"
Select Case Type Select Case Type
Case CompType.Mod Case CompType.Mod
Address += "&classId=6" Address += "&classId=6"
@@ -887,28 +874,26 @@ NoSubtitle:
Address += "&classId=12" Address += "&classId=12"
End Select End Select
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/") If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If ModLoader <> CompModLoaderType.Any AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(If(CurseForgeAltSearchText, SearchText)) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(If(CurseForgeAltSearchText, SearchText)) If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
Return Address Return Address
End Function End Function
''' <summary> ''' <summary>
''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。 ''' 获取对应的 Modrinth API 请求链接。
''' </summary> ''' </summary>
Public Function GetModrinthAddress() As String Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0 If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
'应用筛选参数 '应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance" Dim Address As String = $"https://api.modrinth.com/v2/search?limit={COMP_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText) If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]] 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String) Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]") Facets.Add($"[""project_type:{GetStringFromEnum(Type).Lower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]") If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If ModLoader <> CompModLoaderType.Any AndAlso Not IgnoreModLoaderFilter Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).Lower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]" Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address Return Address
@@ -928,6 +913,9 @@ NoSubtitle:
Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean
Return Not left = right Return Not left = right
End Operator End Operator
Public Overrides Function GetHashCode() As Integer
Return (Type, Tag, ModLoader, GameVersion, SearchText, Source).GetHashCode()
End Function
End Class End Class
Public Class CompProjectStorage Public Class CompProjectStorage
@@ -955,7 +943,8 @@ NoSubtitle:
'实际的获取 '实际的获取
Private Const CompPageSize = 40 Private Const COMP_PAGE_SIZE = 40
Private Const MSG_NO_CHINESE_SEARCH_RESULT As String = "无搜索结果,请尝试搜索其英文名称"
''' <summary> ''' <summary>
''' 已知工程信息的缓存。 ''' 已知工程信息的缓存。
''' </summary> ''' </summary>
@@ -965,157 +954,156 @@ NoSubtitle:
''' </summary> ''' </summary>
Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer)) Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
Dim Request As CompProjectRequest = Task.Input Dim Request As CompProjectRequest = Task.Input
Dim Storage = Request.Storage '避免多线程问题 Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
If Request.Storage.Results.Count >= Request.TargetResultCount Then #Region "前置检查"
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Comp] 已有 {Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
Return Return
ElseIf Not Request.CanContinue Then ElseIf Not Request.CanContinue Then
If Not Request.Storage.Results.Any() Then If Not Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果") Throw New Exception("没有符合条件的结果")
Else Else
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理") Log($"[Comp] 已有 {Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理")
Return Return
End If End If
End If End If
#Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)" '拒绝 1.13- Quilt(这个版本根本没有 Quilt)
If Request.ModLoader = CompModLoaderType.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then If Request.ModLoader = CompModLoaderType.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion) Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If End If
#End Region #End Region
#Region "处理搜索文本,赋值回 Task.Input.SearchText" #Region "中文搜索"
Dim RawFilter As String = If(Request.SearchText, "").Trim Dim RawSearchText As String = If(Request.SearchText, "").Trim
Request.SearchText = RawFilter RawSearchText = RawSearchText.Lower
RawFilter = RawFilter.ToLower Log("[Comp] 工程列表搜索原始文本:" & RawSearchText)
Log("[Comp] 工程列表搜索原始文本:" & RawFilter)
'中文请求关键字处理 Dim IsChineseSearch As Boolean =
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter) RegexCheck(RawSearchText, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
If IsChineseSearch AndAlso (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) '目前仅对 Mod 和数据包进行中文搜索,注意整合包的名称可能已经有中文了
'构造搜索请求 Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry)) If IsChineseSearch Then
For Each Entry In CompDatabase '帮助方法:从搜索项提取可能的英文单词
SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With { Dim ExtractWords =
Function(Result As SearchEntry(Of CompDatabaseEntry), Source As CompSourceType) As IEnumerable(Of String)
'从各个可能的来源提取候选
Dim Candidates As New List(Of String)
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = CompSourceType.CurseForge Then
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
End If
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = CompSourceType.Modrinth Then
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
End If
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
'分词、清洗、去重
Candidates = Candidates.
SelectMany(Function(c) c.Split(" ")).
Select(Function(w) w.TrimStart("{[(").TrimEnd("}])").Lower).
Where(
Function(w)
If w.Length <= 1 Then Return False '单字或空白
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
If Val(w) > 0 Then Return False '数字
Return True
End Function).Distinct.ToList
'如果一个词可以由其他词拼成,则去掉这个词(例如将 ender io enderio 的 enderio 剔除,只保留 ender io)
Dim CanForm As Func(Of String, Boolean) = Nothing
CanForm = Function(s) Candidates.Contains(s) OrElse Candidates.Any(Function(c) s.StartsWith(c) AndAlso CanForm(s.Substring(c.Length)))
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
Return Candidates
End Function
'CurseForge
If Request.Source.HasFlag(CompSourceType.CurseForge) Then
'数据库搜索
Static CurseForgeSearchEntries As List(Of SearchEntry(Of CompDatabaseEntry)) =
CompDatabase.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of CompDatabaseEntry) With {
.Item = Entry, .Item = Entry,
.SearchSource = New List(Of SearchSource) From { .SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名 New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 0.5) New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
} }).ToList
}) Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
Next If CurseForgeSearchResults.Any Then
Dim SearchResults = Search(SearchEntries, Request.SearchText, 40, 0.2) '选取目标(CurseForge 要求每个词都必须匹配上,所以只能选择一个 Mod 进行搜索)
If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称") Dim CurseForgeTarget =
'提取可能的英文名 If(CurseForgeSearchResults.First.AbsoluteRight,
Dim ExtractWords = CurseForgeSearchResults.Where(Function(s) s.AbsoluteRight).ToList, '优先使用所有完全匹配的
Function(Result As SearchEntry(Of CompDatabaseEntry)) As String() CurseForgeSearchResults.MaxByAll(Function(s) s.Similarity)). '其次使用所有相似度最高的
Dim Word As String = "" MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
If Result.Item.CurseForgeSlug IsNot Nothing Then Word += Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " " '后处理
If Result.Item.ModrinthSlug IsNot Nothing Then Word += Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " " CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, CompSourceType.CurseForge).Join(" ")
Word += Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - "). Log("[Comp] 中文搜索关键词(CurseForge):" & CurseForgeAltSearchText, LogLevel.Debug)
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ").Replace("-", " ") End If
Dim Words = Word.ToLower.Split(" ") End If
Words = Words.Select(Function(w) w.TrimStart("{[(").TrimEnd("}])")).Where( 'Modrinth
Function(w) If Request.Source.HasFlag(CompSourceType.Modrinth) Then
If w.Length <= 1 Then Return False '单字词 '数据库搜索
If {"the", "of", "mod", "and"}.Contains(w) Then Return False '常见词 Static ModrinthSearchEntries As List(Of SearchEntry(Of CompDatabaseEntry)) =
If Val(w) > 0 Then Return False '数字 CompDatabase.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
If w.Split(" ").Count > 3 AndAlso w.Contains("ftb") Then Return False '神秘 FTB Function(Entry) New SearchEntry(Of CompDatabaseEntry) With {
Return True .Item = Entry,
End Function).Distinct.ToArray .SearchSource = New List(Of SearchSource) From {
Return Words New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
End Function New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
If ModrinthSearchResults.Any Then
'分词
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重 Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
For Each Result In SearchResults For Each Result In ModrinthSearchResults
For Each Word In ExtractWords(Result) For Each Word In ExtractWords(Result, CompSourceType.Modrinth)
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(Request.SearchText)), 100000, Result.Similarity) '完全匹配为 100000
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0) If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
WordWeights(Word) += Similarity Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(RawSearchText)), 1000, Result.Similarity) '完全匹配为 1000
WordWeights(Word) += Similarity * Result.Item.Popularity '权重 += 相似度 * 受欢迎程度
Next Next
Next Next
If Not WordWeights.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称") ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
'根据权重选取英文单词 Log("[Comp] 中文搜索关键词(Modrinth):" & ModrinthAltSearchText, LogLevel.Debug)
Dim SortedWords = WordWeights.OrderByDescending(Function(w) w.Value).ToList '直接请求工程
If SortedWords.First.Value >= 100000 Then '如果有完全匹配的,就只选完全匹配的 ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
Request.SearchText = SortedWords.Where(Function(w) w.Value >= 100000).Select(Function(w) w.Key).Join(" ")
Else '否则,CurseForge 选第一个结果,Modrinth 选前 5 个单词
Request.SearchText = SortedWords.Take(5).Select(Function(w) w.Key).Join(" ")
Request.CurseForgeAltSearchText = ExtractWords(SearchResults.First).Join(" ")
Log("[Comp] 中文搜索基础关键词(CurseForge):" & Request.CurseForgeAltSearchText, LogLevel.Developer)
End If End If
Log("[Comp] 中文搜索基础关键词:" & Request.SearchText, LogLevel.Developer)
End If End If
'结束
'最终处理关键字:分割、去重 If String.IsNullOrEmpty(CurseForgeAltSearchText) AndAlso String.IsNullOrEmpty(ModrinthAltSearchText) AndAlso Not ModrinthSlugs.Any Then
Dim ProcessKeywords = Throw New Exception(MSG_NO_CHINESE_SEARCH_RESULT)
Sub(ByRef Text As String)
If Text Is Nothing Then Return
Text = Text.ToLowerInvariant
Dim Words As New List(Of String)
For Each Keyword In Text.Split(" ")
Keyword = Keyword.Trim("["c, "]"c)
If Keyword = "" Then Continue For
If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
Log("[Comp] 已跳过搜索关键词:" & Keyword, LogLevel.Developer)
Continue For
End If End If
Words.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso Not Words.Any() Then
Text = RawFilter '全都被过滤掉了
Else
Text = Join(Words.Distinct.ToList, " ")
End If End If
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod) Task.Progress = 0.05
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Text = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Text = "optifabric"
End Sub
If Request.CurseForgeAltSearchText IsNot Nothing Then
ProcessKeywords(Request.CurseForgeAltSearchText)
Log("[Comp] 工程列表搜索最终文本(CurseForge):" & Request.CurseForgeAltSearchText, LogLevel.Debug)
End If
ProcessKeywords(Request.SearchText)
Log("[Comp] 工程列表搜索最终文本:" & Request.SearchText, LogLevel.Debug)
Task.Progress = 0.1
#End Region #End Region
Dim RealResults As New List(Of CompProject) Dim RealResults As New List(Of CompProject)
Retry: NextPage:
Dim RawResults As New List(Of CompProject) Dim RawResults As New SafeList(Of CompProject)
Dim [Error] As Exception = Nothing
#Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults" #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
Dim CurseForgeThread As Thread = Nothing Dim WorkThreads As New List(Of Thread)
Dim ModrinthThread As Thread = Nothing Dim Errors As New SafeList(Of (Ex As Exception, Source As CompSourceType))
Dim ResultsLock As New Object
'在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏 '在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod '所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140 Dim IgnoreModLoaderFilter = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress()
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Forge '设置回去
Try Try
'启动 CurseForge 线程 'CurseForge 搜索
Dim CurseForgeFailed As Boolean = False If Request.Source.HasFlag(CompSourceType.CurseForge) AndAlso
If CurseForgeUrl IsNot Nothing Then Not (Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset) AndAlso '剩余的未显示的搜索结果不足
CurseForgeThread = RunInNewThread( (Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(CurseForgeAltSearchText))) Then '如果是中文搜索,就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub() Sub()
Try Try
'获取工程列表 '获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl) Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Comp] 开始 CurseForge 搜索:" & CurseForgeUrl)
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl) Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data") For Each JsonEntry As JObject In RequestResult("data")
Dim Project As New CompProject(JsonEntry) Dim Project As New CompProject(JsonEntry)
@@ -1123,71 +1111,91 @@ Retry:
ProjectList.Add(Project) ProjectList.Add(Project)
Next Next
'更新结果 '更新结果
SyncLock ResultsLock ProjectList.ForEach(Sub(p) RawResults.Add(p))
RawResults.AddRange(ProjectList) Storage.CurseForgeOffset += RequestResult("data").Count
End SyncLock
Storage.CurseForgeOffset += ProjectList.Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Log($"[Comp] 从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败") Log(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset Storage.CurseForgeTotal = -1
[Error] = ex Errors.Add((ex, CompSourceType.CurseForge))
CurseForgeFailed = True
End Try End Try
End Sub, "CurseForge Project Request") If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "CurseForge Search"))
End If End If
'启动 Modrinth 线程 'Modrinth 搜索
Dim ModrinthFailed As Boolean = False If Request.Source.HasFlag(CompSourceType.Modrinth) AndAlso
If ModrinthUrl IsNot Nothing Then Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
ModrinthThread = RunInNewThread( (Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(ModrinthAltSearchText))) Then '如果是中文搜索,就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub() Sub()
Try Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl) Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Comp] 开始 Modrinth 搜索:" & ModrinthUrl)
Dim RequestResult As JObject = DlModRequest(ModrinthUrl) Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits") For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New CompProject(JsonEntry)) ProjectList.Add(New CompProject(JsonEntry))
Next Next
'更新结果 '更新结果
SyncLock ResultsLock ProjectList.ForEach(Sub(p) RawResults.Add(p))
For Each Project In ProjectList Storage.ModrinthOffset += RequestResult("hits").Count
RawResults.Add(Project)
Next
End SyncLock
Storage.ModrinthOffset += ProjectList.Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") Log($"[Comp] 从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败") Log(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset Storage.ModrinthTotal = -1
[Error] = ex Errors.Add((ex, CompSourceType.Modrinth))
ModrinthFailed = True
End Try End Try
End Sub, "Modrinth Project Request") If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "Modrinth Search"))
End If
'Modrinth 直接获取工程
If Request.Source.HasFlag(CompSourceType.Modrinth) AndAlso
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
ModrinthSlugs.Any Then '有直接获取的 Slug
WorkThreads.Add(RunInNewThread(
Sub()
Try
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
Log("[Comp] 开始 Modrinth 直接获取:" & ModrinthUrl)
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Log($"[Comp] 从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
Log(ex, "Modrinth 直接获取失败")
Errors.Add((ex, CompSourceType.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "Modrinth Get"))
End If End If
'等待线程结束 '等待线程结束
If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join() For Each Thread In WorkThreads
If Task.IsAborted Then Return '会自动触发 Finally Thread.Join()
If ModrinthThread IsNot Nothing Then ModrinthThread.Join() If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
If Task.IsAborted Then Return Next
'筛除不是 Forge 的 Mod '筛除不是 Forge 的 Mod
If IsOldForgeRequest Then If IgnoreModLoaderFilter Then
RawResults = RawResults.Where(Function(p) Not p.ModLoaders.Any() OrElse p.ModLoaders.Contains(CompModLoaderType.Forge)).ToList RawResults = RawResults.Where(Function(p) Not p.ModLoaders.Any() OrElse p.ModLoaders.Contains(CompModLoaderType.Forge)).ToList
End If End If
'确保存在结果 '确保存在结果
Storage.ErrorMessage = Nothing Storage.ErrorMessage = Nothing
If Not RawResults.Any() Then If Not RawResults.Any() Then
If [Error] IsNot Nothing Then If Errors.Any() Then
Throw [Error] Throw Errors.First.Ex
Else Else
If IsChineseSearch AndAlso Not (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then If IsChineseSearch AndAlso Not (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then
Throw New Exception("没有搜索结果,请尝试使用英文搜索") Throw New Exception(MSG_NO_CHINESE_SEARCH_RESULT)
ElseIf Request.Source = CompSourceType.CurseForge AndAlso Request.Tag.StartsWithF("/") Then ElseIf Request.Source = CompSourceType.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型") Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Request.Source = CompSourceType.Modrinth AndAlso Request.Tag.EndsWithF("/") Then ElseIf Request.Source = CompSourceType.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
@@ -1196,9 +1204,9 @@ Retry:
Throw New Exception("没有搜索结果") Throw New Exception("没有搜索结果")
End If End If
End If End If
ElseIf [Error] IsNot Nothing Then ElseIf Errors.Any() Then
'有结果但是有错误 '有结果但是有错误
If CurseForgeFailed Then If Errors.Any(Function(e) e.Source = CompSourceType.CurseForge) Then
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。" Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
Else Else
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。" Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
@@ -1206,8 +1214,9 @@ Retry:
End If End If
Finally Finally
CurseForgeThread?.Interrupt() For Each Thread In WorkThreads
ModrinthThread?.Interrupt() If Thread.IsAlive Then Thread.Interrupt()
Next
End Try End Try
#End Region #End Region
@@ -1215,9 +1224,8 @@ Retry:
#Region "提取非重复项,存储于 RealResults" #Region "提取非重复项,存储于 RealResults"
'将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同 '将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同
'这样做的话,去重后将优先保留 Modrinth 的内容
RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'RawResults 去重 '去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)) RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
'已有内容去重 '已有内容去重
RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
@@ -1232,9 +1240,9 @@ Retry:
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个") Log($"[Comp] 总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Request.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环 If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试,这时候重试可能导致无限循环
Log("[Comp] 将继续尝试加载下一页") Log("[Comp] 将继续尝试加载下一页")
GoTo Retry GoTo NextPage
Else Else
Log("[Comp] 无法继续加载,将强制结束") Log("[Comp] 无法继续加载,将强制结束")
End If End If
@@ -1258,23 +1266,23 @@ Retry:
Return 1 Return 1
End Select End Select
End Function End Function
If String.IsNullOrEmpty(Request.SearchText) Then If String.IsNullOrEmpty(RawSearchText) Then
'如果没有搜索文本,按下载量将结果排序 '如果没有搜索文本,按下载量将结果排序
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * GetDownloadCountMult(Result)) Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
Next Next
Else Else
'如果有搜索文本,按关联度将结果排序 '如果有搜索文本,按关联度将结果排序
'排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2) '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
Dim Entry As New List(Of SearchEntry(Of CompProject)) Dim SearchEntries As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9) Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From { SearchEntries.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1),
New SearchSource(Result.Description, 0.05)}}) New SearchSource(Result.Description, 0.05)}})
Next Next
Dim SearchResult = Search(Entry, RawFilter, 101, -1) Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
For Each OneResult In SearchResult For Each OneResult In SearchResult
Scores(OneResult.Item) += Scores(OneResult.Item) +=
If(OneResult.AbsoluteRight, 10, OneResult.Similarity) / If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
@@ -1282,7 +1290,7 @@ Retry:
Next Next
End If End If
'根据排序分得出结果并添加 '根据排序分得出结果并添加
If Task.IsAborted Then Throw New ThreadInterruptedException '#8246 If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
Storage.Results.AddRange( Storage.Results.AddRange(
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key)) Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
@@ -1461,16 +1469,16 @@ Retry:
Select(Function(d) d("modId").ToString).ToList Select(Function(d) d("modId").ToString).ToList
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.Lower).ToList
GameVersions = RawVersions. GameVersions = RawVersions.
Where(Function(v) McVersion.IsFormatFit(v)). Where(Function(v) McVersion.IsFormatFit(v)).
Select(Function(v) v.Replace("-snapshot", " 预览版")). Select(Function(v) v.Replace("-snapshot", " 预览版")).
Distinct.ToList Distinct.ToList
If GameVersions.Count > 1 Then If GameVersions.IsSingle Then
GameVersions = GameVersions.ToList
ElseIf GameVersions.Count > 1 Then
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本 If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else Else
GameVersions = New List(Of String) From {"未知版本"} GameVersions = New List(Of String) From {"未知版本"}
End If End If
@@ -1525,15 +1533,15 @@ Retry:
Select(Function(d) d("project_id").ToString).ToList Select(Function(d) d("project_id").ToString).ToList
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.Lower).ToList
GameVersions = RawVersions.Where(Function(v) v.Contains(".")). GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))). Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
Distinct.ToList Distinct.ToList
If GameVersions.Count > 1 Then If GameVersions.IsSingle Then
'无需处理
ElseIf GameVersions.Count > 1 Then
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本 If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else Else
@@ -1594,7 +1602,7 @@ Retry:
If GameVersions.All( If GameVersions.All(
Function(VerName) Function(VerName)
Return Not VerName.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) VerName.ContainsF(s, True)) Return Not VerName.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) VerName.ContainsF(s, True))
End Function) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}") End Function) Then Info.Add($"游戏版本 {GameVersions.Join("、"c)}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0 If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次")) Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If End If
@@ -1605,7 +1613,7 @@ Retry:
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Title, .Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join(",") .Info = Info.Join(","c)
} }
Select Case Status Select Case Status
Case CompFileStatus.Release Case CompFileStatus.Release
@@ -1695,13 +1703,13 @@ Retry:
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置工程信息 '获取前置工程信息
If UndoneDeps.Any Then If UndoneDeps.Any Then
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置:{Join(UndoneDeps, ",")}") Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置:{UndoneDeps.Join(","c)}")
Dim Projects As JArray Dim Projects As JArray
If TargetProject.FromCurseForge Then If TargetProject.FromCurseForge Then
Projects = DlModRequest("https://api.curseforge.com/v1/mods", Projects = DlModRequest("https://api.curseforge.com/v1/mods",
HttpMethod.Post, "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json")("data") HttpMethod.Post, "{""modIds"": [" & UndoneDeps.Join(","c) & "]}", "application/json")("data")
Else Else
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]") Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{UndoneDeps.Join(""",""")}""]")
End If End If
For Each Project In Projects For Each Project In Projects
Dim Unused As New CompProject(Project) '在 New 的时候会添加缓存以便之后读取 Dim Unused As New CompProject(Project) '在 New 的时候会添加缓存以便之后读取
@@ -79,7 +79,7 @@
End Try End Try
Next Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf) Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput) Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput) WriteFile(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray)) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
@@ -113,7 +113,7 @@ Extracted:
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList() For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
Try Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower Dim Ext As String = TargetFile.Extension.Lower
If Ext = ".log" OrElse Ext = ".txt" Then If Ext = ".log" OrElse Ext = ".txt" Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else Else
@@ -147,7 +147,7 @@ Extracted:
DirectFile = Nothing DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))) Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower
Dim TargetType As AnalyzeFileType Dim TargetType As AnalyzeFileType
If MatchName.StartsWithF("hs_err") Then If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr TargetType = AnalyzeFileType.HsErr
@@ -229,7 +229,7 @@ Extracted:
'创建文件名词典 '创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String())) Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).ToLower) = SelectedFile FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key) OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志") Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志")
Next Next
@@ -307,7 +307,7 @@ Extracted:
''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。 ''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
''' </summary> ''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf) If Raw.Length <= HeadLines + TailLines Then Return Raw.Distinct.Join(vbLf)
Dim Lines As New List(Of String) Dim Lines As New List(Of String)
Dim RealHeadLines As Integer = 0, ViewedLines As Integer Dim RealHeadLines As Integer = 0, ViewedLines As Integer
For ViewedLines = 0 To Raw.Length - 1 For ViewedLines = 0 To Raw.Length - 1
@@ -448,7 +448,7 @@ Done:
Else Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因") Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", "")) Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Reason.Value.Join(";"c) & ")", ""))
Next Next
End If End If
End Sub End Sub
@@ -464,7 +464,7 @@ Done:
Else Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}))) CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If End If
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", "")) Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Additional.Join(";"c) & ")", ""))
End Sub End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String) Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional})) AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -623,9 +623,9 @@ Done:
Dim IsMixin As Boolean = MixinAnalyze(LogMc) Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息 '常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf)) If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
@@ -714,18 +714,18 @@ NextStack:
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp", If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes",
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "fabric", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external",
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft", "injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent" "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.Lower) Then Continue For
PossibleWords.Add(Word.Trim) PossibleWords.Add(Word.Trim)
Next Next
Next Next
PossibleWords = PossibleWords.Distinct.ToList PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词") Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", ")) If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", "))
If PossibleWords.Count > 10 Then If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑") Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
Return New List(Of String) Return New List(Of String)
@@ -773,8 +773,8 @@ NextStack:
Dim HintLines As New List(Of String) Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "") Dim RealModString As String = ModString.Lower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For If Not RealModString.Contains(KeyWord.Lower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray)) HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For Exit For
@@ -874,7 +874,7 @@ NextStack:
StartProcess(DirectFile.Value.Key) StartProcess(DirectFile.Value.Key)
Else Else
Dim FilePath As String = PathTemp & "Crash.txt" Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
StartProcess(FilePath) StartProcess(FilePath)
End If End If
End Sub)) End Sub))
@@ -974,35 +974,35 @@ NextStack:
End If End If
Case CrashReason.Mod缺少前置或MC版本错误 Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then If Additional.Any Then
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Additional.Join("\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.堆栈分析发现关键字 Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else Else
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Additional.Join(", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If End If
Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃 Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.确定Mod导致游戏崩溃 Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.ModMixin失败 Case CrashReason.ModMixin失败
If Additional.Count = 0 Then If Additional.Count = 0 Then
Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h") Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
ElseIf Additional.Count = 1 Then ElseIf Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Additional.Join("\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.Mod配置文件导致游戏崩溃 Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then If Additional(1) Is Nothing Then
@@ -1011,25 +1011,25 @@ NextStack:
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
End If End If
Case CrashReason.Mod初始化失败 Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.特定方块导致崩溃 Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h") Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h")
Else Else
Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h") Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
End If End If
Case CrashReason.Mod重复安装 Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。") Results.Add("你重复安装了多个相同的 Mod:\n - " & Additional.Join("\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h") Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If End If
Case CrashReason.特定实体导致崩溃 Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
If Additional.First.Contains("minecraft:player") Then If Additional.First.Contains("minecraft:player") Then
If Additional.First.Contains(" ") Then If Additional.First.Contains(" ") Then
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h") Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
@@ -1040,7 +1040,7 @@ NextStack:
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h") Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
End If End If
Else Else
Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、")}\h") Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、"c)}\h")
End If End If
Case CrashReason.OptiFine与Forge不兼容 Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。") Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
@@ -1077,31 +1077,31 @@ NextStack:
Case CrashReason.Forge安装不完整 Case CrashReason.Forge安装不完整
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h") Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错 Case CrashReason.Fabric报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Mod互不兼容 Case CrashReason.Mod互不兼容
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Mod加载器报错 Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Fabric报错并给出解决方案 Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Forge报错 Case CrashReason.Forge报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
@@ -1113,7 +1113,7 @@ NextStack:
End Select End Select
Next Next
Return Join(Results, "\n\n此外,"). Return Results.Join("\n\n此外,").
Replace("\n", vbCrLf). Replace("\n", vbCrLf).
Replace("\h", ""). Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
@@ -97,7 +97,7 @@
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance) Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug) Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort() Task.Interrupt()
Throw New ThreadInterruptedException Throw New ThreadInterruptedException
End If End If
RealAddress = BackAssetsFile.LocalPath RealAddress = BackAssetsFile.LocalPath
@@ -107,7 +107,7 @@
'检查是否需要更新:每天只更新一次 '检查是否需要更新:每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引,取消") Log("[Download] 无需更新资源文件索引,取消")
Task.Abort() Task.Interrupt()
End If End If
End Sub)) End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
@@ -158,14 +158,14 @@
Public Property AllDrops As List(Of Integer) Public Property AllDrops As List(Of Integer)
Get Get
If _AllDrops Is Nothing Then If _AllDrops Is Nothing Then
_AllDrops = Setup.Get("CacheDrops").ToString. _AllDrops = Settings.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList() Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
End If End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing,以防止反复获取设置尝试初始化 Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing,以防止反复获取设置尝试初始化
End Get End Get
Set(value As List(Of Integer)) Set(value As List(Of Integer))
_AllDrops = value _AllDrops = value
Setup.Set("CacheDrops", value.Join(",")) Settings.Set("CacheDrops", value.Join(","c))
End Set End Set
End Property End Property
Private _AllDrops As List(Of Integer) = Nothing Private _AllDrops As List(Of Integer) = Nothing
@@ -191,7 +191,7 @@
''' </summary> ''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -242,20 +242,20 @@
Dim Version As String Dim Version As String
'快照版 '快照版
Version = Json("latest")("snapshot") Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
Setup.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版 '正式版
Version = Json("latest")("release") Version = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
Setup.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
Setup.Set("ToolUpdateReleaseLast", Version) Settings.Set("ToolUpdateReleaseLast", Version)
Catch ex As Exception Catch ex As Exception
Throw New Exception("Minecraft 官方源版本列表解析失败", ex) Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try End Try
@@ -304,7 +304,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading Case LoadState.Loading
DlClientListLoader.WaitForExit(Id) DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select End Select
'重新查找版本 '重新查找版本
@@ -383,7 +383,7 @@
''' </summary> ''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain) Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -423,7 +423,7 @@
Name(i) = Name(i).Replace("_", " ") Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "), .DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"), .ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
.IsPreview = Name(i).ContainsF("pre", True), .IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0), .Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar", .FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
@@ -489,7 +489,7 @@
''' </summary> ''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain) Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
@@ -638,7 +638,7 @@
Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain) Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain) Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
@@ -849,7 +849,7 @@
VersionName = ApiName.Replace("1.20.1-", "") VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName) Version = New Version("19." & VersionName)
Inherit = "1.20.1" Inherit = "1.20.1"
ElseIf ApiName.StartsWith("0.") Then '0.25w14craftmine.3-beta ElseIf ApiName.StartsWithF("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName VersionName = ApiName
Dim Segments = ApiName.BeforeFirst("-").Split("."c) Dim Segments = ApiName.BeforeFirst("-").Split("."c)
Version = New Version(0, 0, Segments.Last) Version = New Version(0, 0, Segments.Last)
@@ -872,7 +872,7 @@
''' </summary> ''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain) Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -997,7 +997,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain) Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -1031,7 +1031,7 @@
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8, .IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"), .MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"), .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1059,7 +1059,7 @@
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8, .IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"), .MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"), .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1096,7 +1096,7 @@
''' </summary> ''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain) Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1170,7 +1170,7 @@
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Dim McimUrl As String = DlSourceModGet(Url) Dim McimUrl As String = DlSourceModGet(Url)
If McimUrl <> Url Then If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod") Select Case Settings.Get("ToolDownloadMod")
Case 0 Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
@@ -1210,7 +1210,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean Public ReadOnly Property DlSourcePreferMojang As Boolean
Get Get
Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang) Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1224,7 +1224,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get Get
Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang) Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1323,7 +1323,7 @@
If SubLoader.Key.State = LoadState.Finished Then If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功 '检查加载器成功
MainLoader.Output = SubLoader.Key.Output MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Return Return
ElseIf BeforeLoadersAllFailed Then ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器 '此前的加载器全部失败,直接启动后续加载器
@@ -1355,7 +1355,7 @@
End If End If
Next Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Throw ErrorInfo Throw ErrorInfo
End If End If
Exit For Exit For
@@ -1364,15 +1364,15 @@
Thread.Sleep(10) Thread.Sleep(10)
WaitCycle += 1 WaitCycle += 1
'检查父加载器中断 '检查父加载器中断
If MainLoader.IsAborted Then If MainLoader.IsInterrupted Then
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Return Return
End If End If
Loop Loop
End Sub End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer))) Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
For Each Loader In LoaderList For Each Loader In LoaderList
If Loader.Key.State = LoadState.Loading Then Loader.Key.Abort() If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
Next Next
End Sub End Sub
@@ -95,11 +95,11 @@
Try Try
'确定文件存在 '确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava) If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If PathJava.ContainsF("finalshell", True) Then Throw New Exception("不兼容 FinalShell 的 Java") '#8080 If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326 If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe") IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version '运行 -version
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败") If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output) If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试") If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
@@ -124,8 +124,6 @@
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString) If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'#3649:在 64 位系统上禁用 32 位 Java '#3649:在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java") If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'#2249:JRE 17 似乎会导致 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso MajorVersion >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException Catch ex As ApplicationException
Throw ex Throw ex
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
@@ -167,13 +165,13 @@
Public Sub JavaListInit() Public Sub JavaListInit()
JavaList = New List(Of JavaEntry) JavaList = New List(Of JavaEntry)
Try Try
If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then
'不使用缓存 '不使用缓存
Log("[Java] 要求 Java 列表缓存更新") Log("[Java] 要求 Java 列表缓存更新")
Setup.Set("CacheJavaListVersion", JavaListCacheVersion) Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
Else Else
'使用缓存 '使用缓存
For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll")) For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry)) JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next Next
End If End If
@@ -186,7 +184,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback) Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
End Sub End Sub
@@ -234,7 +232,7 @@
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 Java
Dim VersionSelect As String = "" Dim VersionSelect As String = ""
If GameInstance IsNot Nothing Then If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance) VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then If VersionSelect.StartsWithF("{") Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect)) UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -243,22 +241,22 @@
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Instance:=GameInstance) Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try End Try
End If End If
End If End If
'获取全局设置中指定的 Java '获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect"))) UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
UserJava.Check() UserJava.Check()
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Setup.Reset("LaunchArgumentJavaSelect") Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try End Try
End If End If
@@ -277,7 +275,7 @@ RetryGet:
Select Case JavaSearchLoader.State Select Case JavaSearchLoader.State
Case LoadState.Failed Case LoadState.Failed
Throw JavaSearchLoader.Error Throw JavaSearchLoader.Error
Case LoadState.Aborted Case LoadState.Interrupted
Throw New ThreadInterruptedException("Java 搜索加载器已中断") Throw New ThreadInterruptedException("Java 搜索加载器已中断")
End Select End Select
@@ -332,7 +330,7 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right) Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If End If
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "") Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", GameInstance) Then If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗 '直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug) Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -412,9 +410,9 @@ UserPass:
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try Try
'检查强制指定 '检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect") Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
If GameInstance IsNot Nothing Then If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance) Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If End If
If UserSetup <> "" Then If UserSetup <> "" Then
@@ -423,7 +421,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup)) UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java") Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava GoTo NoUserJava
End Try End Try
For Each Java In JavaList For Each Java In JavaList
@@ -438,7 +436,7 @@ NoUserJava:
Return False Return False
Catch ex As Exception Catch ex As Exception
Log(ex, "检查 Java 类别时出错", LogLevel.Feedback) Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Return True Return True
End Try End Try
End Function End Function
@@ -519,19 +517,14 @@ NoUserJava:
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705) If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
JavaSearchFolder(Disk.Name, JavaPreList, False) JavaSearchFolder(Disk.Name, JavaPreList, False)
Next Next
'查找 .jdks 文件夹中的 Java '查找用户文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, True) JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), JavaPreList, False)
'查找 SDKMAN 安装目录中的 Java JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, True) JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
'查找 APPDATA 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
'查找启动器目录中的 Java '查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True) JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java '查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
End If
'若不全为符号链接,则清除符号链接的地址 '若不全为符号链接,则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean) Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -565,7 +558,7 @@ NoUserJava:
#Region "添加玩家手动导入的 Java" #Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll") Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
Try Try
For Each JavaJsonObject In GetJson(ImportedJava) For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject) Dim Entry = JavaEntry.FromJson(JavaJsonObject)
@@ -573,14 +566,14 @@ NoUserJava:
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback) Log(ex, "Java 列表已损坏", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
#End Region #End Region
'确保可用并获取详细信息,转入正式列表 '确保可用并获取详细信息,转入正式列表
Dim NewJavaList As New List(Of JavaEntry) Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794 For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next Next
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter) NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
@@ -590,7 +583,7 @@ NoUserJava:
For Each Java In NewJavaList For Each Java In NewJavaList
AllList.Add(Java.ToJson) AllList.Add(Java.ToJson)
Next Next
Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
JavaList = NewJavaList JavaList = NewJavaList
Catch ex As Exception Catch ex As Exception
@@ -599,7 +592,7 @@ NoUserJava:
End Try End Try
Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java") Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox()) If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox()) If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub End Sub
@@ -672,18 +665,18 @@ Wait:
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹 '查找其下的所有文件夹
'不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121 '不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon", "bin", Static Keywords As String() = {
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net", "java", "jdk", "jre", "env", "环境", "run", "软件", "mc", "dragon", "well", "bin", "sdk", "candidate", "current",
"software", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合", "游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot", "应用", "运行", "前置", "mojang", "官启", "官方", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清", "runtime", "x86", "x64", "arm", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "forge", "fabric",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
"4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).Lower '用于搜索的字符串
If IsFullSearch OrElse If IsFullSearch OrElse
OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source) JavaSearchFolder(FolderInfo, Results, Source)
End If End If
Next Next
@@ -710,7 +703,7 @@ Wait:
}) })
AddHandler JavaDownloadLoader.OnStateChangedThread, AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState) Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug) Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug)
DeleteDirectory(LastJavaBaseDir) DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then ElseIf NewState = LoadState.Finished Then
File diff suppressed because it is too large Load Diff
@@ -5,9 +5,21 @@ Public Module ModMinecraft
#Region "文件夹" #Region "文件夹"
''' <summary> ''' <summary>
''' 当前的 Minecraft 文件夹路径,以“\”结尾。 ''' 当前的 Minecraft 文件夹路径,以 \ 结尾。
''' </summary> ''' </summary>
Public McFolderSelected As String Public Property McFolderSelected As String
Get
If _McFolderSelected Is Nothing Then McFolderSelected = Settings.Get("LaunchFolderSelect") '仅在首次读取时触发
Return _McFolderSelected
End Get
Set(Value As String)
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", Path)
Settings.Set("LaunchFolderSelect", Value.Replace(Path, "$"))
Log("[Minecraft] 当前选择的 Minecraft 文件夹:" & _McFolderSelected)
End Set
End Property
Private _McFolderSelected As String
''' <summary> ''' <summary>
''' 当前的 Minecraft 文件夹列表。 ''' 当前的 Minecraft 文件夹列表。
''' </summary> ''' </summary>
@@ -22,8 +34,8 @@ Public Module ModMinecraft
Public Location As String Public Location As String
Public Type As Types Public Type As Types
Public Enum Types Public Enum Types
Original Vanilla
RenamedOriginal RenamedVanilla
Custom Custom
End Enum End Enum
@@ -50,9 +62,9 @@ Public Module ModMinecraft
'扫描当前文件夹 '扫描当前文件夹
Try Try
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Original}) If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Original}) If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Vanilla})
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "扫描 PCL 所在文件夹中是否有 MC 文件夹失败") Log(ex, "扫描 PCL 所在文件夹中是否有 MC 文件夹失败")
@@ -62,7 +74,7 @@ Public Module ModMinecraft
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\" Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹 If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹 Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Original}) CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
End If End If
#End Region #End Region
@@ -70,54 +82,51 @@ Public Module ModMinecraft
#Region "读取自定义(Custom)文件夹,可能没有结果" #Region "读取自定义(Custom)文件夹,可能没有结果"
'格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径 '格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
For Each Folder As String In Setup.Get("LaunchFolders").Split("|") For Each Folder As String In Settings.Get("LaunchFolders").ToString.Split({"|"c}, StringSplitOptions.RemoveEmptyEntries)
If Folder = "" Then Continue For If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Red) Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Red)
Continue For Continue For
End If End If
Dim Name As String = Folder.Split(">")(0) Dim FolderName As String = Folder.BeforeFirst(">"), FolderPath As String = Folder.AfterFirst(">")
Dim Path As String = Folder.Split(">")(1)
Try Try
CheckPermissionWithException(Path) CheckPermissionWithException(FolderPath)
'若已有该文件夹,则直接重命名;没有则添加 '若已有该文件夹,则直接重命名;没有则添加
Dim Renamed As Boolean = False Dim Renamed As Boolean = False
For Each OriginalFolder As McFolder In CacheMcFolderList For Each OriginalFolder As McFolder In CacheMcFolderList
If OriginalFolder.Location = Path Then If OriginalFolder.Location = FolderPath Then
OriginalFolder.Name = Name OriginalFolder.Name = FolderName
OriginalFolder.Type = McFolder.Types.RenamedOriginal OriginalFolder.Type = McFolder.Types.RenamedVanilla
Renamed = True Renamed = True
End If End If
Next Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Location = Path, .Type = McFolder.Types.Custom}) If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = FolderName, .Location = FolderPath, .Type = McFolder.Types.Custom})
Catch ex As Exception Catch ex As Exception
MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & Path & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True) MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & FolderPath & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
Log(ex, $"无法访问 Minecraft 文件夹 {Path}") Log(ex, $"无法访问 Minecraft 文件夹 {FolderPath}")
End Try End Try
Next Next
'将自定义文件夹情况同步到设置 '将自定义文件夹情况同步到设置
Dim NewSetup As New List(Of String) Dim NewSetup As New List(Of String)
For Each Folder As McFolder In CacheMcFolderList For Each Folder As McFolder In CacheMcFolderList
If Not Folder.Type = McFolder.Types.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Location) If Not Folder.Type = McFolder.Types.Vanilla Then NewSetup.Add(Folder.Name & ">" & Folder.Location)
Next Next
If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
Setup.Set("LaunchFolders", Join(NewSetup, "|")) Settings.Set("LaunchFolders", NewSetup.Join("|"c))
#End Region #End Region
'若没有可用文件夹,则创建 .minecraft '若没有可用文件夹,则创建 .minecraft
If Not CacheMcFolderList.Any() Then If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\") Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Original}) CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If End If
For Each Folder As McFolder In CacheMcFolderList For Each Folder As McFolder In CacheMcFolderList
#Region "更新 launcher_profiles.json"
McFolderLauncherProfilesJsonCreate(Folder.Location) McFolderLauncherProfilesJsonCreate(Folder.Location)
#End Region
Next Next
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 2000)) If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 2000))
'回设 '回设
McFolderList = CacheMcFolderList McFolderList = CacheMcFolderList
@@ -173,30 +182,34 @@ Public Module ModMinecraft
If ReferenceEquals(_McInstanceSelectedLast, value) Then Return If ReferenceEquals(_McInstanceSelectedLast, value) Then Return
_McInstanceSelected = value '由于有可能是 Nothing,导致无法初始化,才得这样弄一圈 _McInstanceSelected = value '由于有可能是 Nothing,导致无法初始化,才得这样弄一圈
_McInstanceSelectedLast = value _McInstanceSelectedLast = value
Settings.MakeInstanceDirty()
'更新 MC 文件夹所选取的 Minecraft 版本
Log("[Launch] 当前选择的 Minecraft 版本:" & If(value?.PathVersion, "无"))
WriteIni(McFolderSelected & "PCL.ini", "Version", If(value?.Name, ""))
If value Is Nothing Then Return If value Is Nothing Then Return
'重置缓存的下载文件夹 '重置缓存的下载文件夹
PageDownloadCompDetail.CachedFolder.Clear() PageDownloadCompDetail.CachedFolder.Clear()
'统一通行证重判 '统一通行证重判
If AniControlEnabled = 0 AndAlso If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerNide", Instance:=value) <> Setup.Get("CacheNideServer") AndAlso Settings.Get("VersionServerNide", Instance:=value) <> Settings.Get("CacheNideServer") AndAlso
Setup.Get("VersionServerLogin", Instance:=value) = 3 Then Settings.Get("VersionServerLogin", Instance:=value) = 3 Then
Setup.Set("CacheNideAccess", "") Settings.Set("CacheNideAccess", "")
Log("[Launch] 服务器改变,要求重新登录统一通行证") Log("[Launch] 服务器改变,要求重新登录统一通行证")
End If End If
If Setup.Get("VersionServerLogin", Instance:=value) = 3 Then If Settings.Get("VersionServerLogin", Instance:=value) = 3 Then
Setup.Set("CacheNideServer", Setup.Get("VersionServerNide", Instance:=value)) Settings.Set("CacheNideServer", Settings.Get("VersionServerNide", Instance:=value))
End If End If
'Authlib-Injector 重判 'Authlib-Injector 重判
If AniControlEnabled = 0 AndAlso If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerAuthServer", Instance:=value) <> Setup.Get("CacheAuthServerServer") AndAlso Settings.Get("VersionServerAuthServer", Instance:=value) <> Settings.Get("CacheAuthServerServer") AndAlso
Setup.Get("VersionServerLogin", Instance:=value) = 4 Then Settings.Get("VersionServerLogin", Instance:=value) = 4 Then
Setup.Set("CacheAuthAccess", "") Settings.Set("CacheAuthAccess", "")
Log("[Launch] 服务器改变,要求重新登录 Authlib-Injector") Log("[Launch] 服务器改变,要求重新登录 Authlib-Injector")
End If End If
If Setup.Get("VersionServerLogin", Instance:=value) = 4 Then If Settings.Get("VersionServerLogin", Instance:=value) = 4 Then
Setup.Set("CacheAuthServerServer", Setup.Get("VersionServerAuthServer", Instance:=value)) Settings.Set("CacheAuthServerServer", Settings.Get("VersionServerAuthServer", Instance:=value))
Setup.Set("CacheAuthServerName", Setup.Get("VersionServerAuthName", Instance:=value)) Settings.Set("CacheAuthServerName", Settings.Get("VersionServerAuthName", Instance:=value))
Setup.Set("CacheAuthServerRegister", Setup.Get("VersionServerAuthRegister", Instance:=value)) Settings.Set("CacheAuthServerRegister", Settings.Get("VersionServerAuthRegister", Instance:=value))
End If End If
End Set End Set
End Property End Property
@@ -212,15 +225,15 @@ Public Module ModMinecraft
''' </summary> ''' </summary>
Public ReadOnly Property PathIndie As String Public ReadOnly Property PathIndie As String
Get Get
If Setup.IsUnset("VersionArgumentIndieV2", Instance:=Me) Then If Not Settings.HasSaved("VersionArgumentIndieV2", Instance:=Me) Then
If Not IsLoaded Then Load() If Not IsLoaded Then Load()
'决定该版本是否应该被隔离 '决定该版本是否应该被隔离
Dim ShouldBeIndie = Dim ShouldBeIndie =
Function() As Boolean Function() As Boolean
'从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭 '从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Instance:=Me) AndAlso Setup.Get("VersionArgumentIndie", Instance:=Me) > 0 Then If Settings.HasSaved("VersionArgumentIndie", Instance:=Me) AndAlso Settings.Get("VersionArgumentIndie", Instance:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化({Name}):从老的版本独立设置中迁移") Log($"[Minecraft] 版本隔离初始化({Name}):从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Instance:=Me) = 1 Return Settings.Get("VersionArgumentIndie", Instance:=Me) = 1
End If End If
'若版本文件夹下包含 mods 或 saves 文件夹,则自动开启版本隔离 '若版本文件夹下包含 mods 或 saves 文件夹,则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(PathVersion & "mods\") Dim ModFolder As New DirectoryInfo(PathVersion & "mods\")
@@ -231,8 +244,8 @@ Public Module ModMinecraft
End If End If
'根据全局的默认设置决定是否隔离 '根据全局的默认设置决定是否隔离
Dim IsRelease As Boolean = State <> McInstanceState.Fool AndAlso State <> McInstanceState.Old AndAlso State <> McInstanceState.Snapshot Dim IsRelease As Boolean = State <> McInstanceState.Fool AndAlso State <> McInstanceState.Old AndAlso State <> McInstanceState.Snapshot
Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Setup.Get("LaunchArgumentIndieV2")})判断,State {GetStringFromEnum(State)},IsRelease {IsRelease},Modable {Modable}") Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Settings.Get("LaunchArgumentIndieV2")})判断,State {GetStringFromEnum(State)},IsRelease {IsRelease},Modable {Modable}")
Select Case Setup.Get("LaunchArgumentIndieV2") Select Case Settings.Get("LaunchArgumentIndieV2")
Case 0 '关闭 Case 0 '关闭
Return False Return False
Case 1 '仅隔离可安装 Mod 的版本 Case 1 '仅隔离可安装 Mod 的版本
@@ -245,9 +258,9 @@ Public Module ModMinecraft
Return True Return True
End Select End Select
End Function End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Instance:=Me) Settings.Set("VersionArgumentIndieV2", ShouldBeIndie(), Instance:=Me)
End If End If
Return If(Setup.Get("VersionArgumentIndieV2", Instance:=Me), PathVersion, McFolderSelected) Return If(Settings.Get("VersionArgumentIndieV2", Instance:=Me), PathVersion, McFolderSelected)
End Get End Get
End Property End Property
@@ -692,7 +705,7 @@ Recheck:
End Try End Try
'确认 Json 可用性 '确认 Json 可用性
Try Try
Dim JsonObjCheck = JsonObject If JsonObject("mainClass") Is Nothing Then Throw New Exception("版本 JSON 中没有 mainClass 项!") '这里也会触发 JsonObject 的 Get 事件
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 JSON 可用性检查失败(" & PathVersion & ")") Log(ex, "版本 JSON 可用性检查失败(" & PathVersion & ")")
JsonText = "" JsonText = ""
@@ -817,8 +830,8 @@ ExitDataLoad:
If State = McInstanceState.Fool Then If State = McInstanceState.Fool Then
Info = GetMcFoolName(Version.VanillaName) Info = GetMcFoolName(Version.VanillaName)
ElseIf State <> McInstanceState.Error Then ElseIf State <> McInstanceState.Error Then
If Setup.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证" If Settings.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证" If Settings.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证"
End If End If
End If End If
'确定版本收藏状态 '确定版本收藏状态
@@ -914,7 +927,7 @@ ExitDataLoad:
End If End If
'Logo 'Logo
Try Try
If Logo.EndsWith("PCL\Logo.png") Then If Logo.EndsWithF("PCL\Logo.png") Then
NewItem.Logo = PathVersion & "PCL\Logo.png" '修复老版本中,存储的自定义 Logo 使用完整路径,导致移动后无法加载的 Bug NewItem.Logo = PathVersion & "PCL\Logo.png" '修复老版本中,存储的自定义 Logo 使用完整路径,导致移动后无法加载的 Bug
Else Else
NewItem.Logo = Logo NewItem.Logo = Logo
@@ -1012,7 +1025,7 @@ ExitDataLoad:
Get Get
If String.IsNullOrEmpty(OptiFine) OrElse OptiFine = "未知版本" Then Return 0 If String.IsNullOrEmpty(OptiFine) OrElse OptiFine = "未知版本" Then Return 0
'字母编号,如 G2 中的 G(7) '字母编号,如 G2 中的 G(7)
Dim Result As Integer = Asc(OptiFine.ToUpper.First) - Asc("A"c) + 1 Dim Result As Integer = Asc(OptiFine.Upper.First) - Asc("A"c) + 1
'末尾数字,如 C5 beta4 中的 5 '末尾数字,如 C5 beta4 中的 5
Result *= 100 Result *= 100
Result += Val(RegexSeek(Right(OptiFine, OptiFine.Length - 1), "[0-9]+")) Result += Val(RegexSeek(Right(OptiFine, OptiFine.Length - 1), "[0-9]+"))
@@ -1023,7 +1036,7 @@ ExitDataLoad:
If Val(Right(OptiFine, 1)) = 0 AndAlso Right(OptiFine, 1) <> "0" Then If Val(Right(OptiFine, 1)) = 0 AndAlso Right(OptiFine, 1) <> "0" Then
Result += 1 '为 pre 或 beta 结尾,视作 1 Result += 1 '为 pre 或 beta 结尾,视作 1
Else Else
Result += Val(RegexSeek(OptiFine.ToLower, "(?<=((pre)|(beta)))[0-9]+")) Result += Val(RegexSeek(OptiFine.Lower, "(?<=((pre)|(beta)))[0-9]+"))
End If End If
Else Else
Result += 99 Result += 99
@@ -1145,7 +1158,7 @@ ExitDataLoad:
''' 根据版本名获取对应的愚人节版本描述。非愚人节版本会返回空字符串。 ''' 根据版本名获取对应的愚人节版本描述。非愚人节版本会返回空字符串。
''' </summary> ''' </summary>
Public Function GetMcFoolName(Name As String) As String Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower Name = Name.Lower
If Name.StartsWithF("2.0") Then If Name.StartsWithF("2.0") Then
Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!" Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name = "15w14a" Then ElseIf Name = "15w14a" Then
@@ -1216,7 +1229,7 @@ ExitDataLoad:
GoTo OnLoaded GoTo OnLoaded
End If End If
'有可用版本 '有可用版本
Dim FolderListCheck As Integer = GetHash(McInstanceCacheVersion & "#" & Join(FolderList.ToArray, "#")) Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码 Dim FolderListCheck As Integer = GetHash(McInstanceCacheVersion & "#" & FolderList.Join("#"c)) Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
'可以使用缓存 '可以使用缓存
Dim Result = InitMcInstanceListWithCache(PathMc) Dim Result = InitMcInstanceListWithCache(PathMc)
@@ -1237,7 +1250,7 @@ Reload:
'改变当前选择的版本 '改变当前选择的版本
OnLoaded: OnLoaded:
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
'尝试读取已储存的选择 '尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version") Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
@@ -1247,7 +1260,6 @@ OnLoaded:
If Instance.Name = SavedSelection AndAlso Not Instance.State = McInstanceState.Error Then If Instance.Name = SavedSelection AndAlso Not Instance.State = McInstanceState.Error Then
'使用已储存的选择 '使用已储存的选择
McInstanceSelected = Instance McInstanceSelected = Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
Log("[Minecraft] 选择该文件夹储存的 Minecraft 版本:" & McInstanceSelected.PathVersion) Log("[Minecraft] 选择该文件夹储存的 Minecraft 版本:" & McInstanceSelected.PathVersion)
Return Return
End If End If
@@ -1257,18 +1269,16 @@ OnLoaded:
If Not McInstanceList.First.Value(0).State = McInstanceState.Error Then If Not McInstanceList.First.Value(0).State = McInstanceState.Error Then
'自动选择第一项 '自动选择第一项
McInstanceSelected = McInstanceList.First.Value(0) McInstanceSelected = McInstanceList.First.Value(0)
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & McInstanceSelected.PathVersion) Log("[Launch] 自动选择 Minecraft 版本:" & McInstanceSelected.PathVersion)
End If End If
Else Else
McInstanceSelected = Nothing McInstanceSelected = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Minecraft] 未找到可用 Minecraft 版本") Log("[Minecraft] 未找到可用 Minecraft 版本")
End If End If
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000)) If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Catch ex As Exception Catch ex As Exception
If Loader.IsAborted Then Return '#5617 If Loader.IsInterrupted Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载 WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback) Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
End Try End Try
@@ -1642,9 +1652,9 @@ OnLoaded:
Case "Mojang", "Ms" Case "Mojang", "Ms"
Url = "https://sessionserver.mojang.com/session/minecraft/profile/" Url = "https://sessionserver.mojang.com/session/minecraft/profile/"
Case "Nide" Case "Nide"
Url = "https://auth.mc-user.com:233/" & If(McInstanceSelected Is Nothing, Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/" Url = "https://auth.mc-user.com:233/" & If(McInstanceSelected Is Nothing, Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Case "Auth" Case "Auth"
Url = If(McInstanceSelected Is Nothing, Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/" Url = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Case Else Case Else
Throw New ArgumentException("皮肤地址种类无效:" & If(Type, "null")) Throw New ArgumentException("皮肤地址种类无效:" & If(Type, "null"))
End Select End Select
@@ -1665,7 +1675,7 @@ OnLoaded:
Throw New Exception("皮肤返回值中不包含皮肤数据项,可能是未设置自定义皮肤的用户", ex) Throw New Exception("皮肤返回值中不包含皮肤数据项,可能是未设置自定义皮肤的用户", ex)
End Try End Try
SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue)) SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue))
Dim SkinJson As JObject = GetJson(SkinString.ToLower) Dim SkinJson As JObject = GetJson(SkinString.Lower)
If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
Throw New Exception("用户未设置自定义皮肤") Throw New Exception("用户未设置自定义皮肤")
Else Else
@@ -1689,7 +1699,7 @@ OnLoaded:
If Not File.Exists(FileAddress) Then If Not File.Exists(FileAddress) Then
NetDownloadByClient(Address, FileAddress & ".PCLDownloading") NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
File.Delete(FileAddress) File.Delete(FileAddress)
FileSystem.Rename(FileAddress & ".PCLDownloading", FileAddress) File.Move(FileAddress & ".PCLDownloading", FileAddress)
Log("[Minecraft] 皮肤下载成功:" & FileAddress) Log("[Minecraft] 皮肤下载成功:" & FileAddress)
End If End If
Return FileAddress Return FileAddress
@@ -1763,7 +1773,7 @@ OnLoaded:
If OriginalName Is Nothing Then Return Nothing If OriginalName Is Nothing Then Return Nothing
Dim Splited As New List(Of String)(OriginalName.Split(":")) Dim Splited As New List(Of String)(OriginalName.Split(":"))
Splited.RemoveAt(2) 'Java 的此格式下版本号固定为第三段,第四段可能包含架构、分包等其他信息 Splited.RemoveAt(2) 'Java 的此格式下版本号固定为第三段,第四段可能包含架构、分包等其他信息
Return Join(Splited, ":") Return Splited.Join(":"c)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -2009,12 +2019,12 @@ OnLoaded:
Result.AddRange(McLibNetFilesFromTokens(McLibListGet(Instance, False))) Result.AddRange(McLibNetFilesFromTokens(McLibListGet(Instance, False)))
'统一通行证文件 '统一通行证文件
If Setup.Get("VersionServerLogin", Instance:=Instance) = 3 Then If Settings.Get("VersionServerLogin", Instance:=Instance) = 3 Then
Dim TargetFile As String = PathAppdata & "nide8auth.jar" Dim TargetFile As String = PathPure & "nide8auth.jar"
Try Try
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/ '测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
Log("[Minecraft] 开始获取统一通行证下载信息") Log("[Minecraft] 开始获取统一通行证下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Instance:=Instance), RequireJson:=True)) Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get("VersionServerNide", Instance:=Instance), RequireJson:=True))
Result.Add(New NetFile( Result.Add(New NetFile(
Urls:={"https://login.mc-user.com:233/index/jar"}, Urls:={"https://login.mc-user.com:233/index/jar"},
LocalPath:=TargetFile, LocalPath:=TargetFile,
@@ -2029,7 +2039,7 @@ OnLoaded:
End If End If
'Authlib-Injector 文件 'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Instance:=Instance) = 4 Then If Settings.Get("VersionServerLogin", Instance:=Instance) = 4 Then
Dim TargetFile = PathPure & "authlib-injector.jar" Dim TargetFile = PathPure & "authlib-injector.jar"
Try Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
@@ -2143,7 +2153,7 @@ OnLoaded:
''' 检查设置,是否应当忽略文件检查? ''' 检查设置,是否应当忽略文件检查?
''' </summary> ''' </summary>
Public Function ShouldIgnoreFileCheck(Instance As McInstance) Public Function ShouldIgnoreFileCheck(Instance As McInstance)
Return Setup.Get("VersionAdvanceAssetsV2", Instance:=Instance) OrElse (Setup.Get("VersionAdvanceAssets", Instance:=Instance) = 2) Return Settings.Get("VersionAdvanceAssetsV2", Instance:=Instance) OrElse (Settings.Get("VersionAdvanceAssets", Instance:=Instance) = 2)
End Function End Function
#End Region #End Region
@@ -2366,8 +2376,8 @@ OnLoaded:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0 If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1 If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If End If
Left = Left.ToLowerInvariant Left = Left.Lower
Right = Right.ToLowerInvariant Right = Right.Lower
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+") Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+") Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim i As Integer = 0 Dim i As Integer = 0
@@ -1,7 +1,7 @@
Imports System.IO.Compression Imports System.IO.Compression
Public Module ModMod Public Module ModMod
Private Const LocalModCacheVersion As Integer = 11 Private Const LocalModCacheVersion As Integer = 12
Public Class McMod Public Class McMod
@@ -79,7 +79,7 @@ Public Module ModMod
End Get End Get
Set(value As String) Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value _Name = value
End If End If
End Set End Set
@@ -98,7 +98,7 @@ Public Module ModMod
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf) _Description = value.ToString.Trim(vbLf)
'优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号 '优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号
If _Description.ToLower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "." If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If End If
End Set End Set
End Property End Property
@@ -252,10 +252,10 @@ GotFabric:
End If End If
Loop Loop
End If End If
Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf) Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型 '布尔型
Value = (RawValue.ToLower = "true") Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then ElseIf Val(RawValue).ToString = RawValue Then
'数字型 '数字型
Value = Val(RawValue) Value = Val(RawValue)
@@ -424,7 +424,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property CanUpdate As Boolean Public ReadOnly Property CanUpdate As Boolean
Get Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get End Get
End Property End Property
@@ -526,7 +526,7 @@ Finished:
''' 是否可能为前置 Mod。目前非常不准确。 ''' 是否可能为前置 Mod。目前非常不准确。
''' </summary> ''' </summary>
Public Function IsPresetMod() As Boolean Public Function IsPresetMod() As Boolean
Return DisplayName IsNot Nothing AndAlso (DisplayName.ToLower.Contains("core") OrElse DisplayName.ToLower.Contains("lib")) Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
End Function End Function
''' <summary> ''' <summary>
@@ -534,7 +534,7 @@ Finished:
''' </summary> ''' </summary>
Public Shared Function IsModFile(Path As String) Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower Path = Path.Lower
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
@@ -555,7 +555,7 @@ Finished:
Try Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Thread.Sleep(100) Thread.Sleep(100)
Loop Loop
Finally Finally
@@ -567,9 +567,9 @@ Finished:
'获取 Mod 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo) Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then If Directory.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.ToLower Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input) For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then If File.DirectoryName.Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod '仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
@@ -602,7 +602,7 @@ Finished:
'加载 Mod 列表 '加载 Mod 列表
Dim ModList As New List(Of McMod) Dim ModList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList For Each ModFile As FileInfo In ModFileList
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Dim ModEntry As New McMod(ModFile.FullName) Dim ModEntry As New McMod(ModFile.FullName)
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件,名称相同,但一个启用一个禁用 Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件,名称相同,但一个启用一个禁用
If DumpMod IsNot Nothing Then If DumpMod IsNot Nothing Then
@@ -622,7 +622,7 @@ Finished:
ModList = ModList.OrderBy(Function(m) m.FileName).ToList ModList = ModList.OrderBy(Function(m) m.FileName).ToList
'回设 '回设
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Loader.Output = ModList Loader.Output = ModList
'开始联网加载 '开始联网加载
@@ -641,7 +641,7 @@ Finished:
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存,获取需要更新的 Mod 列表 '读取 Comp 缓存,获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("") Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey)) ModEntry.FromJson(Cache(CacheKey))
@@ -691,7 +691,7 @@ Finished:
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号 Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If End If
Next Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return If Not ModrinthMapping.Any() Then Return
@@ -707,7 +707,7 @@ Finished:
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post, Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json") ""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod) Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -740,7 +740,7 @@ Finished:
Dim CurseForgeHashes As New List(Of UInteger) Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash) CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post, Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches") $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
@@ -761,7 +761,7 @@ Finished:
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next Next
Next Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Return If Not CurseForgeMapping.Any() Then Return
@@ -781,7 +781,7 @@ Finished:
Entry.Comp = Project Entry.Comp = Project
Next Next
'查找或许版本更新的文件列表 '查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer) Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
@@ -844,7 +844,7 @@ Finished:
'等待线程结束 '等待线程结束
Do Until EndedThreadCount = 2 Do Until EndedThreadCount = 2
Thread.Sleep(10) Thread.Sleep(10)
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Loop Loop
'保存缓存 '保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -856,7 +856,7 @@ Finished:
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏 '刷新边栏
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677) RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else Else
@@ -200,7 +200,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {}) For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then If Id.StartsWithF("forge-") Then
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!") If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
@@ -250,7 +250,7 @@ Retry:
'获取 Mod 下载信息 '获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray)) Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json")("data") Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
'如果文件已被删除,则 API 会跳过那一项 '如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题") If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -369,7 +369,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {}) For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower Select Case Entry.Name.Lower
Case "minecraft" Case "minecraft"
MinecraftVersion = Entry.Value.ToString MinecraftVersion = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0 Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
@@ -584,7 +584,7 @@ Retry:
If Not Line.Contains("=") Then Continue For If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("=")) Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next Next
WriteFile(MMCSetupFile, Join(Lines, vbCrLf)) WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
'读取文件 '读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand") Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
@@ -621,7 +621,7 @@ Retry:
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs) Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
Else Else
JvmArgs += " " & Setup.Get("LaunchAdvanceJvm") JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs) Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
End If End If
@@ -33,13 +33,13 @@
HasRunningMinecraft = False HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh() FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放 '音乐播放
If Setup.Get("UiMusicStop") Then If Settings.Get("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放")) RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放"))
ElseIf Setup.Get("UiMusicStart") Then ElseIf Settings.Get("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放")) RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放"))
End If End If
'启动器可见性 '启动器可见性
Select Case Setup.Get("LaunchArgumentVisible") Select Case Settings.Get("LaunchArgumentVisible")
Case 2 Case 2
'直接关闭 '直接关闭
If TriggerLauncherShutdown Then If TriggerLauncherShutdown Then
@@ -91,7 +91,7 @@
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
TimerWindow() TimerWindow()
TimerLog() TimerLog()
'设置窗口标题 '设置窗口标题
@@ -277,7 +277,7 @@
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})") WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True IsWindowFinished = True
'最大化 '最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then If Settings.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
+4 -4
View File
@@ -302,7 +302,7 @@ Public Class CustomEvent
Case EventType.修改设置, EventType.写入设置 Case EventType.修改设置, EventType.写入设置
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400") If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
Setup.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected) Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green) If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.修改变量, EventType.写入变量 Case EventType.修改变量, EventType.写入变量
@@ -369,7 +369,7 @@ Public Class CustomEvent
End Try End Try
RelativeUrl = LocalTemp RelativeUrl = LocalTemp
End If End If
RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\") RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
'确认实际路径 '确认实际路径
Dim Location As String, WorkingDir As String = Path & "PCL" Dim Location As String, WorkingDir As String = Path & "PCL"
@@ -408,12 +408,12 @@ Public Class CustomEvent
''' 弹出安全确认弹窗。返回是否继续执行。 ''' 弹出安全确认弹窗。返回是否继续执行。
''' </summary> ''' </summary>
Private Shared Function EventSafetyConfirm(Message As String) As Boolean Private Shared Function EventSafetyConfirm(Message As String) As Boolean
If Setup.Get("HintCustomCommand") Then Return True If Settings.Get("HintCustomCommand") Then Return True
Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消") Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 1 Case 1
Return True Return True
Case 2 Case 2
Setup.Set("HintCustomCommand", True) Settings.Set("HintCustomCommand", True)
Return True Return True
Case Else Case Else
Return False Return False
+54 -39
View File
@@ -512,7 +512,7 @@ EndHint:
EventData = If(JsonData("EventData"), "") EventData = If(JsonData("EventData"), "")
IsEvent = True IsEvent = True
Else Else
Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml") Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
If File.Exists(XamlAddress) Then If File.Exists(XamlAddress) Then
XamlContent = ReadFile(XamlAddress) XamlContent = ReadFile(XamlAddress)
IsEvent = False IsEvent = False
@@ -579,7 +579,7 @@ EndHint:
'读取自定义文件 '读取自定义文件
If Directory.Exists(Path & "PCL\Help\") Then If Directory.Exists(Path & "PCL\Help\") Then
For Each File In EnumerateFiles(Path & "PCL\Help\") For Each File In EnumerateFiles(Path & "PCL\Help\")
Select Case File.Extension.ToLower Select Case File.Extension.Lower
Case ".helpignore" Case ".helpignore"
'加载忽略列表 '加载忽略列表
Log("[Help] 发现 .helpignore 文件:" & File.FullName) Log("[Help] 发现 .helpignore 文件:" & File.FullName)
@@ -598,7 +598,7 @@ EndHint:
'读取自带文件 '读取自带文件
For Each File In EnumerateFiles(PathTemp & "Help") For Each File In EnumerateFiles(PathTemp & "Help")
'跳过非 json 文件与以 . 开头的文件夹 '跳过非 json 文件与以 . 开头的文件夹
If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For If File.Extension.Lower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
'检查忽略列表 '检查忽略列表
Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "") Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
For Each Ignore In IgnoreList For Each Ignore In IgnoreList
@@ -614,7 +614,7 @@ NextFile:
Catch ex As Exception Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox) Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
End Try End Try
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
'将文件实例化 '将文件实例化
Dim Dict As New List(Of HelpEntry) Dim Dict As New List(Of HelpEntry)
@@ -630,7 +630,7 @@ NextFile:
'回设 '回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏") If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Loader.Output = Dict Loader.Output = Dict
Catch ex As Exception Catch ex As Exception
@@ -643,12 +643,12 @@ NextFile:
''' 尝试解压内置帮助文件。 ''' 尝试解压内置帮助文件。
''' </summary> ''' </summary>
Public Sub HelpTryExtract() Public Sub HelpTryExtract()
If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help") DeleteDirectory(PathTemp & "Help")
Directory.CreateDirectory(PathTemp & "Help") Directory.CreateDirectory(PathTemp & "Help")
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help")) WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help") ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Setup.Set("SystemHelpVersion", VersionCode) Settings.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug) Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
End If End If
End Sub End Sub
@@ -657,11 +657,19 @@ NextFile:
#Region "愚人节" #Region "愚人节"
Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1 Private _IsAprilEnabled As Boolean? = Nothing
Public ReadOnly Property IsAprilEnabled As Boolean
Get
If _IsAprilEnabled Is Nothing Then
_IsAprilEnabled =
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
Settings.Get("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
End If
Return _IsAprilEnabled.Value
End Get
End Property
Public IsAprilGiveup As Boolean = False Public IsAprilGiveup As Boolean = False
Private AprilSpeed As New Vector(0, 0) Private AprilDifficultiedDistance As Integer = 0
Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
Private AprilDistance As Integer = 0
Private Sub TimerFool() Private Sub TimerFool()
Try Try
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
@@ -669,11 +677,13 @@ NextFile:
'计算是否空闲 '计算是否空闲
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain) Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
If MousePos = AprilMousePosLast Then Static IdieCount As Integer = 0
AprilIdieCount += 1 Static MousePosLast As New Point(0, 0)
If MousePos = MousePosLast Then
IdieCount += 1
Else Else
AprilMousePosLast = MousePos MousePosLast = MousePos
AprilIdieCount = 0 IdieCount = 0
End If End If
'计算躲避移动 '计算躲避移动
Dim Direction As Vector Dim Direction As Vector
@@ -685,9 +695,11 @@ NextFile:
Direction = -Dir Direction = -Dir
Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI) Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度 Dim Difficulty As Double = 1 / (1 + (AprilDifficultiedDistance / 6000) ^ 2) + 0.25 '难度,初始为 1.25x,6000 距离为 0.75x,12000 为 0.5x,24000 为 0.256x,最低 0.25x
'计算回归移动 Dim Acc = Math.Max(0, -0.65 - Math.Log((Distance / Difficulty + 0.4) / 200)) * Direction * Difficulty '加速度
If AprilIdieCount >= 64 * 5 Then 'FrmMain.Title = CInt(AprilTotalDistance) & " - " & Difficulty
'5s 不动时回到起始点
If IdieCount >= 64 * 5 Then
Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3) Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y) Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
@@ -697,10 +709,11 @@ NextFile:
End If End If
End If End If
'回到边界 '回到边界
Static Speed As New Vector(0, 0)
Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm) Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
If Relative.X < -ButtonWidth * 2 Then If Relative.X < -ButtonWidth * 2 Then
FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界 FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
AprilSpeed.X -= 80 Speed.X -= 80
If Relative.Y < 0 Then If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5 FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -708,7 +721,7 @@ NextFile:
End If End If
ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界 FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
AprilSpeed.X += 80 Speed.X += 80
If Relative.Y < 0 Then If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5 FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -716,7 +729,7 @@ NextFile:
End If End If
ElseIf Relative.Y < -ButtonHeight * 2 Then ElseIf Relative.Y < -ButtonHeight * 2 Then
FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界 FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
AprilSpeed.Y -= 25 Speed.Y -= 25
If Relative.X < 0 Then If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2 FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -724,7 +737,7 @@ NextFile:
End If End If
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界 FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
AprilSpeed.Y += 25 Speed.Y += 25
If Relative.X < 0 Then If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2 FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -732,29 +745,31 @@ NextFile:
End If End If
End If End If
'移动 '移动
AprilSpeed = AprilSpeed * 0.8 + Acc Speed = Speed * 0.8 + Acc
Dim SpeedValue = Math.Min(60, AprilSpeed.Length) Dim SpeedValue = Math.Min(60, Speed.Length)
If SpeedValue < 0.01 Then Return If SpeedValue < 0.01 Then Return
AprilSpeed.Normalize() Speed.Normalize()
AprilSpeed *= SpeedValue Speed *= SpeedValue
AprilDistance += SpeedValue AprilDifficultiedDistance += SpeedValue
FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X FrmLaunchLeft.AprilPosTrans.X += Speed.X
FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
'大小改变 '大小改变
FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8) FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8) FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
'放弃提示 '放弃提示
If AprilDistance > 4000 Then Static GiveUpDistance As Double = -1500
AprilDistance = -4000 GiveUpDistance += SpeedValue
If GiveUpDistance > 2500 Then
GiveUpDistance = 0
Select Case RandomInteger(0, 3) Select Case RandomInteger(0, 3)
Case 0 Case 0
Hint("放弃吧!只需要点一下右下角的小白旗……") Hint("放弃吧!只需要点一下右下角的小白旗……", HintType.Red)
Case 1 Case 1
Hint("看到右下角的那面小白旗了吗?") Hint("看到右下角的那面小白旗了吗?", HintType.Red)
Case 2 Case 2
Hint("这里建议点一下右下角的小白旗投降呢.jpg") Hint("这里建议点一下右下角的小白旗投降呢.jpg", HintType.Red)
Case 3 Case 3
Hint("右下角的小白旗永远等着你……") Hint("右下角的小白旗永远等着你……", HintType.Red)
End Select End Select
End If End If
@@ -843,7 +858,7 @@ NextFile:
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion)) Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie)) Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name)) Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.ToLower) Then If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.Lower) Then
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name)) Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
Else Else
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName)) Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
@@ -857,7 +872,7 @@ NextFile:
'登录信息 '登录信息
If McLoginLoader.State = LoadState.Finished Then If McLoginLoader.State = LoadState.Finished Then
Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name)) Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.ToLower)) Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.Lower))
Select Case McLoginLoader.Input.Type Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy Case McLoginType.Legacy
Text = Text.Replace("{login}", Replacer("离线")) Text = Text.Replace("{login}", Replacer("离线"))
@@ -876,7 +891,7 @@ NextFile:
'高级 '高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint())) Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave())) 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, McInstanceSelected))) Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value))) 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))) Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text Return Text
@@ -971,7 +986,7 @@ NextFile:
Timer150Count = 0 Timer150Count = 0
Try Try
#Region "每 7.5s 执行一次的代码" #Region "每 7.5s 执行一次的代码"
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble() If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDifficultiedDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
'以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745 '以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
RunInUi( RunInUi(
Sub() Sub()
+6 -6
View File
@@ -24,13 +24,13 @@
Directory.CreateDirectory(Path & "PCL\Musics\") Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In EnumerateFiles(Path & "PCL\Musics\") For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的 '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Ext As String = File.Extension.ToLower Dim Ext As String = File.Extension.Lower
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName) MusicAllList.Add(File.FullName)
Next Next
End If End If
'打乱顺序播放 '打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList)) MusicWaitingList = If(Settings.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后 '若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
@@ -129,7 +129,7 @@
''' 播放下一曲,并显示提示文本。 ''' 播放下一曲,并显示提示文本。
''' </summary> ''' </summary>
Public Sub MusicControlNext() Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then If MusicAllList.IsSingle Then
MusicStartPlay(MusicCurrent) MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Green) Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Green)
Else Else
@@ -289,14 +289,14 @@
CurrentWave.Init(Reader) CurrentWave.Init(Reader)
CurrentWave.Play() CurrentWave.Play()
'第一次打开的暂停 '第一次打开的暂停
If IsFirstLoad AndAlso Not Setup.Get("UiMusicAuto") Then CurrentWave.Pause() If IsFirstLoad AndAlso Not Settings.Get("UiMusicAuto") Then CurrentWave.Pause()
MusicRefreshUI() MusicRefreshUI()
'停止条件:播放完毕或变化 '停止条件:播放完毕或变化
Dim PreviousVolume = 0 Dim PreviousVolume = 0
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped
If Setup.Get("UiMusicVolume") <> PreviousVolume Then If Settings.Get("UiMusicVolume") <> PreviousVolume Then
'更新音量 '更新音量
PreviousVolume = Setup.Get("UiMusicVolume") PreviousVolume = Settings.Get("UiMusicVolume")
CurrentWave.Volume = PreviousVolume / 1000 CurrentWave.Volume = PreviousVolume / 1000
End If End If
'更新进度条 '更新进度条
+1 -21
View File
@@ -62,26 +62,6 @@ Friend Module ModSecret
Return "0000-0000-0000-0000" Return "0000-0000-0000-0000"
End Function End Function
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Instance:=McInstanceSelected)
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(PageInstanceSetup.GetRam(McInstanceSelected) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & "m")
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
'为 Java 7 及更早版本自动添加永久代内存参数
If McLaunchJavaSelected.MajorVersion <= 7 Then
If Not DataList.Any(Function(d) d.Contains("-XX:PermSize=") OrElse d.Contains("-XX:MaxPermSize=")) Then
DataList.Add("-XX:PermSize=256m")
DataList.Add("-XX:MaxPermSize=512m")
McLaunchLog("检测到 Java " & McLaunchJavaSelected.MajorVersion & ",已自动添加永久代内存参数")
Else
McLaunchLog("检测到 Java " & McLaunchJavaSelected.MajorVersion & ",用户已自定义永久代参数,跳过自动添加")
End If
End If
End Sub
#End Region #End Region
#Region "网络鉴权" #Region "网络鉴权"
@@ -240,7 +220,7 @@ Friend Module ModSecret
FrmMain.PanTitle.Background = Brush FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze() FrmMain.PanTitle.Background.Freeze()
'主页面背景 '主页面背景
If Setup.Get("UiBackgroundColorful") Then If Settings.Get("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)} Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.3.0")> <Assembly: AssemblyVersion("2.12.4.0")>
<Assembly: AssemblyFileVersion("2.12.3.0")> <Assembly: AssemblyFileVersion("2.12.4.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -32,7 +32,7 @@
<local:MyComboBoxItem Content="Modrinth" Tag="2" /> <local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <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:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.11" /> <local:MyComboBoxItem Content="1.21.11" />
<local:MyComboBoxItem Content="1.21.1" /> <local:MyComboBoxItem Content="1.21.1" />
@@ -45,7 +45,7 @@
<local:MyComboBoxItem Content="1.8.9" /> <local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" /> <local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox> </local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0"> <local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" /> <local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" /> <local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" /> <local:MyComboBoxItem Content="NeoForge" Tag="6" />
@@ -53,7 +53,7 @@
<local:MyComboBoxItem Content="Quilt" Tag="5" /> <local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320" /> <local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
</Grid> </Grid>
<Grid Margin="0,4,0,6" Height="35"> <Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -87,7 +87,7 @@
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50"> <local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" /> <local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" ShowProgress="True" />
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
</local:MyScrollViewer> </local:MyScrollViewer>
@@ -8,7 +8,7 @@
Sub(Task) Sub(Task)
LoadTargetFromAdditional() LoadTargetFromAdditional()
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge) Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
Task.Output = Result Task.Output = Result
End Sub) End Sub)
@@ -171,7 +171,7 @@ GroupDone:
Version.Type = CompType.Mod AndAlso '是 Mod Version.Type = CompType.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的 McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For If Loader = CompModLoaderType.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ") If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
Next Next
End If End If
@@ -303,7 +303,7 @@ GroupDone:
Select Case MyLoader.State Select Case MyLoader.State
Case LoadState.Failed Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red) Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消!", HintType.Blue) Hint(MyLoader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
Return '不重新加载版本列表 Return '不重新加载版本列表
@@ -442,7 +442,7 @@ GroupDone:
Else Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - "). Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":") Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Setup.Get("ToolDownloadTranslateV2") Select Case Settings.Get("ToolDownloadTranslateV2")
Case 0 Case 0
FileName = $"【{ChineseName}】{File.FileName}" FileName = $"【{ChineseName}】{File.FileName}"
Case 1 Case 1
@@ -463,8 +463,8 @@ GroupDone:
Target = SelectSaveFile("选择保存位置", FileName, Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" & Desc & "文件|" &
If(File.Type = CompType.Mod, If(File.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"), If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return If Not Target.Contains("\") Then Return
'构造步骤加载器 '构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " " Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
@@ -2,15 +2,6 @@
Public Module ModDownloadLib Public Module ModDownloadLib
''' <summary>
''' 如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败。
''' </summary>
Private InstallSyncLock As New Object
''' <summary>
''' 如果 OptiFine 与 Forge 同时复制原版 Jar,就会导致复制文件时冲突。
''' </summary>
Private VanillaSyncLock As New Object
#Region "Minecraft 下载" #Region "Minecraft 下载"
''' <summary> ''' <summary>
@@ -239,7 +230,7 @@ Public Module ModDownloadLib
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red) Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完 Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Abort() Task.Interrupt()
Return Return
End If End If
Dim JarUrl As String = Instance.JsonObject("downloads")("server")("url") Dim JarUrl As String = Instance.JsonObject("downloads")("server")("url")
@@ -327,7 +318,7 @@ pause"
''' <param name="InstanceJson">在 version_manifest.json 中的对应项。</param> ''' <param name="InstanceJson">在 version_manifest.json 中的对应项。</param>
Public Sub McUpdateLogShow(InstanceJson As JToken) Public Sub McUpdateLogShow(InstanceJson As JToken)
Dim WikiName As String Dim WikiName As String
Dim Id As String = InstanceJson("id").ToString.ToLower Dim Id As String = InstanceJson("id").ToString.Lower
If Id = "3d shareware v1.34" Then If Id = "3d shareware v1.34" Then
WikiName = "3D_Shareware_v1.34" WikiName = "3D_Shareware_v1.34"
ElseIf Id = "2.0" Then ElseIf Id = "2.0" Then
@@ -420,21 +411,21 @@ pause"
Dim JavaLoader = GetJavaDownloadLoader() Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(17, IsForceRestart:=True) JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
Finally Finally
JavaLoader.Abort() '确保取消时中止 Java 下载 JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try End Try
'检查下载结果 '检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。") If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If End If
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Else Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer" Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
@@ -478,7 +469,7 @@ pause"
Log(ex, "读取 OptiFine 安装器信息失败") Log(ex, "读取 OptiFine 安装器信息失败")
End Try End Try
Try Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装") Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
@@ -502,7 +493,7 @@ pause"
Log(ex, "读取 OptiFine 安装器错误信息失败") Log(ex, "读取 OptiFine 安装器错误信息失败")
End Try End Try
Try Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装") Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
@@ -584,11 +575,11 @@ pause"
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成") If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
'拷贝原版文件 '拷贝原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
@@ -1095,21 +1086,21 @@ Retry:
Dim JavaLoader = GetJavaDownloadLoader() Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(17, IsForceRestart:=True) JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
Finally Finally
JavaLoader.Abort() '确保取消时中止 Java 下载 JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try End Try
'检查下载结果 '检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。") If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If End If
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
@@ -1146,7 +1137,7 @@ Retry:
Log(ex, $"读取 {LoaderName} 安装器信息失败") Log(ex, $"读取 {LoaderName} 安装器信息失败")
End Try End Try
Try Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装") Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
@@ -1169,7 +1160,7 @@ Retry:
Log(ex, $"读取 {LoaderName} 安装器错误信息失败") Log(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try End Try
Try Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装") Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
@@ -1190,7 +1181,7 @@ Retry:
process.Dispose() process.Dispose()
'检查是否安装成功:最后 5 行中是否有 true(true 可能在倒数数行,见 #832) '检查是否安装成功:最后 5 行中是否有 true(true 可能在倒数数行,见 #832)
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(Join(LastResults, vbCrLf)) Log(LastResults.Join(vbCrLf))
Dim LastLines As String = "" Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行 For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
LastLines &= vbCrLf & LastResults(i) LastLines &= vbCrLf & LastResults(i)
@@ -1353,8 +1344,8 @@ Retry:
Task.Progress = 0.8 Task.Progress = 0.8
'去除其中的原始 Forgelike 项 '去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug) Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
@@ -1390,11 +1381,11 @@ Retry:
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList() Where(Function(l) l.State <> LoadState.Finished).ToList()
If TargetLoaders.Any Then Log($"[Download] {LoaderName} 安装正在等待原版文件下载完成") If TargetLoaders.Any Then Log($"[Download] {LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
'拷贝原版文件 '拷贝原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
@@ -1541,7 +1532,7 @@ Retry:
Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'如果只有一个版本,则不特别列出 '如果只有一个版本,则不特别列出
If Entries.Count = 1 Then Return If Entries.IsSingle Then Return
'获取推荐版本与最新版本 '获取推荐版本与最新版本
Dim FreshVersion As DlForgeVersionEntry = Nothing Dim FreshVersion As DlForgeVersionEntry = Nothing
If Entries.Any Then If Entries.Any Then
@@ -1662,7 +1653,7 @@ Retry:
Next Next
If RecommendedList.Count < 5 Then Throw New Exception("获取的推荐版本数过少(" & Result & ")") If RecommendedList.Count < 5 Then Throw New Exception("获取的推荐版本数过少(" & Result & ")")
'保存 '保存
Dim CacheJson As String = "{" & Join(RecommendedList, ",") & "}" Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
WriteFile(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson) WriteFile(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功") Log("[Download] 刷新 Forge 推荐版本缓存成功")
Catch ex As Exception Catch ex As Exception
@@ -1698,7 +1689,7 @@ Retry:
Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlNeoForgeListEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlNeoForgeListEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'如果只有一个版本,则不特别列出 '如果只有一个版本,则不特别列出
If Entries.Count = 1 Then Return If Entries.IsSingle Then Return
'获取最新稳定版和测试版 '获取最新稳定版和测试版
Dim FreshStableVersion As DlNeoForgeListEntry = Nothing Dim FreshStableVersion As DlNeoForgeListEntry = Nothing
Dim FreshBetaVersion As DlNeoForgeListEntry = Nothing Dim FreshBetaVersion As DlNeoForgeListEntry = Nothing
@@ -1901,7 +1892,7 @@ Retry:
Return New MyVirtualizingElement(Of MyListItem)( Return New MyVirtualizingElement(Of MyListItem)(
Function() Function()
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.DisplayName.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/OptiFabric.png" .Logo = PathImage & "Blocks/OptiFabric.png"
} }
@@ -1999,7 +1990,7 @@ Retry:
Hint(Loader.Name & "成功!", HintType.Green) Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
End Select End Select
End Sub End Sub
@@ -2013,7 +2004,7 @@ Retry:
Hint(Loader.Name & "成功!", HintType.Green) Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
Return '不重新加载版本列表 Return '不重新加载版本列表
@@ -2024,7 +2015,7 @@ Retry:
Public Sub McInstallFailedClearFolder(Loader) Public Sub McInstallFailedClearFolder(Loader)
Try Try
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装) Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装)
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Aborted Then If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Interrupted Then
'删除版本文件夹 '删除版本文件夹
If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then
Log("[Download] 由于版本已被独立启动,不清理版本文件夹:" & Loader.Input, LogLevel.Developer) Log("[Download] 由于版本已被独立启动,不清理版本文件夹:" & Loader.Input, LogLevel.Developer)
@@ -2317,7 +2308,7 @@ Retry:
SplitArguments.Add(RawArguments(i)) SplitArguments.Add(RawArguments(i))
End If End If
Next Next
Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ") Dim RealArguments As String = SplitArguments.Distinct.Join(" ")
'合并 '合并
'相关讨论见 #2801 '相关讨论见 #2801
OutputJson = MinecraftJson OutputJson = MinecraftJson
@@ -2372,4 +2363,47 @@ Retry:
#End Region #End Region
''' <summary>
''' 如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败。
''' </summary>
Private InstallSyncLock As New Object
''' <summary>
''' 如果 OptiFine 与 Forge 同时复制原版 JAR,就会导致复制文件时冲突。
''' </summary>
Private VanillaSyncLock As New Object
''' <summary>
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = PathPure & "JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
Try
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex As Exception
If File.Exists(WrapperPath) Then
'因为未知原因 Java Wrapper 可能变为只读文件(#4243)
Log(ex, "Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
Try
File.Delete(WrapperPath)
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex2 As Exception
Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
WrapperPath = PathPure & "JavaWrapper2.jar"
Try
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex3 As Exception
Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
End Try
End Try
Else
Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
End If
End Try
End SyncLock
Return WrapperPath
End Function
End Module End Module
@@ -322,7 +322,7 @@
Else Else
BtnOptiFabricClear.Visibility = Visibility.Visible BtnOptiFabricClear.Visibility = Visibility.Visible
ImgOptiFabric.Visibility = Visibility.Visible ImgOptiFabric.Visibility = Visibility.Visible
LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v") LabOptiFabric.Text = SelectedOptiFabric.DisplayName.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Foreground = ColorGray1 LabOptiFabric.Foreground = ColorGray1
End If End If
End If End If
@@ -456,16 +456,16 @@
Case "snapshot" Case "snapshot"
Type = "预览版" Type = "预览版"
'Mojang 误分类 'Mojang 误分类
If Version("id").ToString.StartsWith("1.") AndAlso If Version("id").ToString.StartsWithF("1.") AndAlso
Not Version("id").ToString.ToLower.Contains("combat") AndAlso Not Version("id").ToString.Lower.Contains("combat") AndAlso
Not Version("id").ToString.ToLower.Contains("rc") AndAlso Not Version("id").ToString.Lower.Contains("rc") AndAlso
Not Version("id").ToString.ToLower.Contains("experimental") AndAlso Not Version("id").ToString.Lower.Contains("experimental") AndAlso
Not Version("id").ToString.ToLower.Contains("pre") Then Not Version("id").ToString.Lower.Contains("pre") Then
Type = "正式版" Type = "正式版"
Version("type") = "release" Version("type") = "release"
End If End If
'愚人节版本 '愚人节版本
Select Case Version("id").ToString.ToLower Select Case Version("id").ToString.Lower
Case "20w14infinite", "20w14∞" Case "20w14infinite", "20w14∞"
Type = "愚人节版" Type = "愚人节版"
Version("id") = "20w14∞" Version("id") = "20w14∞"
@@ -566,7 +566,7 @@
Dim HasAny As Boolean = False Dim HasAny As Boolean = False
Dim HasRequiredVersion As Boolean = False Dim HasRequiredVersion As Boolean = False
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.DisplayName.StartsWith(VanillaName & " ") Then Continue For '不是同一个大版本 If Not OptiFineVersion.DisplayName.StartsWithF(VanillaName & " ") Then Continue For '不是同一个大版本
HasAny = True HasAny = True
If SelectedForge Is Nothing Then Return Nothing '未选择 Forge If SelectedForge Is Nothing Then Return Nothing '未选择 Forge
If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用 If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用
@@ -609,7 +609,7 @@
Dim Versions As New List(Of DlOptiFineListEntry) Dim Versions As New List(Of DlOptiFineListEntry)
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.DisplayName.StartsWith(VanillaName & " ") Then Versions.Add(Version) If Version.DisplayName.StartsWithF(VanillaName & " ") Then Versions.Add(Version)
Next Next
If Not Versions.Any() Then Return If Not Versions.Any() Then Return
'排序 '排序
@@ -915,8 +915,8 @@
Dim FabricApiName = FabricApi.DisplayName Dim FabricApiName = FabricApi.DisplayName
Try Try
If FabricApiName Is Nothing OrElse VanillaName Is Nothing Then Return False If FabricApiName Is Nothing OrElse VanillaName Is Nothing Then Return False
FabricApiName = FabricApiName.ToLower : VanillaName = VanillaName.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").ToLower FabricApiName = FabricApiName.Lower : VanillaName = VanillaName.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").Lower
If FabricApiName.StartsWith("[" & VanillaName & "]") Then Return True If FabricApiName.StartsWithF("[" & VanillaName & "]") Then Return True
If Not FabricApiName.Contains("/") OrElse Not FabricApiName.Contains("]") Then Return False If Not FabricApiName.Contains("/") OrElse Not FabricApiName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a) '直接的判断(例如 1.18.1/22w03a)
For Each Part As String In FabricApiName.BeforeFirst("]").TrimStart("[").Split("/") For Each Part As String In FabricApiName.BeforeFirst("]").TrimStart("[").Split("/")
@@ -980,7 +980,7 @@
Dim Versions As New List(Of CompFile) Dim Versions As New List(Of CompFile)
For Each Version In DlFabricApiLoader.Output For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then If IsFabricApiCompatible(Version) Then
If Not Version.DisplayName.StartsWith("[") Then If Not Version.DisplayName.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.DisplayName, LogLevel.Debug) Log("[Download] 已特判修改 Fabric API 显示名:" & Version.DisplayName, LogLevel.Debug)
Version.DisplayName = "[" & VanillaName & "] " & Version.DisplayName Version.DisplayName = "[" & VanillaName & "] " & Version.DisplayName
End If End If
@@ -1122,7 +1122,7 @@
Private Sub BtnStart_Click() Handles BtnStart.Click Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离 '确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndieV2") = 0 OrElse Setup.Get("LaunchArgumentIndieV2") = 2) Then (Settings.Get("LaunchArgumentIndieV2") = 0 OrElse Settings.Get("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离,多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf & If MyMsgBox("你尚未开启版本隔离,多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此,游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & "因此,游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then "推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
@@ -313,8 +313,8 @@ Public Class MyLocalModItem
Shortened = True Shortened = True
Next Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-") CurrentName = CurrentSegs.Join("-")
NewestName = Join(NewestSegs, "-") NewestName = NewestSegs.Join("-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号 Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If End If
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})" Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
@@ -323,7 +323,7 @@ Public Class MyLocalModItem
'懒加载 '懒加载
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
OnFirstEnterScrollViewerViewport(AddressOf FirstEnterScrollViewerViewport) LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf FirstEnterScrollViewerViewport)
End Sub End Sub
Private HasEnteredViewport As Boolean = False Private HasEnteredViewport As Boolean = False
Private Sub FirstEnterScrollViewerViewport() Private Sub FirstEnterScrollViewerViewport()
@@ -347,7 +347,7 @@ Public Class MyLocalModItem
DescFileName = GetFileNameFromPath(Entry.Path) DescFileName = GetFileNameFromPath(Entry.Path)
End If End If
Dim NewDescription As String Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then If Settings.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名 '标题显示文件名,详情显示译名
'标题 '标题
Title = DescFileName Title = DescFileName
@@ -357,7 +357,7 @@ Public Class MyLocalModItem
NewDescription = Entry.DisplayName NewDescription = Entry.DisplayName
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value NewDescription = Titles.Title & Titles.SubTitle
End If End If
NewDescription = NewDescription.Replace(" | ", " / ") NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})" If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
@@ -369,8 +369,8 @@ Public Class MyLocalModItem
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key Title = Titles.Title
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version) SubTitle = Titles.SubTitle & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If End If
'描述 '描述
NewDescription = DescFileName NewDescription = DescFileName
@@ -305,9 +305,9 @@ Public Class PageInstanceExport
'保存配置文件 '保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Setup.Get("CacheExportConfig")) Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String) Dim ConfigLines As New List(Of String)
'ini 段 'ini 段
ConfigLines.Add("Name:" & TextExportName.Text) ConfigLines.Add("Name:" & TextExportName.Text)
@@ -351,9 +351,9 @@ Public Class PageInstanceExport
'读取配置文件 '读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click Private Sub ImportConfig() Handles BtnAdvancedImport.Click
Try Try
Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Setup.Get("CacheExportConfig")) Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator) Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
'ini 段 'ini 段
Dim Ini As New Dictionary(Of String, String) Dim Ini As New Dictionary(Of String, String)
@@ -485,7 +485,7 @@ Public Class PageInstanceExport
'检查规则 '检查规则
Dim ShouldKeep As Boolean = False Dim ShouldKeep As Boolean = False
For Each Rule In AllRules For Each Rule In AllRules
Dim Revert = Rule.StartsWith("!") Dim Revert = Rule.StartsWithF("!")
If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
Next Next
If Not ShouldKeep Then Continue For If Not ShouldKeep Then Continue For
@@ -493,7 +493,7 @@ Public Class PageInstanceExport
CopyFile(Entry.FullName, TargetPath) CopyFile(Entry.FullName, TargetPath)
'若为压缩包,考虑联网获取路径 '若为压缩包,考虑联网获取路径
If CheckHostedAssets AndAlso If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.ToLower) AndAlso {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
{"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
Dim ModFile As New McMod(TargetPath) Dim ModFile As New McMod(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash Dim Unused = ModFile.ModrinthHash '提前计算 Hash
@@ -617,7 +617,7 @@ Public Class PageInstanceExport
'等待线程结束 '等待线程结束
Do Until EndedThreadCount = 2 Do Until EndedThreadCount = 2
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
@@ -305,7 +305,7 @@
''' 返回输入的文件是否为一个 Mod 文件,仅用于判断拖拽行为。 ''' 返回输入的文件是否为一个 Mod 文件,仅用于判断拖拽行为。
''' </summary> ''' </summary>
Public Shared Function InstallMods(FilePathList As IEnumerable(Of String)) As Boolean Public Shared Function InstallMods(FilePathList As IEnumerable(Of String)) As Boolean
Dim Extension As String = FilePathList.First.AfterLast(".").ToLower Dim Extension As String = FilePathList.First.AfterLast(".").Lower
'检查文件扩展名 '检查文件扩展名
If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装") Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
@@ -322,7 +322,7 @@
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!") Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod) Then ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod) Then
'未处于 Mod 管理页面 '未处于 Mod 管理页面
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {Instance.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install If MyMsgBox($"是否要将这{If(FilePathList.IsSingle, "个", "些")}文件作为 Mod 安装到 {Instance.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else Else
'处于 Mod 管理页面 '处于 Mod 管理页面
Install: Install:
@@ -332,7 +332,7 @@ Install:
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227 If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName) CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next Next
If FilePathList.Count = 1 Then If FilePathList.IsSingle Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green) Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green)
Else Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green) Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green)
@@ -503,7 +503,7 @@ Install:
End If End If
End If End If
File.Delete(NewPath) File.Delete(NewPath)
FileSystem.Rename(ModEntity.Path, NewPath) File.Move(ModEntity.Path, NewPath)
Catch ex As FileNotFoundException Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback) Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback)
ReloadModList(True) ReloadModList(True)
@@ -556,9 +556,9 @@ Install:
Public Shared UpdatingInstanceModFolders As New List(Of String) Public Shared UpdatingInstanceModFolders As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod)) Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
'更新前警告 '更新前警告
If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then If Not Settings.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod,这可能导致游戏崩溃,甚至永久损坏存档!{vbCrLf}如果你在游玩整合包,请千万不要自行更新 Mod!{vbCrLf}{vbCrLf}在更新前,请先备份存档,并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题,你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险,继续更新", "取消", IsWarn:=True) = 1 Then If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod,这可能导致游戏崩溃,甚至永久损坏存档!{vbCrLf}如果你在游玩整合包,请千万不要自行更新 Mod!{vbCrLf}{vbCrLf}在更新前,请先备份存档,并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题,你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险,继续更新", "取消", IsWarn:=True) = 1 Then
Setup.Set("HintUpdateMod", True) Settings.Set("HintUpdateMod", True)
Else Else
Return Return
End If End If
@@ -592,8 +592,8 @@ Install:
Shortened = True Shortened = True
Loop Loop
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentReplaceName = Join(CurrentSegs, "-") CurrentReplaceName = CurrentSegs.Join("-")
NewestReplaceName = Join(NewestSegs, "-") NewestReplaceName = NewestSegs.Join("-")
End If End If
'添加到下载列表 '添加到下载列表
Dim TempAddress As String = PathTemp & "mods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹,以便重复文件检查时识别 Dim TempAddress As String = PathTemp & "mods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹,以便重复文件检查时识别
@@ -649,7 +649,7 @@ Install:
End Select End Select
Case LoadState.Failed Case LoadState.Failed
Hint("Mod 更新失败:" & Loader.Error.GetBrief(), HintType.Red) Hint("Mod 更新失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint("Mod 更新已中止!", HintType.Blue) Hint("Mod 更新已中止!", HintType.Blue)
Case Else Case Else
Return Return
@@ -737,13 +737,13 @@ Install:
'显示结果提示 '显示结果提示
If Not IsSuccessful Then Return If Not IsSuccessful Then Return
If IsShiftPressed Then If IsShiftPressed Then
If ModList.Count = 1 Then If ModList.IsSingle Then
Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Green) Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Green)
Else Else
Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Green) Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Green)
End If End If
Else Else
If ModList.Count = 1 Then If ModList.IsSingle Then
Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Green) Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Green)
Else Else
Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Green) Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Green)
@@ -797,8 +797,8 @@ Install:
Dim ModOriginalName As String = ModEntry.DisplayName.Replace(" ", "+") Dim ModOriginalName As String = ModEntry.DisplayName.Replace(" ", "+")
Dim ModSearchName As String = ModOriginalName.Substring(0, 1) Dim ModSearchName As String = ModOriginalName.Substring(0, 1)
For i = 1 To ModOriginalName.Count - 1 For i = 1 To ModOriginalName.Count - 1
Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.ToLower.Equals(ModOriginalName(i - 1).ToString) Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.Lower.Equals(ModOriginalName(i - 1).ToString)
Dim IsCurrentLower As Boolean = ModOriginalName(i).ToString.ToLower.Equals(ModOriginalName(i).ToString) Dim IsCurrentLower As Boolean = ModOriginalName(i).ToString.Lower.Equals(ModOriginalName(i).ToString)
If IsLastLower AndAlso Not IsCurrentLower Then If IsLastLower AndAlso Not IsCurrentLower Then
'上一个字母为小写,这一个字母为大写 '上一个字母为小写,这一个字母为大写
ModSearchName += "+" ModSearchName += "+"
@@ -807,7 +807,7 @@ Install:
Next Next
ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine") ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine")
'百科搜索链接 '百科搜索链接
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.DisplayName, "百科搜索", "返回") = 1 Then If MyMsgBox(ContentLines.Join(vbCrLf), ModEntry.DisplayName, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End If End If
End If End If
@@ -9,7 +9,7 @@
End Sub End Sub
Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded
Dim NewVisibility = If((Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible) Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible)
If BtnDownload.Visibility <> NewVisibility Then If BtnDownload.Visibility <> NewVisibility Then
BtnDownload.Visibility = NewVisibility BtnDownload.Visibility = NewVisibility
PanMain.TriggerForceResize() PanMain.TriggerForceResize()
@@ -39,7 +39,7 @@
Dim LogoCustom As Boolean = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", "False") Dim LogoCustom As Boolean = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", "False")
If LogoCustom Then If LogoCustom Then
For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items
If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWith("PCL\Logo.png")) Then If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWithF("PCL\Logo.png")) Then
ComboDisplayLogo.SelectedItem = Selection ComboDisplayLogo.SelectedItem = Selection
Exit For Exit For
End If End If
@@ -71,12 +71,12 @@
Else Else
'改为隐藏 '改为隐藏
Try Try
If Not Setup.Get("HintHide") Then If Not Settings.Get("HintHide") Then
If MyMsgBox("确认要从版本列表中隐藏该版本吗?隐藏该版本后,它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后,在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then If MyMsgBox("确认要从版本列表中隐藏该版本吗?隐藏该版本后,它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后,在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then
ComboDisplayType.SelectedIndex = 0 ComboDisplayType.SelectedIndex = 0
Return Return
End If End If
Setup.Set("HintHide", True) Settings.Set("HintHide", True)
End If End If
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Hidden) WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Hidden)
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
@@ -115,7 +115,7 @@
'获取临时中间名,以防止仅修改大小写的重命名失败 '获取临时中间名,以防止仅修改大小写的重命名失败
Dim TempName As String = NewName & "_temp" Dim TempName As String = NewName & "_temp"
Dim TempPath As String = McFolderSelected & "versions\" & TempName & "\" Dim TempPath As String = McFolderSelected & "versions\" & TempName & "\"
Dim OnlyChangedCase As Boolean = NewName.ToLower = OldName.ToLower Dim OnlyChangedCase As Boolean = NewName.Lower = OldName.Lower
'重新读取版本 JSON 信息,避免 JsonObject 中已被合并的项被重新存储 '重新读取版本 JSON 信息,避免 JsonObject 中已被合并的项被重新存储
Dim JsonObject As JObject Dim JsonObject As JObject
Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath() Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
@@ -126,8 +126,8 @@
JsonObject = PageInstanceLeft.Instance.JsonObject JsonObject = PageInstanceLeft.Instance.JsonObject
End Try End Try
'重命名主文件夹 '重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName) Directory.Move(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName) Directory.Move(TempPath, NewName)
'清理 ini 缓存 '清理 ini 缓存
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt") IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini") IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
@@ -135,20 +135,20 @@
'不能进行遍历重命名,否则在版本名很短的时候容易误伤其他文件(#6443) '不能进行遍历重命名,否则在版本名很短的时候容易误伤其他文件(#6443)
If Directory.Exists($"{NewPath}{OldName}-natives") Then If Directory.Exists($"{NewPath}{OldName}-natives") Then
If OnlyChangedCase Then If OnlyChangedCase Then
My.Computer.FileSystem.RenameDirectory($"{NewPath}{OldName}-natives", $"{OldName}natives_temp") Directory.Move($"{NewPath}{OldName}-natives", $"{OldName}natives_temp")
My.Computer.FileSystem.RenameDirectory($"{NewPath}{OldName}-natives_temp", $"{NewName}-natives") Directory.Move($"{NewPath}{OldName}-natives_temp", $"{NewName}-natives")
Else Else
DeleteDirectory($"{NewPath}{NewName}-natives") DeleteDirectory($"{NewPath}{NewName}-natives")
My.Computer.FileSystem.RenameDirectory($"{NewPath}{OldName}-natives", $"{NewName}-natives") Directory.Move($"{NewPath}{OldName}-natives", $"{NewName}-natives")
End If End If
End If End If
If File.Exists($"{NewPath}{OldName}.jar") Then If File.Exists($"{NewPath}{OldName}.jar") Then
If OnlyChangedCase Then If OnlyChangedCase Then
My.Computer.FileSystem.RenameFile($"{NewPath}{OldName}.jar", $"{OldName}_temp.jar") File.Move($"{NewPath}{OldName}.jar", $"{OldName}_temp.jar")
My.Computer.FileSystem.RenameFile($"{NewPath}{OldName}_temp.jar", $"{NewName}.jar") File.Move($"{NewPath}{OldName}_temp.jar", $"{NewName}.jar")
Else Else
File.Delete($"{NewPath}{NewName}.jar") File.Delete($"{NewPath}{NewName}.jar")
My.Computer.FileSystem.RenameFile($"{NewPath}{OldName}.jar", $"{NewName}.jar") File.Move($"{NewPath}{OldName}.jar", $"{NewName}.jar")
End If End If
End If End If
'替换版本设置文件中的路径 '替换版本设置文件中的路径
@@ -267,7 +267,7 @@
End If End If
'生成脚本 '生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then
If Setup.Get("LoginType") = McLoginType.Legacy Then If Settings.Get("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……") Hint("正在导出启动脚本……")
Else Else
Hint("正在导出启动脚本……(注意,使用脚本启动可能会导致登录失效!)") Hint("正在导出启动脚本……(注意,使用脚本启动可能会导致登录失效!)")
@@ -301,7 +301,7 @@
Hint(Loader.Name & "成功!", HintType.Green) Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
End Select End Select
End Sub End Sub
@@ -48,7 +48,7 @@
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
<TextBlock VerticalAlignment="Center" Grid.Row="6" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="6" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="6" Grid.Column="1" MaxDropDownHeight="240" <local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="6" Grid.Column="1"
ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它"> ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" /> <ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />--> <!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
@@ -216,16 +216,18 @@
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数" Margin="0,0,25,0" /> <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;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#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 VerticalAlignment="Center" Grid.Row="4" HorizontalAlignment="Left" Text="内存管理" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="4" HorizontalAlignment="Left" Text="内存管理" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboAdvanceGC" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionAdvanceGC" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="VersionAdvanceGC" Grid.Row="4" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="跟随全局设置" IsSelected="True" /> <local:MyComboBoxItem Content="跟随全局设置" />
<local:MyComboBoxItem Content="尽量使用 ZGC(激进)" <local:MyComboBoxItem Content="尽量使用 ZGC"
ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC。&#xa;在 Java 25+ 额外添加 -XX:+UseCompactObjectHeaders。&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC。&#xa;ZGC 的内存占用比 G1GC 更高,不过在回收内存时不会导致卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="尽量使用分代 ZGC(平衡)" <local:MyComboBoxItem Content="尽量使用分代 ZGC"
ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20- 使用 G1GC。&#xa;在 Java 25+ 额外添加 -XX:+UseCompactObjectHeaders。&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20- 使用 G1GC。&#xa;ZGC 的内存占用比 G1GC 更高,不过在回收内存时不会导致卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="仅 G1GC" <local:MyComboBoxItem Content="标准 G1GC"
ToolTipService.BetweenShowDelay="0" ToolTip="固定使用以下参数:&#xa;-XX:+UseG1GC -XX:+UnlockExperimentalVMOptions -XX:G1NewSizePercent=20 -XX:G1ReservePercent=20 -XX:MaxGCPauseMillis=50 -XX:G1HeapRegionSize=32M&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="总是使用 G1GC,附带 Mojang 官方的优化参数。&#xa;G1GC 的内存占用比 ZGC 更低,但在回收内存时会导致突然的卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="不指定(可自定义)" <local:MyComboBoxItem Content="调优 G1GC" local:SettingService.Value="5"
ToolTipService.BetweenShowDelay="0" ToolTip="不自动添加 GC 参数。&#xa;&#xa;仅当选择此项时,你可以在 “Java 虚拟机参数” 设置中手动添加 GC 参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="总是使用 G1GC,附带 PCL 调优过的优化参数。&#xa;G1GC 的内存占用比 ZGC 更低,但在回收内存时会导致突然的卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="不指定(可自定义)" local:SettingService.Value="4"
ToolTipService.BetweenShowDelay="0" ToolTip="不自动添加 GC 参数。&#xa;仅当选择此项时,你可以在 “Java 虚拟机参数” 设置中手动添加 GC 参数。" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" /> <TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="6" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3" <local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="6" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
@@ -27,42 +27,44 @@
Try Try
'启动参数 '启动参数
TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance) TextArgumentTitle.Text = Settings.Get("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance) TextArgumentInfo.Text = Settings.Get("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定 Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Setup.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1) ComboArgumentIndieV2.SelectedIndex = If(Settings.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox() RefreshJavaComboBox()
'游戏内存 '游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Instance:=PageInstanceLeft.Instance)), MyRadioBox).Checked = True CType(FindName("RadioRamType" & Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Instance:=PageInstanceLeft.Instance) OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance))
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Instance:=PageInstanceLeft.Instance) SliderRamCustom.Value = Settings.Get("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
ComboRamOptimize.SelectedIndex = Settings.Get("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
'服务器 '服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Instance:=PageInstanceLeft.Instance) TextServerEnter.Text = Settings.Get("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance) ComboServerLogin.SelectedIndex = Settings.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex ComboServerLoginLast = ComboServerLogin.SelectedIndex
ServerLogin(ComboServerLogin.SelectedIndex) ServerLogin(ComboServerLogin.SelectedIndex)
TextServerNide.Text = Setup.Get("VersionServerNide", Instance:=PageInstanceLeft.Instance) TextServerNide.Text = Settings.Get("VersionServerNide", Instance:=PageInstanceLeft.Instance)
TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance) TextServerAuthServer.Text = Settings.Get("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Instance:=PageInstanceLeft.Instance) TextServerAuthName.Text = Settings.Get("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance) TextServerAuthRegister.Text = Settings.Get("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
'高级设置 '高级设置
TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance) TextAdvanceJvm.Text = Settings.Get("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance) TextAdvanceGame.Text = Settings.Get("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
ComboAdvanceGC.SelectedIndex = Setup.Get("VersionAdvanceGC", Instance:=PageInstanceLeft.Instance) TextAdvanceRun.Text = Settings.Get("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
TextAdvanceRun.Text = Setup.Get("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance) CheckAdvanceRunWait.Checked = Settings.Get("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
CheckAdvanceRunWait.Checked = Setup.Get("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance) If Settings.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
If Setup.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置") Log("[Setup] 已迁移老版本的关闭文件校验设置")
Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance) Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If End If
CheckAdvanceAssetsV2.Checked = Setup.Get("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance) CheckAdvanceAssetsV2.Checked = Settings.Get("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
CheckAdvanceJava.Checked = Setup.Get("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance) CheckAdvanceJava.Checked = Settings.Get("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableJLW.Checked = Setup.Get("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance) CheckAdvanceDisableJLW.Checked = Settings.Get("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableModUpdate.Checked = Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) CheckAdvanceDisableModUpdate.Checked = Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
SettingService.RefreshSettings(Me)
Catch ex As Exception Catch ex As Exception
Log(ex, "重载版本独立设置时出错", LogLevel.Feedback) Log(ex, "重载版本独立设置时出错", LogLevel.Feedback)
@@ -73,31 +75,32 @@
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("VersionServerEnter", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerLogin", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerNide", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerNide", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthName", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamType", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionRamType", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamCustom", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamOptimize", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceGC", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化版本独立设置") Log("[Setup] 已初始化版本独立设置")
Hint("已初始化版本独立设置!", HintType.Green, False) Hint("已初始化版本独立设置!", HintType.Green, False)
Catch ex As Exception Catch ex As Exception
@@ -109,31 +112,36 @@
'将控件改变路由到设置改变 '将控件改变路由到设置改变
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Instance:=PageInstanceLeft.Instance) If AniControlEnabled = 0 Then Settings.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
If AniControlEnabled = 0 Then If AniControlEnabled = 0 Then
'#3194,不能删减 / '#3194,不能删减 /
'Dim HandledText As String = sender.Text 'Dim HandledText As String = sender.Text
'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/") 'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/")
Setup.Set(sender.Tag, sender.Text, Instance:=PageInstanceLeft.Instance) Settings.Set(sender.Tag, sender.Text, Instance:=PageInstanceLeft.Instance)
End If End If
End Sub End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Instance:=PageInstanceLeft.Instance) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Value, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboRamOptimize.SelectionChanged, ComboAdvanceGC.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Instance:=PageInstanceLeft.Instance) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub CheckBoxLikeComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged Private Shared Sub CheckBoxLikeComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex = 0, Instance:=PageInstanceLeft.Instance) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex = 0, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceDisableModUpdate.Change Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceDisableModUpdate.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked, Instance:=PageInstanceLeft.Instance) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
#Region "游戏内存" #Region "游戏内存"
Public Shared Sub OnVersionRamTypeChanged(Type As Integer)
If FrmInstanceSetup Is Nothing Then Return
FrmInstanceSetup.RamType(Type)
End Sub
Public Sub RamType(Type As Integer) Public Sub RamType(Type As Integer)
If SliderRamCustom Is Nothing Then Return If SliderRamCustom Is Nothing Then Return
SliderRamCustom.IsEnabled = (Type = 1) SliderRamCustom.IsEnabled = (Type = 1)
@@ -272,7 +280,7 @@
''' </summary> ''' </summary>
Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double
'跟随全局设置 '跟随全局设置
If Setup.Get("VersionRamType", Instance:=Instance) = 2 Then If Settings.Get("VersionRamType", Instance:=Instance) = 2 Then
Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava) Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava)
End If End If
@@ -282,7 +290,7 @@
'使用当前版本的设置 '使用当前版本的设置
Dim RamGive As Double Dim RamGive As Double
If Setup.Get("VersionRamType", Instance:=Instance) = 0 Then If Settings.Get("VersionRamType", Instance:=Instance) = 0 Then
'自动配置 '自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值 '确定需求的内存值
@@ -294,7 +302,7 @@
If Instance IsNot Nothing AndAlso Instance.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\") Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50 RamTarget2 = 2.7 + ModCount / 50
@@ -338,7 +346,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else Else
'手动配置 '手动配置
Dim Value As Integer = Setup.Get("VersionRamCustom", Instance:=Instance) Dim Value As Integer = Settings.Get("VersionRamCustom", Instance:=Instance)
If Value <= 12 Then If Value <= 12 Then
RamGive = Value * 0.1 + 0.3 RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then ElseIf Value <= 25 Then
@@ -358,6 +366,16 @@ PreFin:
#Region "服务器" #Region "服务器"
'当第三方登录更改时,清空版本列表缓存以更新版本分类
'TODO: 这会不会导致拖拽改变第三方登录的时候版本列表缓存没有更新?
Public Shared Sub OnVersionServerLoginChanged(Type As Integer)
If FrmInstanceSetup Is Nothing Then Return
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "")
If PageInstanceLeft.Instance Is Nothing Then Return
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
'自动替换标点 '自动替换标点
Private Sub TextServerEnter_Change() Handles TextServerEnter.TextChanged Private Sub TextServerEnter_Change() Handles TextServerEnter.TextChanged
Dim NewText = TextServerEnter.Text.Replace(":", ":").Replace("。", ".") Dim NewText = TextServerEnter.Text.Replace(":", ":").Replace("。", ".")
@@ -424,7 +442,7 @@ PreFin:
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表 '更新列表
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance) Dim SelectedBySetup As String = Settings.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try Try
For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion) For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -435,7 +453,7 @@ PreFin:
If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem
Next Next
Catch ex As Exception Catch ex As Exception
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback) Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
End Try End Try
'更新选择项 '更新选择项
@@ -470,15 +488,15 @@ PreFin:
Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag
If "使用全局设置".Equals(SelectedJava) Then If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:跟随全局设置") Log("[Java] 修改版本 Java 选择设置:跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:自动选择") Log("[Java] 修改版本 Java 选择设置:自动选择")
Else Else
'选择指定项 '选择指定项
Setup.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:" & SelectedJava.ToString) Log("[Java] 修改版本 Java 选择设置:" & SelectedJava.ToString)
End If End If
RefreshRam(True) RefreshRam(True)
@@ -55,7 +55,7 @@
Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png") Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
If FileAddress.Contains("\") Then If FileAddress.Contains("\") Then
File.Delete(FileAddress) File.Delete(FileAddress)
If Address.StartsWith(PathImage) Then If Address.StartsWithF(PathImage) Then
Dim Image As New MyBitmap(Address) Dim Image As New MyBitmap(Address)
Image.Save(FileAddress) Image.Save(FileAddress)
Else Else
@@ -79,7 +79,7 @@
'检查文件存在 '检查文件存在
Address = Loader.Output Address = Loader.Output
If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出") If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
If Not Address.StartsWith(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address) If Not Address.StartsWithF(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
'加载 '加载
Dim Image As MyBitmap Dim Image As MyBitmap
Try Try
@@ -142,7 +142,7 @@
End If End If
Next Next
If FrmLaunchLeft IsNot Nothing AndAlso HasLoaderRunning Then If FrmLaunchLeft IsNot Nothing AndAlso HasLoaderRunning Then
'由于 Abort 不是实时的,暂时不会释放文件,会导致删除报错,故只能取消执行 '由于 Interrupt 不是实时的,暂时不会释放文件,会导致删除报错,故只能取消执行
Hint("有正在获取中的皮肤,请稍后再试!", HintType.Blue) Hint("有正在获取中的皮肤,请稍后再试!", HintType.Blue)
Else Else
RunInThread( RunInThread(
@@ -177,8 +177,8 @@
Sub() Sub()
Try Try
'更新缓存 '更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress) WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get("CacheMsV2Uuid"), SkinAddress)
Log($"[Skin] 已写入皮肤地址缓存 {Setup.Get("CacheMsV2Uuid")} -> {SkinAddress}") Log($"[Skin] 已写入皮肤地址缓存 {Settings.Get("CacheMsV2Uuid")} -> {SkinAddress}")
'刷新控件 '刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy} For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True) SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -27,17 +27,10 @@
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack" If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug) Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Setup.Set("LaunchFolderSelect", "$.minecraft\") PageSelectLeft.CreateMcFolderInCurrentPath()
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
PageSelectLeft.AddFolder(Path & ".minecraft\", GetFolderNameFromPath(Path), False)
McFolderListLoader.WaitForExit() McFolderListLoader.WaitForExit()
End If End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
McFolderSelected = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then
'无效的文件夹 '无效的文件夹
If McFolderSelected = "" Then If McFolderSelected = "" Then
@@ -46,10 +39,9 @@
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, LogLevel.Debug) Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, LogLevel.Debug)
End If End If
McFolderListLoader.WaitForExit(IsForceRestart:=True) McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Location.Replace(Path, "$")) McFolderSelected = McFolderList.First.Location
End If End If
Log("[Launch] Minecraft 文件夹:" & McFolderSelected) If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装 '自动整合包安装
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
Try Try
@@ -67,7 +59,7 @@
End Try End Try
End If End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = ReadIni(McFolderSelected & "PCL.ini", "Version")
Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection)) Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection))
If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then
'无效的版本 '无效的版本
@@ -75,11 +67,9 @@
If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Instance = Nothing Instance = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本") Log("[Launch] 无可用 Minecraft 版本")
Else Else
Instance = McInstanceList.First.Value(0) Instance = McInstanceList.First.Value(0)
Setup.Set("LaunchVersionSelect", Instance.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Instance.PathVersion) Log("[Launch] 自动选择 Minecraft 版本:" & Instance.PathVersion)
End If End If
End If End If
@@ -94,7 +84,7 @@
End Sub, "Version Check", ThreadPriority.AboveNormal) End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面 '改变页面
Dim LoginType As McLoginType = Setup.Get("LoginType") Dim LoginType As McLoginType = Settings.Get("LoginType")
If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True
RefreshPage(False, False) RefreshPage(False, False)
@@ -108,7 +98,7 @@
''' </summary> ''' </summary>
Public Sub PageChangeToLaunching() Public Sub PageChangeToLaunching()
'修改登陆方式 '修改登陆方式
Select Case Setup.Get("LoginType") Select Case Settings.Get("LoginType")
Case McLoginType.Legacy Case McLoginType.Legacy
LabLaunchingMethod.Text = "离线登录" LabLaunchingMethod.Text = "离线登录"
Case McLoginType.Ms Case McLoginType.Ms
@@ -279,37 +269,37 @@
Dim Type As PageType Dim Type As PageType
Dim LoginPageType As Integer Dim LoginPageType As Integer
If McInstanceSelected IsNot Nothing Then If McInstanceSelected IsNot Nothing Then
LoginPageType = Setup.Get("VersionServerLogin", Instance:=McInstanceSelected) LoginPageType = Settings.Get("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类,下一次打开 McInstanceSelected 为空时才能加载出正确的页面 '缓存当前版本的页面种类,下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Setup.Set("LoginPageType", LoginPageType) Settings.Set("LoginPageType", LoginPageType)
Else Else
LoginPageType = Setup.Get("LoginPageType") LoginPageType = Settings.Get("LoginPageType")
End If End If
Select Case LoginPageType Select Case LoginPageType
Case 0 '正版或离线 Case 0 '正版或离线
UnknownType: UnknownType:
If RadioLoginType5.Checked Then If RadioLoginType5.Checked Then
If Setup.Get("CacheMsV2Access") = "" Then If Settings.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
End If End If
Setup.Set("LoginType", McLoginType.Ms) Settings.Set("LoginType", McLoginType.Ms)
Else Else
Type = PageType.Legacy Type = PageType.Legacy
Setup.Set("LoginType", McLoginType.Legacy) Settings.Set("LoginType", McLoginType.Legacy)
End If End If
PanType.Visibility = Visibility.Visible PanType.Visibility = Visibility.Visible
PanTypeOne.Visibility = Visibility.Collapsed PanTypeOne.Visibility = Visibility.Collapsed
RadioLoginType5.Visibility = Visibility.Visible RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版 Case 1 '仅正版
If Setup.Get("CacheMsV2Access") = "" Then If Settings.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
End If End If
Setup.Set("LoginType", McLoginType.Ms) Settings.Set("LoginType", McLoginType.Ms)
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonShield) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonShield)
@@ -318,33 +308,33 @@ UnknownType:
RadioLoginType0.Visibility = Visibility.Collapsed RadioLoginType0.Visibility = Visibility.Collapsed
Case 2 '仅离线 Case 2 '仅离线
Type = PageType.Legacy Type = PageType.Legacy
Setup.Set("LoginType", McLoginType.Legacy) Settings.Set("LoginType", McLoginType.Legacy)
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
LabTypeOne.Text = "离线登录" LabTypeOne.Text = "离线登录"
Case 3 '统一通行证 Case 3 '统一通行证
If Setup.Get("CacheNideAccess") = "" Then If Settings.Get("CacheNideAccess") = "" Then
Type = PageType.Nide Type = PageType.Nide
Else Else
Type = PageType.NideSkin Type = PageType.NideSkin
End If End If
Setup.Set("LoginType", McLoginType.Nide) Settings.Set("LoginType", McLoginType.Nide)
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = "统一通行证登录" LabTypeOne.Text = "统一通行证登录"
Case 4 'Authlib-Injector Case 4 'Authlib-Injector
If Setup.Get("CacheAuthAccess") = "" Then If Settings.Get("CacheAuthAccess") = "" Then
Type = PageType.Auth Type = PageType.Auth
Else Else
Type = PageType.AuthSkin Type = PageType.AuthSkin
End If End If
Setup.Set("LoginType", McLoginType.Auth) Settings.Set("LoginType", McLoginType.Auth)
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Instance:=McInstanceSelected)) LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerName"), Settings.Get("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录" If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else Case Else
Log("[Control] 未知的登录页面:" & LoginPageType, LogLevel.Hint) Log("[Control] 未知的登录页面:" & LoginPageType, LogLevel.Hint)
@@ -353,7 +343,7 @@ UnknownType:
'刷新页面 '刷新页面
If PageCurrent = Type Then Return If PageCurrent = Type Then Return
PageChange(Type, Anim).Reload(KeepInput) PageChange(Type, Anim).Reload(KeepInput)
Dim Control As MyRadioButton = FindName("RadioLoginType" & Setup.Get("LoginType")) Dim Control As MyRadioButton = FindName("RadioLoginType" & Settings.Get("LoginType"))
If Control IsNot Nothing Then Control.Checked = True If Control IsNot Nothing Then Control.Checked = True
End Sub End Sub
Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check
@@ -368,7 +358,7 @@ UnknownType:
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal) Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String) Private Shared Function SkinMsInput() As EqualableList(Of String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Setup.Get("CacheMsV2Name"), Setup.Get("CacheMsV2Uuid")} Return New EqualableList(Of String) From {Settings.Get("CacheMsV2Name"), Settings.Get("CacheMsV2Uuid")}
End Function End Function
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String))
'清空已有皮肤 '清空已有皮肤
@@ -384,9 +374,9 @@ UnknownType:
End If End If
Try Try
Dim Result As String = McSkinGetAddress(Uuid, "Ms") Dim Result As String = McSkinGetAddress(Uuid, "Ms")
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Result = McSkinDownload(Result) Result = McSkinDownload(Result)
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Data.Output = Result Data.Output = Result
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Data.Output = "" Data.Output = ""
@@ -407,7 +397,7 @@ Finish:
'刷新显示 '刷新显示
If FrmLoginMsSkin IsNot Nothing Then If FrmLoginMsSkin IsNot Nothing Then
RunInUi(AddressOf FrmLoginMsSkin.Skin.Load) RunInUi(AddressOf FrmLoginMsSkin.Skin.Load)
ElseIf Not Data.IsAborted Then '如果已经中断,Input 也被清空,就不会再次刷新 ElseIf Not Data.IsInterrupted Then '如果已经中断,Input 也被清空,就不会再次刷新
Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染 Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染
End If End If
End Sub End Sub
@@ -416,18 +406,18 @@ Finish:
Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal) Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
Private Shared Function SkinLegacyInput() As EqualableList(Of String) Private Shared Function SkinLegacyInput() As EqualableList(Of String)
'根据类型判断输入 '根据类型判断输入
Dim Type As Integer = Setup.Get("LaunchSkinType") Dim Type As Integer = Settings.Get("LaunchSkinType")
Select Case Type Select Case Type
Case 0 Case 0
If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")} Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")}
ElseIf Setup.Get("LoginLegacyName") = "" Then ElseIf Settings.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""} Return New EqualableList(Of String) From {0, ""}
Else Else
Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")} Return New EqualableList(Of String) From {0, If(Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")}
End If End If
Case 3 Case 3
Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} Return New EqualableList(Of String) From {3, Settings.Get("LaunchSkinID")}
Case Else Case Else
Return New EqualableList(Of String) From {Type} Return New EqualableList(Of String) From {Type}
End Select End Select
@@ -451,11 +441,11 @@ UseDefault:
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Else Else
Dim Result As String = McLoginMojangUuid(ID, True) Dim Result As String = McLoginMojangUuid(ID, True)
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID)
Result = McSkinGetAddress(Result, "Mojang") Result = McSkinGetAddress(Result, "Mojang")
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID)
Result = McSkinDownload(Result) Result = McSkinDownload(Result)
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & ID)
Data.Output = Result Data.Output = Result
End If End If
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
@@ -473,7 +463,7 @@ UseDefault:
Case 4 '自定义 Case 4 '自定义
If Not File.Exists(PathAppdata & "CustomSkin.png") Then If Not File.Exists(PathAppdata & "CustomSkin.png") Then
Hint("未找到离线皮肤自定义文件,可能它已被删除。PCL 将使用默认的 Steve 皮肤!") Hint("未找到离线皮肤自定义文件,可能它已被删除。PCL 将使用默认的 Steve 皮肤!")
Setup.Set("LaunchSkinType", 1) Settings.Set("LaunchSkinType", 1)
GoTo UseDefault GoTo UseDefault
End If End If
Data.Output = PathAppdata & "CustomSkin.png" Data.Output = PathAppdata & "CustomSkin.png"
@@ -481,7 +471,7 @@ UseDefault:
'刷新显示 '刷新显示
If FrmLoginLegacy IsNot Nothing Then If FrmLoginLegacy IsNot Nothing Then
RunInUi(AddressOf FrmLoginLegacy.Skin.Load) RunInUi(AddressOf FrmLoginLegacy.Skin.Load)
ElseIf Not Data.IsAborted Then '如果已经中断,Input 也被清空,就不会再次刷新 ElseIf Not Data.IsInterrupted Then '如果已经中断,Input 也被清空,就不会再次刷新
Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染 Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染
End If End If
End Sub End Sub
@@ -490,7 +480,7 @@ UseDefault:
Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal) Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
Private Shared Function SkinNideInput() As EqualableList(Of String) Private Shared Function SkinNideInput() As EqualableList(Of String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Setup.Get("CacheNideName"), Setup.Get("CacheNideUuid")} Return New EqualableList(Of String) From {Settings.Get("CacheNideName"), Settings.Get("CacheNideUuid")}
End Function End Function
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String))
'清空已有皮肤 '清空已有皮肤
@@ -506,9 +496,9 @@ UseDefault:
End If End If
Try Try
Dim Result As String = McSkinGetAddress(Uuid, "Nide") Dim Result As String = McSkinGetAddress(Uuid, "Nide")
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Result = McSkinDownload(Result) Result = McSkinDownload(Result)
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Data.Output = Result Data.Output = Result
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Data.Output = "" Data.Output = ""
@@ -529,7 +519,7 @@ Finish:
'刷新显示 '刷新显示
If FrmLoginNideSkin IsNot Nothing Then If FrmLoginNideSkin IsNot Nothing Then
RunInUi(AddressOf FrmLoginNideSkin.Skin.Load) RunInUi(AddressOf FrmLoginNideSkin.Skin.Load)
ElseIf Not Data.IsAborted Then '如果已经中断,Input 也被清空,就不会再次刷新 ElseIf Not Data.IsInterrupted Then '如果已经中断,Input 也被清空,就不会再次刷新
Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染 Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染
End If End If
End Sub End Sub
@@ -538,7 +528,7 @@ Finish:
Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal) Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
Private Shared Function SkinAuthInput() As EqualableList(Of String) Private Shared Function SkinAuthInput() As EqualableList(Of String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Setup.Get("CacheAuthName"), Setup.Get("CacheAuthUuid")} Return New EqualableList(Of String) From {Settings.Get("CacheAuthName"), Settings.Get("CacheAuthUuid")}
End Function End Function
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String))
'清空已有皮肤 '清空已有皮肤
@@ -554,9 +544,9 @@ Finish:
End If End If
Try Try
Dim Result As String = McSkinGetAddress(UUID, "Auth") Dim Result As String = McSkinGetAddress(UUID, "Auth")
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Result = McSkinDownload(Result) Result = McSkinDownload(Result)
If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName) If Data.IsInterrupted Then Throw New ThreadInterruptedException("当前任务已取消:" & UserName)
Data.Output = Result Data.Output = Result
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Data.Output = "" Data.Output = ""
@@ -577,7 +567,7 @@ Finish:
'刷新显示 '刷新显示
If FrmLoginAuthSkin IsNot Nothing Then If FrmLoginAuthSkin IsNot Nothing Then
RunInUi(AddressOf FrmLoginAuthSkin.Skin.Load) RunInUi(AddressOf FrmLoginAuthSkin.Skin.Load)
ElseIf Not Data.IsAborted Then '如果已经中断,Input 也被清空,就不会再次刷新 ElseIf Not Data.IsInterrupted Then '如果已经中断,Input 也被清空,就不会再次刷新
Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染 Data.Input = Nothing '清空输入,因为皮肤实际上没有被渲染,如果不清空切换到页面的 Start 会由于输入相同而不渲染
End If End If
End Sub End Sub
@@ -601,6 +591,7 @@ Finish:
If IsAprilEnabled AndAlso Not IsAprilGiveup Then If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!") ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!")
IsAprilGiveup = True IsAprilGiveup = True
Settings.Set("AprilDoneYear", Date.Now.Year)
FrmLaunchLeft.AprilScaleTrans.ScaleX = 1 FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
FrmLaunchLeft.AprilScaleTrans.ScaleY = 1 FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
FrmLaunchLeft.AprilPosTrans.X = 0 FrmLaunchLeft.AprilPosTrans.X = 0
@@ -624,7 +615,7 @@ Finish:
CurrentState = 0 CurrentState = 0
Else Else
If McInstanceSelected Is Nothing Then If McInstanceSelected Is Nothing Then
If Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then If Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
CurrentState = 1 CurrentState = 1
Else Else
CurrentState = 2 CurrentState = 2
@@ -670,7 +661,7 @@ Finish:
End Select End Select
ExitRefresh: ExitRefresh:
'功能隐藏 '功能隐藏
FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Setup.Get("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible) FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible)
If CurrentState = 3 Then If CurrentState = 3 Then
FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility
End If End If
@@ -678,7 +669,7 @@ ExitRefresh:
'取消按钮 '取消按钮
Private Sub BtnCancel_Click() Handles BtnCancel.Click Private Sub BtnCancel_Click() Handles BtnCancel.Click
If McLaunchLoaderReal IsNot Nothing Then If McLaunchLoaderReal IsNot Nothing Then
McLaunchLoaderReal.Abort() McLaunchLoaderReal.Interrupt()
McLaunchLog("已取消启动") McLaunchLog("已取消启动")
Try Try
If McLaunchWatcher IsNot Nothing Then If McLaunchWatcher IsNot Nothing Then
@@ -703,7 +694,7 @@ ExitRefresh:
''' </summary> ''' </summary>
Public Sub LaunchingRefresh() Public Sub LaunchingRefresh()
Try Try
If McLaunchLoaderReal.State = LoadState.Aborted Then Return If McLaunchLoaderReal.State = LoadState.Interrupted Then Return
'阶段状态获取 '阶段状态获取
Dim IsLaunched As Boolean = False '是否已经启动游戏,只是在等待窗口 Dim IsLaunched As Boolean = False '是否已经启动游戏,只是在等待窗口
Try Try
@@ -42,17 +42,17 @@ Public Class PageLaunchRight
End Sub End Sub
Private Sub RefreshReal() Private Sub RefreshReal()
Dim Content As String = Nothing, Url As String = Nothing Dim Content As String = Nothing, Url As String = Nothing
Select Case Setup.Get("UiCustomType") Select Case Settings.Get("UiCustomType")
Case 1 Case 1
'加载本地文件 '加载本地文件
Log("[Page] 主页自定义数据来源:本地文件") Log("[Page] 主页自定义数据来源:本地文件")
Content = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测 Content = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Case 2 Case 2
'联网下载 '联网下载
Url = Setup.Get("UiCustomNet") Url = Settings.Get("UiCustomNet")
Case 3 Case 3
'预设 '预设
Select Case Setup.Get("UiCustomPreset") Select Case Settings.Get("UiCustomPreset")
Case 0 Case 0
Log("[Page] 主页预设:你知道吗") Log("[Page] 主页预设:你知道吗")
Content = " Content = "
@@ -117,7 +117,7 @@ Public Class PageLaunchRight
End Select End Select
'联网下载 '联网下载
If Not String.IsNullOrWhiteSpace(Url) Then If Not String.IsNullOrWhiteSpace(Url) Then
If Url = Setup.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then If Url = Settings.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then
'缓存可用 '缓存可用
Log("[Page] 主页自定义数据来源:联网缓存文件") Log("[Page] 主页自定义数据来源:联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml") Content = ReadFile(PathTemp & "Cache\Custom.xaml")
@@ -128,7 +128,7 @@ Public Class PageLaunchRight
Log("[Page] 主页自定义数据来源:联网全新下载") Log("[Page] 主页自定义数据来源:联网全新下载")
Hint("正在加载主页……") Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面 RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面
Setup.Set("CacheSavedPageVersion", "") Settings.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新 OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新
Return Return
End If End If
@@ -152,7 +152,7 @@ Public Class PageLaunchRight
VersionAddress = Address.Replace(".xaml", ".xaml.ini") VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else Else
VersionAddress = Address.BeforeFirst("?") VersionAddress = Address.BeforeFirst("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/" If Not VersionAddress.EndsWithF("/") Then VersionAddress += "/"
VersionAddress += "version" VersionAddress += "version"
If Address.Contains("?") Then VersionAddress += "?" & Address.AfterFirst("?") If Address.Contains("?") Then VersionAddress += "?" & Address.AfterFirst("?")
End If End If
@@ -161,7 +161,7 @@ Public Class PageLaunchRight
Try Try
Version = NetRequestByClientRetry(VersionAddress) Version = NetRequestByClientRetry(VersionAddress)
If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长({Version.Length} 字符)") If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion") Dim CurrentVersion As String = Settings.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}") Log($"[Page] 当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
Return Return
@@ -174,8 +174,8 @@ Public Class PageLaunchRight
'实际下载 '实际下载
Dim FileContent As String = NetRequestByClientRetry(Address) Dim FileContent As String = NetRequestByClientRetry(Address)
Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}") Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Address) Settings.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version) Settings.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent) WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
'若内容变更则要求刷新 '若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh() If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
@@ -206,8 +206,8 @@ Public Class PageLaunchRight
Private Sub ClearCache() Private Sub ClearCache()
LoadedContentHash = -1 LoadedContentHash = -1
OnlineLoader.Input = New Tuple(Of String, Boolean)("", True) OnlineLoader.Input = New Tuple(Of String, Boolean)("", True)
Setup.Set("CacheSavedPageUrl", "") Settings.Set("CacheSavedPageUrl", "")
Setup.Set("CacheSavedPageVersion", "") Settings.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空主页缓存") Log("[Page] 已清空主页缓存")
End Sub End Sub
@@ -251,7 +251,7 @@ Public Class PageLaunchRight
''' 加载主页失败时调用。 ''' 加载主页失败时调用。
''' </summary> ''' </summary>
Private Sub OnLoadContentFailed(ex As Exception) Private Sub OnLoadContentFailed(ex As Exception)
If ModeDebug OrElse Setup.Get("UiCustomType") = 1 Then If ModeDebug OrElse Settings.Get("UiCustomType") = 1 Then
Log(ex, "加载主页失败") Log(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.GetBrief}"), If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.GetBrief}"),
"加载主页失败", "重试", "取消") = 1 Then ForceRefresh() "加载主页失败", "重试", "取消") = 1 Then ForceRefresh()
@@ -5,20 +5,20 @@
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
'记住密码 '记住密码
CheckRemember.Checked = Setup.Get("LoginRemember") CheckRemember.Checked = Settings.Get("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西 If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表 '保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Setup.Get("LoginAuthEmail") = "", Nothing, Setup.Get("LoginAuthEmail").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get("LoginAuthEmail") = "", Nothing, Settings.Get("LoginAuthEmail").ToString.Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入,刷新列表后自动选择第一项 '不保留输入,刷新列表后自动选择第一项
If Setup.Get("LoginAuthEmail") = "" Then If Settings.Get("LoginAuthEmail") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") ComboName.ItemsSource = Settings.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginAuthEmail").ToString.BeforeFirst("¨") ComboName.Text = Settings.Get("LoginAuthEmail").ToString.BeforeFirst("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
If FrmLoginAuth Is Nothing Then If FrmLoginAuth Is Nothing Then
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else Else
@@ -49,20 +49,20 @@
'保存输入信息 '保存输入信息
Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If sender.Text = "" Then TextPass.Password = "" If sender.Text = "" Then TextPass.Password = ""
If AniControlEnabled = 0 Then Setup.Set("CacheAuthAccess", "") '迫使其不进行 Validate If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "") '迫使其不进行 Validate
End Sub End Sub
Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged
If AniControlEnabled = 0 Then Setup.Set("CacheAuthAccess", "") If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "")
End Sub End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Setup.Get("LoginRemember") Then If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then
TextPass.Password = "" TextPass.Password = ""
Else Else
TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim TextPass.Password = Settings.Get("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim
End If End If
End Sub End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked)
End Sub End Sub
'链接处理 '链接处理
@@ -71,15 +71,15 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister"))) OpenWebsite(If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister")))
Else Else
Dim Website As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister")) Dim Website As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot")) OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If End If
End Sub End Sub
'切换注册按钮可见性 '切换注册按钮可见性
Private Sub ReloadRegisterButton() Handles Me.Loaded Private Sub ReloadRegisterButton() Handles Me.Loaded
Dim Address As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed) BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed)
End Sub End Sub
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Setup.Get("CacheAuthName") TextName.Text = Settings.Get("CacheAuthName")
TextEmail.Text = Setup.Get("CacheAuthUsername") TextEmail.Text = Settings.Get("CacheAuthUsername")
TextEmail.Visibility = If(Setup.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
PageLoginLegacy_Loaded() PageLoginLegacy_Loaded()
End Sub End Sub
''' <summary> ''' <summary>
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Setup.Get("CacheAuthUsername"), .Password = Setup.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Settings.Get("CacheAuthUsername"), .Password = Settings.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
End Function End Function
Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -55,8 +55,8 @@
Return Return
End If End If
Hint("正在尝试更换,请稍候!") Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存 Settings.Set("CacheAuthUuid", "") '清空选择缓存
Setup.Set("CacheAuthName", "") Settings.Set("CacheAuthName", "")
RunInThread( RunInThread(
Sub() Sub()
Try Try
@@ -70,15 +70,15 @@
End Sub) End Sub)
End Sub End Sub
Public Shared Sub ExitLogin() Handles BtnExit.Click Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "") Settings.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "") Settings.Set("CacheAuthUuid", "")
Setup.Set("CacheAuthName", "") Settings.Set("CacheAuthName", "")
McLoginAuthLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果 McLoginAuthLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
Dim Address As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet")) If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet"))
End Sub End Sub
@@ -18,15 +18,15 @@ Public Class PageLoginLegacy
If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西 If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表 '保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text.Trim Dim Input As String = ComboName.Text.Trim
ComboName.ItemsSource = If(Setup.Get("LoginLegacyName") = "", Nothing, Setup.Get("LoginLegacyName").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get("LoginLegacyName") = "", Nothing, Settings.Get("LoginLegacyName").ToString.Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入,刷新列表后自动选择第一项 '不保留输入,刷新列表后自动选择第一项
If Setup.Get("LoginLegacyName") = "" Then If Settings.Get("LoginLegacyName") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") ComboName.ItemsSource = Settings.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim ComboName.Text = Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsReloaded = True IsReloaded = True
@@ -36,7 +36,7 @@ Public Class PageLoginLegacy
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginData Public Shared Function GetLoginData() As McLoginData
Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim) Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim)
Return New McLoginLegacy With {.UserName = UserName, .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")} Return New McLoginLegacy With {.UserName = UserName, .SkinType = Settings.Get("LaunchSkinType"), .SkinName = Settings.Get("LaunchSkinID")}
End Function End Function
''' <summary> ''' <summary>
''' 当前页面的登录信息是否有效。 ''' 当前页面的登录信息是否有效。
@@ -62,12 +62,12 @@ Public Class PageLoginLegacy
End If End If
End Sub End Sub
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If Setup.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) If Settings.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible) HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug,它不一定会自动更新 HintChinese 的大小(#6627) RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug,它不一定会自动更新 HintChinese 的大小(#6627)
End Sub End Sub
Private Sub Skin_Click() Handles Skin.Click Private Sub Skin_Click() Handles Skin.Click
If (Setup.Get("UiHiddenPageSetup") OrElse Setup.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then If (Settings.Get("UiHiddenPageSetup") OrElse Settings.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
Hint("启动设置已被禁用!", HintType.Red) Hint("启动设置已被禁用!", HintType.Red)
Else Else
FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面 FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面
@@ -9,7 +9,7 @@
ComboAccounts.Items.Clear() ComboAccounts.Items.Clear()
ComboAccounts.Items.Add(New MyComboBoxItem With {.Content = "添加新账号"}) ComboAccounts.Items.Add(New MyComboBoxItem With {.Content = "添加新账号"})
Try Try
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
For Each Account In MsJson For Each Account In MsJson
Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent() Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent()
Item.Tag = Account.Value.ToString Item.Tag = Account.Value.ToString
@@ -18,8 +18,8 @@
ComboAccounts.Items.Add(Item) ComboAccounts.Items.Add(Item)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, $"微软登录信息出错,登录信息已被重置({Setup.Get("LoginMsJson")})", LogLevel.Hint) Log(ex, $"微软登录信息出错,登录信息已被重置({Settings.Get("LoginMsJson")})", LogLevel.Hint)
Setup.Set("LoginMsJson", "{}") Settings.Set("LoginMsJson", "{}")
End Try End Try
'如果不保留输入,刷新列表后自动选择第一项 '如果不保留输入,刷新列表后自动选择第一项
ComboAccounts.SelectedIndex = If(KeepInput, Math.Max(0, IndexBefore), 0) ComboAccounts.SelectedIndex = If(KeepInput, Math.Max(0, IndexBefore), 0)
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")} If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")}
Dim Result As McLoginMs = Nothing Dim Result As McLoginMs = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -78,7 +78,7 @@
Loop Loop
If McLoginMsLoader.State = LoadState.Finished Then If McLoginMsLoader.State = LoadState.Finished Then
RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True)) RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True))
ElseIf McLoginMsLoader.State = LoadState.Aborted Then ElseIf McLoginMsLoader.State = LoadState.Interrupted Then
Throw New ThreadInterruptedException Throw New ThreadInterruptedException
ElseIf McLoginMsLoader.Error Is Nothing Then ElseIf McLoginMsLoader.Error Is Nothing Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
@@ -89,7 +89,7 @@
Hint("已取消登录!") Hint("已取消登录!")
Catch ex As Exception Catch ex As Exception
If ex.Message = "$$" Then If ex.Message = "$$" Then
ElseIf ex.Message.StartsWith("$") Then ElseIf ex.Message.StartsWithF("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Red) Hint(ex.Message.TrimStart("$"), HintType.Red)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox) Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Setup.Get("CacheMsV2Name") TextName.Text = Settings.Get("CacheMsV2Name")
'皮肤在 Loaded 加载 '皮肤在 Loaded 加载
End Sub End Sub
''' <summary> ''' <summary>
@@ -20,9 +20,9 @@
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If McLoginMsLoader.State = LoadState.Finished Then If McLoginMsLoader.State = LoadState.Finished Then
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name"), .AccessToken = Setup.Get("CacheMsV2Access"), .Uuid = Setup.Get("CacheMsV2Uuid"), .ProfileJson = Setup.Get("CacheMsV2ProfileJson")} Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name"), .AccessToken = Settings.Get("CacheMsV2Access"), .Uuid = Settings.Get("CacheMsV2Uuid"), .ProfileJson = Settings.Get("CacheMsV2ProfileJson")}
Else Else
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")} Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")}
End If End If
End Function End Function
@@ -50,12 +50,12 @@
'退出登录 '退出登录
Private Sub BtnExit_Click() Handles BtnExit.Click Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheMsV2OAuthRefresh", "") Settings.Set("CacheMsV2OAuthRefresh", "")
Setup.Set("CacheMsV2Access", "") Settings.Set("CacheMsV2Access", "")
Setup.Set("CacheMsV2ProfileJson", "") Settings.Set("CacheMsV2ProfileJson", "")
Setup.Set("CacheMsV2Uuid", "") Settings.Set("CacheMsV2Uuid", "")
Setup.Set("CacheMsV2Name", "") Settings.Set("CacheMsV2Name", "")
McLoginMsLoader.Abort() McLoginMsLoader.Interrupt()
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -93,8 +93,8 @@ Retry:
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error) If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error)
Dim AccessToken As String = Setup.Get("CacheMsV2Access") Dim AccessToken As String = Settings.Get("CacheMsV2Access")
Dim Uuid As String = Setup.Get("CacheMsV2Uuid") Dim Uuid As String = Settings.Get("CacheMsV2Uuid")
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post, Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
Content:=New Net.Http.MultipartFormDataContent From { Content:=New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
@@ -5,20 +5,20 @@
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
'记住密码 '记住密码
CheckRemember.Checked = Setup.Get("LoginRemember") CheckRemember.Checked = Settings.Get("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西 If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表 '保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Setup.Get("LoginNideEmail") = "", Nothing, Setup.Get("LoginNideEmail").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get("LoginNideEmail") = "", Nothing, Settings.Get("LoginNideEmail").ToString.Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入,刷新列表后自动选择第一项 '不保留输入,刷新列表后自动选择第一项
If Setup.Get("LoginNideEmail") = "" Then If Settings.Get("LoginNideEmail") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") ComboName.ItemsSource = Settings.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginNideEmail").ToString.BeforeFirst("¨") ComboName.Text = Settings.Get("LoginNideEmail").ToString.BeforeFirst("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected))
If FrmLoginNide Is Nothing Then If FrmLoginNide Is Nothing Then
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else Else
@@ -49,20 +49,20 @@
'保存输入信息 '保存输入信息
Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If sender.Text = "" Then TextPass.Password = "" If sender.Text = "" Then TextPass.Password = ""
If AniControlEnabled = 0 Then Setup.Set("CacheNideAccess", "") '迫使其不进行 Validate If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "") '迫使其不进行 Validate
End Sub End Sub
Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged
If AniControlEnabled = 0 Then Setup.Set("CacheNideAccess", "") If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "")
End Sub End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Setup.Get("LoginRemember") Then If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then
TextPass.Password = "" TextPass.Password = ""
Else Else
TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(sender.SelectedIndex).Trim TextPass.Password = Settings.Get("LoginNidePass").ToString.Split("¨")(sender.SelectedIndex).Trim
End If End If
End Sub End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked)
End Sub End Sub
'链接处理 '链接处理
@@ -71,7 +71,7 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register") OpenWebsite("https://login.mc-user.com:233/" & Settings.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register")
Else Else
OpenWebsite("https://login.mc-user.com:233/account/login") OpenWebsite("https://login.mc-user.com:233/account/login")
End If End If
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Setup.Get("CacheNideName") TextName.Text = Settings.Get("CacheNideName")
TextEmail.Text = Setup.Get("CacheNideUsername") TextEmail.Text = Settings.Get("CacheNideUsername")
TextEmail.Visibility = If(Setup.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
'皮肤在 Loaded 加载 '皮肤在 Loaded 加载
End Sub End Sub
''' <summary> ''' <summary>
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected))
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Setup.Get("CacheNideUsername"), .Password = Setup.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Settings.Get("CacheNideUsername"), .Password = Settings.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
End Function End Function
Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -48,13 +48,13 @@
OpenWebsite("https://login.mc-user.com:233/account/changepw") OpenWebsite("https://login.mc-user.com:233/account/changepw")
End Sub End Sub
Public Shared Sub ExitLogin() Handles BtnExit.Click Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheNideAccess", "") Settings.Set("CacheNideAccess", "")
McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果 McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin") OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
End Sub End Sub
End Class End Class
@@ -70,7 +70,7 @@ Public Class PageLinkMain
'由任意状态切换到 Waiting '由任意状态切换到 Waiting
Private Sub SwitchToWaiting(OldState As LinkStates) Private Sub SwitchToWaiting(OldState As LinkStates)
'加载器与进程状态 '加载器与进程状态
LinkLoader.Abort() LinkLoader.Interrupt()
SyncLock LinkLoader.LockState SyncLock LinkLoader.LockState
LinkLoader.State = LoadState.Waiting LinkLoader.State = LoadState.Waiting
End SyncLock End SyncLock
@@ -171,7 +171,7 @@ Public Class PageLinkMain
End Function End Function
Private Shared Function FixCodeFormat(Code As String) As String Private Shared Function FixCodeFormat(Code As String) As String
Code = Code.Between("【", "】").Between("[", "]") '从完整消息中提取 Code = Code.Between("【", "】").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正 Code = Code.Upper.Replace("O", "0").Replace("I", "1") '输入修正
'版本 1 兼容 '版本 1 兼容
If Code.Length >= 17 AndAlso (Code.Length < 23 OrElse (Code.Length >= 18 AndAlso Code(17) <> "-"c)) Then If Code.Length >= 17 AndAlso (Code.Length < 23 OrElse (Code.Length >= 18 AndAlso Code(17) <> "-"c)) Then
Code = Code.Substring(0, 17) & "-0105E" Code = Code.Substring(0, 17) & "-0105E"
@@ -223,7 +223,7 @@ Public Class PageLinkMain
'由 Loading 状态切换到 Failed '由 Loading 状态切换到 Failed
Private Sub SwitchToFailed(OldState As LinkStates) Private Sub SwitchToFailed(OldState As LinkStates)
'加载器与进程状态 '加载器与进程状态
LinkLoader.Abort() LinkLoader.Interrupt()
ProcessStop() ProcessStop()
'UI 更新 'UI 更新
UpdateProgressBar(1) UpdateProgressBar(1)
@@ -356,7 +356,7 @@ Public Class PageLinkMain
Private Sub Copy() Handles BtnFinishCopy.Click Private Sub Copy() Handles BtnFinishCopy.Click
Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{GetInviteCode()}】,即可加入联机房间!" Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{GetInviteCode()}】,即可加入联机房间!"
ClipboardSet(CodeText, False) ClipboardSet(CodeText, False)
Setup.Set("LinkLastAutoJoinInviteCode", CodeText) Settings.Set("LinkLastAutoJoinInviteCode", CodeText)
Hint("已复制邀请码!", HintType.Green) Hint("已复制邀请码!", HintType.Green)
End Sub End Sub
Private Function GetInviteCode() As String Private Function GetInviteCode() As String
@@ -460,9 +460,9 @@ Public Class PageLinkMain
UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本") UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso
File.Exists(PathEasyTier & "Packet.dll")) Then File.Exists(PathEasyTier & "Packet.dll")) Then
Setup.Set("LinkEasyTierVersion", -1) Settings.Set("LinkEasyTierVersion", -1)
End If End If
Dim LocalVersion As Integer = Setup.Get("LinkEasyTierVersion") Dim LocalVersion As Integer = Settings.Get("LinkEasyTierVersion")
ServerVersion = ServerConfig("Link")("EasyTierVersion") ServerVersion = ServerConfig("Link")("EasyTierVersion")
Dim RequiredFiles As New List(Of NetFile) Dim RequiredFiles As New List(Of NetFile)
Log($"[Link] EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}") Log($"[Link] EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}")
@@ -491,18 +491,18 @@ Public Class PageLinkMain
CopyDirectory(ExtractedPath, PathEasyTier) CopyDirectory(ExtractedPath, PathEasyTier)
'重命名 '重命名
File.Delete(PathEasyTier & "联机模块.exe") File.Delete(PathEasyTier & "联机模块.exe")
Rename(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe") File.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
File.Delete(PathEasyTier & "联机模块 CLI.exe") File.Delete(PathEasyTier & "联机模块 CLI.exe")
Rename(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe") File.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
'清理 '清理
File.Delete(PathEasyTier & "EasyTier.zip") File.Delete(PathEasyTier & "EasyTier.zip")
Setup.Set("LinkEasyTierVersion", ServerVersion) Settings.Set("LinkEasyTierVersion", ServerVersion)
End If End If
Task.Progress = 0.07 Task.Progress = 0.07
'获取节点列表 '获取节点列表
UpdateLoadingPage("正在获取节点列表……", "获取节点列表") UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
Dim RawPeers As List(Of String) Dim RawPeers As List(Of String)
Dim CustomPeers As String = Setup.Get("LinkCustomPeer") Dim CustomPeers As String = Settings.Get("LinkCustomPeer")
If String.IsNullOrWhiteSpace(CustomPeers) Then If String.IsNullOrWhiteSpace(CustomPeers) Then
If DiscoverNodeID = -2 AndAlso Not IsServerSide Then If DiscoverNodeID = -2 AndAlso Not IsServerSide Then
Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容,{vbCrLf}才能进入该房间!") Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容,{vbCrLf}才能进入该房间!")
@@ -539,7 +539,7 @@ Public Class PageLinkMain
For Each Peer As String In RawPeers For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}""" Arguments += $" -p=""{Peer}"""
Next Next
If Setup.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first" If Settings.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程 '启动进程
ProcessStart(Arguments) ProcessStart(Arguments)
Task.Progress = 0.15 Task.Progress = 0.15
@@ -585,8 +585,8 @@ Public Class PageLinkMain
Panic("无法连接到房主", $"可能的原因:{vbCrLf}- 你或者房主的网络环境不佳{vbCrLf}- 房主已关闭房间{vbCrLf}- 邀请码输错了") Panic("无法连接到房主", $"可能的原因:{vbCrLf}- 你或者房主的网络环境不佳{vbCrLf}- 房主已关闭房间{vbCrLf}- 邀请码输错了")
End Select End Select
End If End If
Loop Until Task.IsAborted Loop Until Task.IsInterrupted
If Task.IsAborted Then Throw New ThreadInterruptedException If Task.IsInterrupted Then Throw New ThreadInterruptedException
'等待连接稳定,最多 5s '等待连接稳定,最多 5s
If IsServerSide Then Return If IsServerSide Then Return
UpdateLoadingPage("连接优化中……", "优化连接") UpdateLoadingPage("连接优化中……", "优化连接")
@@ -594,7 +594,7 @@ Public Class PageLinkMain
For i = 1 To 50 For i = 1 To 50
Dim Server = GetTargetPeer() Dim Server = GetTargetPeer()
If Server IsNot Nothing AndAlso Not Server.Relay AndAlso Server.Ping < 100 Then Return '结束 If Server IsNot Nothing AndAlso Not Server.Relay AndAlso Server.Ping < 100 Then Return '结束
If Task.IsAborted Then Throw New ThreadInterruptedException If Task.IsInterrupted Then Throw New ThreadInterruptedException
Thread.Sleep(100) Thread.Sleep(100)
Next Next
End Sub End Sub
@@ -1060,7 +1060,7 @@ ForcedPass:
Else Else
HintFinish.Text = "你或者房主的网络环境不太好," HintFinish.Text = "你或者房主的网络环境不太好,"
End If End If
If String.IsNullOrWhiteSpace(Setup.Get("LinkCustomPeer")) Then If String.IsNullOrWhiteSpace(Settings.Get("LinkCustomPeer")) Then
HintFinish.Text &= "正使用社区节点进行中继。" HintFinish.Text &= "正使用社区节点进行中继。"
Else Else
HintFinish.Text &= "正通过自定义节点进行中继。" HintFinish.Text &= "正通过自定义节点进行中继。"
@@ -30,7 +30,7 @@
</Image.Clip> </Image.Clip>
</Image> </Image>
<local:MyButton Text="赞助 PCL !" Grid.Column="2" Grid.Row="0" Height="35" ColorType="Highlight" <local:MyButton Text="赞助 PCL !" Grid.Column="2" Grid.Row="0" Height="35" ColorType="Highlight"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://afdian.com/a/LTCat" /> local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://meloong.com/afd/a/LTCat" />
<local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" <local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://github.com/Hex-Dragon/PCL2" /> local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid> </Grid>
@@ -54,7 +54,7 @@
<ColumnDefinition Width="150" /> <ColumnDefinition Width="150" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyListItem Title="bangbang93" Margin="-5,0,15,0" IsHitTestVisible="False" Info="提供 BMCLAPI 镜像源和 Forge 安装工具,详见 https://bmclapi.bangbang93.com" Grid.Row="0" Grid.Column="1" /> <local:MyListItem Title="bangbang93" Margin="-5,0,15,0" IsHitTestVisible="False" Info="提供 BMCLAPI 镜像源和 Forge 安装工具,详见 https://bmclapi.bangbang93.com" Grid.Row="0" Grid.Column="1" />
<local:MyButton Text="赞助镜像源" Grid.Row="0" Grid.Column="2" Height="35" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://afdian.com/a/bangbang93" /> <local:MyButton Text="赞助镜像源" Grid.Row="0" Grid.Column="2" Height="35" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://meloong.com/afd/a/bangbang93" />
<local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" /> <local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" />
<local:MyButton Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://www.mcmod.cn" /> <local:MyButton Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://www.mcmod.cn" />
<local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 社区资源镜像源和帮助库图床!" Grid.Row="2" Grid.Column="1" /> <local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 社区资源镜像源和帮助库图床!" Grid.Row="2" Grid.Column="1" />
@@ -116,15 +116,20 @@
<local:MyCard Margin="0,0,0,15" Title="赞助者"> <local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,19,20"> <StackPanel Margin="25,40,19,20">
<TextBlock HorizontalAlignment="Left" Text="以下是近期的高级赞助者们!感谢大家对 PCL 的支持!!!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" /> <TextBlock HorizontalAlignment="Left" Text="以下是近期的高级赞助者们!感谢大家对 PCL 的支持!!!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <TextBlock Margin="0,1.5,6,0" Text="F" /> <WrapPanel Margin="0,0,0,10"> <TextBlock Margin="0,1.5,6,0" Text="." />
<TextBlock Margin="0,1.5,6,0" Text="F" />
<TextBlock Margin="0,1.5,6,0" Text="z" /> <TextBlock Margin="0,1.5,6,0" Text="z" />
<TextBlock Margin="0,1.5,6,0" Text="y" /> <TextBlock Margin="0,1.5,6,0" Text="y" />
<TextBlock Margin="0,1.5,6,0" Text="Y" /> <TextBlock Margin="0,1.5,6,0" Text="Y" />
<TextBlock Margin="0,1.5,6,0" Text="2" /> <TextBlock Margin="0,1.5,6,0" Text="2" />
<TextBlock Margin="0,1.5,6,0" Text="X" /> <TextBlock Margin="0,1.5,6,0" Text="X" />
<TextBlock Margin="0,1.5,6,0" Text="..." />
<TextBlock Margin="0,1.5,6,0" Text="R" />
<TextBlock Margin="0,1.5,6,0" Text="L." /> <TextBlock Margin="0,1.5,6,0" Text="L." />
<TextBlock Margin="0,1.5,6,0" Text="yi" /> <TextBlock Margin="0,1.5,6,0" Text="yi" />
<TextBlock Margin="0,1.5,6,0" Text="Q" /> <TextBlock Margin="0,1.5,6,0" Text="Q" />
<TextBlock Margin="0,1.5,6,0" Text="D" />
<TextBlock Margin="0,1.5,6,0" Text="le" />
<TextBlock Margin="0,1.5,6,0" Text="寄" /> <TextBlock Margin="0,1.5,6,0" Text="寄" />
<TextBlock Margin="0,1.5,6,0" Text="ㅤ" /> <TextBlock Margin="0,1.5,6,0" Text="ㅤ" />
<TextBlock Margin="0,1.5,6,0" Text="vv" /> <TextBlock Margin="0,1.5,6,0" Text="vv" />
@@ -132,6 +137,7 @@
<TextBlock Margin="0,1.5,6,0" Text="念" /> <TextBlock Margin="0,1.5,6,0" Text="念" />
<TextBlock Margin="0,1.5,6,0" Text="覹" /> <TextBlock Margin="0,1.5,6,0" Text="覹" />
<TextBlock Margin="0,1.5,6,0" Text="咕" /> <TextBlock Margin="0,1.5,6,0" Text="咕" />
<TextBlock Margin="0,1.5,6,0" Text="李" />
<TextBlock Margin="0,1.5,6,0" Text="狼" /> <TextBlock Margin="0,1.5,6,0" Text="狼" />
<TextBlock Margin="0,1.5,6,0" Text="甘" /> <TextBlock Margin="0,1.5,6,0" Text="甘" />
<TextBlock Margin="0,1.5,6,0" Text="。" /> <TextBlock Margin="0,1.5,6,0" Text="。" />
@@ -154,12 +160,21 @@
<TextBlock Margin="0,1.5,6,0" Text="莫" /> <TextBlock Margin="0,1.5,6,0" Text="莫" />
<TextBlock Margin="0,1.5,6,0" Text="尊" /> <TextBlock Margin="0,1.5,6,0" Text="尊" />
<TextBlock Margin="0,1.5,6,0" Text="埃" /> <TextBlock Margin="0,1.5,6,0" Text="埃" />
<TextBlock Margin="0,1.5,6,0" Text="灷" />
<TextBlock Margin="0,1.5,6,0" Text="蒙" />
<TextBlock Margin="0,1.5,6,0" Text="鸢" />
<TextBlock Margin="0,1.5,6,0" Text="羽" />
<TextBlock Margin="0,1.5,6,0" Text="梦" />
<TextBlock Margin="0,1.5,6,0" Text="零" />
<TextBlock Margin="0,1.5,6,0" Text="jw" /> <TextBlock Margin="0,1.5,6,0" Text="jw" />
<TextBlock Margin="0,1.5,6,0" Text="ftt" /> <TextBlock Margin="0,1.5,6,0" Text="ftt" />
<TextBlock Margin="0,1.5,6,0" Text="TT" />
<TextBlock Margin="0,1.5,6,0" Text="ZZ" /> <TextBlock Margin="0,1.5,6,0" Text="ZZ" />
<TextBlock Margin="0,1.5,6,0" Text="zjx" /> <TextBlock Margin="0,1.5,6,0" Text="zjx" />
<TextBlock Margin="0,1.5,6,0" Text="XX" />
<TextBlock Margin="0,1.5,6,0" Text="Lie" /> <TextBlock Margin="0,1.5,6,0" Text="Lie" />
<TextBlock Margin="0,1.5,6,0" Text="sjg" /> <TextBlock Margin="0,1.5,6,0" Text="sjg" />
<TextBlock Margin="0,1.5,6,0" Text="yfx" />
<TextBlock Margin="0,1.5,6,0" Text="hly" /> <TextBlock Margin="0,1.5,6,0" Text="hly" />
<TextBlock Margin="0,1.5,6,0" Text="l y y" /> <TextBlock Margin="0,1.5,6,0" Text="l y y" />
<TextBlock Margin="0,1.5,6,0" Text="陈jj" /> <TextBlock Margin="0,1.5,6,0" Text="陈jj" />
@@ -168,18 +183,25 @@
<TextBlock Margin="0,1.5,6,0" Text="eye" /> <TextBlock Margin="0,1.5,6,0" Text="eye" />
<TextBlock Margin="0,1.5,6,0" Text="O.o" /> <TextBlock Margin="0,1.5,6,0" Text="O.o" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" /> <TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="qixi" /> <TextBlock Margin="0,1.5,6,0" Text="qixi" />
<TextBlock Margin="0,1.5,6,0" Text="555" />
<TextBlock Margin="0,1.5,6,0" Text="JJJT" />
<TextBlock Margin="0,1.5,6,0" Text="Rou" /> <TextBlock Margin="0,1.5,6,0" Text="Rou" />
<TextBlock Margin="0,1.5,6,0" Text="wyb" /> <TextBlock Margin="0,1.5,6,0" Text="wyb" />
<TextBlock Margin="0,1.5,6,0" Text="qqq" /> <TextBlock Margin="0,1.5,6,0" Text="qqq" />
<TextBlock Margin="0,1.5,6,0" Text="zikil" /> <TextBlock Margin="0,1.5,6,0" Text="zikil" />
<TextBlock Margin="0,1.5,6,0" Text="Kiro" /> <TextBlock Margin="0,1.5,6,0" Text="Kiro" />
<TextBlock Margin="0,1.5,6,0" Text="Win" />
<TextBlock Margin="0,1.5,6,0" Text="沙轻" />
<TextBlock Margin="0,1.5,6,0" Text="流明" /> <TextBlock Margin="0,1.5,6,0" Text="流明" />
<TextBlock Margin="0,1.5,6,0" Text="姜耸" /> <TextBlock Margin="0,1.5,6,0" Text="姜耸" />
<TextBlock Margin="0,1.5,6,0" Text="柏枫" /> <TextBlock Margin="0,1.5,6,0" Text="柏枫" />
<TextBlock Margin="0,1.5,6,0" Text="柒绪" /> <TextBlock Margin="0,1.5,6,0" Text="柒绪" />
<TextBlock Margin="0,1.5,6,0" Text="缤语" />
<TextBlock Margin="0,1.5,6,0" Text="xsqs" /> <TextBlock Margin="0,1.5,6,0" Text="xsqs" />
<TextBlock Margin="0,1.5,6,0" Text="啊?" /> <TextBlock Margin="0,1.5,6,0" Text="啊?" />
<TextBlock Margin="0,1.5,6,0" Text="空青" />
<TextBlock Margin="0,1.5,6,0" Text="无风" /> <TextBlock Margin="0,1.5,6,0" Text="无风" />
<TextBlock Margin="0,1.5,6,0" Text="听雨" /> <TextBlock Margin="0,1.5,6,0" Text="听雨" />
<TextBlock Margin="0,1.5,6,0" Text="方格" /> <TextBlock Margin="0,1.5,6,0" Text="方格" />
@@ -191,6 +213,9 @@
<TextBlock Margin="0,1.5,6,0" Text="暗生" /> <TextBlock Margin="0,1.5,6,0" Text="暗生" />
<TextBlock Margin="0,1.5,6,0" Text="久辰" /> <TextBlock Margin="0,1.5,6,0" Text="久辰" />
<TextBlock Margin="0,1.5,6,0" Text="陌苼" /> <TextBlock Margin="0,1.5,6,0" Text="陌苼" />
<TextBlock Margin="0,1.5,6,0" Text="夜幕" />
<TextBlock Margin="0,1.5,6,0" Text="夜墨" />
<TextBlock Margin="0,1.5,6,0" Text="芥裔" />
<TextBlock Margin="0,1.5,6,0" Text="慕野" /> <TextBlock Margin="0,1.5,6,0" Text="慕野" />
<TextBlock Margin="0,1.5,6,0" Text="沐落" /> <TextBlock Margin="0,1.5,6,0" Text="沐落" />
<TextBlock Margin="0,1.5,6,0" Text="澍雨" /> <TextBlock Margin="0,1.5,6,0" Text="澍雨" />
@@ -267,12 +292,29 @@
<TextBlock Margin="0,1.5,6,0" Text="晚点" /> <TextBlock Margin="0,1.5,6,0" Text="晚点" />
<TextBlock Margin="0,1.5,6,0" Text="景文" /> <TextBlock Margin="0,1.5,6,0" Text="景文" />
<TextBlock Margin="0,1.5,6,0" Text="天火" /> <TextBlock Margin="0,1.5,6,0" Text="天火" />
<TextBlock Margin="0,1.5,6,0" Text="迟涵" />
<TextBlock Margin="0,1.5,6,0" Text="冬莫" /> <TextBlock Margin="0,1.5,6,0" Text="冬莫" />
<TextBlock Margin="0,1.5,6,0" Text="羽嵩" /> <TextBlock Margin="0,1.5,6,0" Text="羽嵩" />
<TextBlock Margin="0,1.5,6,0" Text="湙泽" /> <TextBlock Margin="0,1.5,6,0" Text="湙泽" />
<TextBlock Margin="0,1.5,6,0" Text="梦幻" /> <TextBlock Margin="0,1.5,6,0" Text="梦幻" />
<TextBlock Margin="0,1.5,6,0" Text="嘿嘿" /> <TextBlock Margin="0,1.5,6,0" Text="嘿嘿" />
<TextBlock Margin="0,1.5,6,0" Text="枫叶" /> <TextBlock Margin="0,1.5,6,0" Text="枫叶" />
<TextBlock Margin="0,1.5,6,0" Text="赤阳" />
<TextBlock Margin="0,1.5,6,0" Text="画猫" />
<TextBlock Margin="0,1.5,6,0" Text="UTA" />
<TextBlock Margin="0,1.5,6,0" Text="柠凉" />
<TextBlock Margin="0,1.5,6,0" Text="本來" />
<TextBlock Margin="0,1.5,6,0" Text=":)" />
<TextBlock Margin="0,1.5,6,0" Text="朔辉" />
<TextBlock Margin="0,1.5,6,0" Text="秋骑" />
<TextBlock Margin="0,1.5,6,0" Text="无一" />
<TextBlock Margin="0,1.5,6,0" Text="老八" />
<TextBlock Margin="0,1.5,6,0" Text="胖子" />
<TextBlock Margin="0,1.5,6,0" Text="御翰" />
<TextBlock Margin="0,1.5,6,0" Text="烛火" />
<TextBlock Margin="0,1.5,6,0" Text="笨挽" />
<TextBlock Margin="0,1.5,6,0" Text="悦木" />
<TextBlock Margin="0,1.5,6,0" Text="林霖" />
<TextBlock Margin="0,1.5,6,0" Text="Alex" /> <TextBlock Margin="0,1.5,6,0" Text="Alex" />
<TextBlock Margin="0,1.5,6,0" Text="JIUZ" /> <TextBlock Margin="0,1.5,6,0" Text="JIUZ" />
<TextBlock Margin="0,1.5,6,0" Text="hina" /> <TextBlock Margin="0,1.5,6,0" Text="hina" />
@@ -282,10 +324,12 @@
<TextBlock Margin="0,1.5,6,0" Text="flzxc" /> <TextBlock Margin="0,1.5,6,0" Text="flzxc" />
<TextBlock Margin="0,1.5,6,0" Text="time" /> <TextBlock Margin="0,1.5,6,0" Text="time" />
<TextBlock Margin="0,1.5,6,0" Text="sadv" /> <TextBlock Margin="0,1.5,6,0" Text="sadv" />
<TextBlock Margin="0,1.5,6,0" Text="gate" />
<TextBlock Margin="0,1.5,6,0" Text="king" /> <TextBlock Margin="0,1.5,6,0" Text="king" />
<TextBlock Margin="0,1.5,6,0" Text="Ezzo" /> <TextBlock Margin="0,1.5,6,0" Text="Ezzo" />
<TextBlock Margin="0,1.5,6,0" Text="vilkil" /> <TextBlock Margin="0,1.5,6,0" Text="vilkil" />
<TextBlock Margin="0,1.5,6,0" Text="1nVt" /> <TextBlock Margin="0,1.5,6,0" Text="1nVt" />
<TextBlock Margin="0,1.5,6,0" Text="^O^" />
<TextBlock Margin="0,1.5,6,0" Text="V無V" /> <TextBlock Margin="0,1.5,6,0" Text="V無V" />
<TextBlock Margin="0,1.5,6,0" Text="hhvv " /> <TextBlock Margin="0,1.5,6,0" Text="hhvv " />
<TextBlock Margin="0,1.5,6,0" Text="TTT4" /> <TextBlock Margin="0,1.5,6,0" Text="TTT4" />
@@ -296,6 +340,9 @@
<TextBlock Margin="0,1.5,6,0" Text="1001" /> <TextBlock Margin="0,1.5,6,0" Text="1001" />
<TextBlock Margin="0,1.5,6,0" Text="tynry" /> <TextBlock Margin="0,1.5,6,0" Text="tynry" />
<TextBlock Margin="0,1.5,6,0" Text="qdy8" /> <TextBlock Margin="0,1.5,6,0" Text="qdy8" />
<TextBlock Margin="0,1.5,6,0" Text="Qing" />
<TextBlock Margin="0,1.5,6,0" Text="TOM" />
<TextBlock Margin="0,1.5,6,0" Text="Gaze" />
<TextBlock Margin="0,1.5,6,0" Text="Long" /> <TextBlock Margin="0,1.5,6,0" Text="Long" />
<TextBlock Margin="0,1.5,6,0" Text="4Ghz" /> <TextBlock Margin="0,1.5,6,0" Text="4Ghz" />
<TextBlock Margin="0,1.5,6,0" Text="miao" /> <TextBlock Margin="0,1.5,6,0" Text="miao" />
@@ -305,7 +352,9 @@
<TextBlock Margin="0,1.5,6,0" Text="cong" /> <TextBlock Margin="0,1.5,6,0" Text="cong" />
<TextBlock Margin="0,1.5,6,0" Text="叶子L" /> <TextBlock Margin="0,1.5,6,0" Text="叶子L" />
<TextBlock Margin="0,1.5,6,0" Text="lelezi" /> <TextBlock Margin="0,1.5,6,0" Text="lelezi" />
<TextBlock Margin="0,1.5,6,0" Text="lucky" />
<TextBlock Margin="0,1.5,6,0" Text="bbbb" /> <TextBlock Margin="0,1.5,6,0" Text="bbbb" />
<TextBlock Margin="0,1.5,6,0" Text="gugu" />
<TextBlock Margin="0,1.5,6,0" Text="Ango" /> <TextBlock Margin="0,1.5,6,0" Text="Ango" />
<TextBlock Margin="0,1.5,6,0" Text="Elysia" /> <TextBlock Margin="0,1.5,6,0" Text="Elysia" />
<TextBlock Margin="0,1.5,6,0" Text="徐铭h" /> <TextBlock Margin="0,1.5,6,0" Text="徐铭h" />
@@ -318,9 +367,11 @@
<TextBlock Margin="0,1.5,6,0" Text="FedEx" /> <TextBlock Margin="0,1.5,6,0" Text="FedEx" />
<TextBlock Margin="0,1.5,6,0" Text="0NaCl" /> <TextBlock Margin="0,1.5,6,0" Text="0NaCl" />
<TextBlock Margin="0,1.5,6,0" Text="pisces" /> <TextBlock Margin="0,1.5,6,0" Text="pisces" />
<TextBlock Margin="0,1.5,6,0" Text="ZDHK" />
<TextBlock Margin="0,1.5,6,0" Text="Mikey" /> <TextBlock Margin="0,1.5,6,0" Text="Mikey" />
<TextBlock Margin="0,1.5,6,0" Text="kjshsk" /> <TextBlock Margin="0,1.5,6,0" Text="kjshsk" />
<TextBlock Margin="0,1.5,6,0" Text="JaMaf" /> <TextBlock Margin="0,1.5,6,0" Text="JaMaf" />
<TextBlock Margin="0,1.5,6,0" Text="调试器" />
<TextBlock Margin="0,1.5,6,0" Text="孙嘉言" /> <TextBlock Margin="0,1.5,6,0" Text="孙嘉言" />
<TextBlock Margin="0,1.5,6,0" Text="张卿予" /> <TextBlock Margin="0,1.5,6,0" Text="张卿予" />
<TextBlock Margin="0,1.5,6,0" Text="樟涛竹" /> <TextBlock Margin="0,1.5,6,0" Text="樟涛竹" />
@@ -342,6 +393,7 @@
<TextBlock Margin="0,1.5,6,0" Text="Chaka" /> <TextBlock Margin="0,1.5,6,0" Text="Chaka" />
<TextBlock Margin="0,1.5,6,0" Text="ximou" /> <TextBlock Margin="0,1.5,6,0" Text="ximou" />
<TextBlock Margin="0,1.5,6,0" Text="小萌新" /> <TextBlock Margin="0,1.5,6,0" Text="小萌新" />
<TextBlock Margin="0,1.5,6,0" Text="寒凌川" />
<TextBlock Margin="0,1.5,6,0" Text="沨旻泽" /> <TextBlock Margin="0,1.5,6,0" Text="沨旻泽" />
<TextBlock Margin="0,1.5,6,0" Text="李睿洋" /> <TextBlock Margin="0,1.5,6,0" Text="李睿洋" />
<TextBlock Margin="0,1.5,6,0" Text="Frutaa" /> <TextBlock Margin="0,1.5,6,0" Text="Frutaa" />
@@ -382,22 +434,45 @@
<TextBlock Margin="0,1.5,6,0" Text="oaken" /> <TextBlock Margin="0,1.5,6,0" Text="oaken" />
<TextBlock Margin="0,1.5,6,0" Text="小小球" /> <TextBlock Margin="0,1.5,6,0" Text="小小球" />
<TextBlock Margin="0,1.5,6,0" Text="天羽煜" /> <TextBlock Margin="0,1.5,6,0" Text="天羽煜" />
<TextBlock Margin="0,1.5,6,0" Text="小牛马" />
<TextBlock Margin="0,1.5,6,0" Text="折尾猫" />
<TextBlock Margin="0,1.5,6,0" Text="橘雨恋" />
<TextBlock Margin="0,1.5,6,0" Text="耿大壮" />
<TextBlock Margin="0,1.5,6,0" Text="无头像" />
<TextBlock Margin="0,1.5,6,0" Text="格洛芬" />
<TextBlock Margin="0,1.5,6,0" Text="史迪威" />
<TextBlock Margin="0,1.5,6,0" Text="小苏子" />
<TextBlock Margin="0,1.5,6,0" Text="塔塔开" />
<TextBlock Margin="0,1.5,6,0" Text="七代风" />
<TextBlock Margin="0,1.5,6,0" Text="狐狸喵" />
<TextBlock Margin="0,1.5,6,0" Text="俥仔面" />
<TextBlock Margin="0,1.5,6,0" Text="英仙座" />
<TextBlock Margin="0,1.5,6,0" Text="小零子" />
<TextBlock Margin="0,1.5,6,0" Text="白清河" />
<TextBlock Margin="0,1.5,6,0" Text="晚江诗" />
<TextBlock Margin="0,1.5,6,0" Text="諸星洋" />
<TextBlock Margin="0,1.5,6,0" Text="UN_41" /> <TextBlock Margin="0,1.5,6,0" Text="UN_41" />
<TextBlock Margin="0,1.5,6,0" Text="bguae" /> <TextBlock Margin="0,1.5,6,0" Text="bguae" />
<TextBlock Margin="0,1.5,6,0" Text="yoyal8" />
<TextBlock Margin="0,1.5,6,0" Text="hjsa30" /> <TextBlock Margin="0,1.5,6,0" Text="hjsa30" />
<TextBlock Margin="0,1.5,6,0" Text="Chpoy" /> <TextBlock Margin="0,1.5,6,0" Text="Chpoy" />
<TextBlock Margin="0,1.5,6,0" Text="Ander." /> <TextBlock Margin="0,1.5,6,0" Text="Ander." />
<TextBlock Margin="0,1.5,6,0" Text="aKALA" />
<TextBlock Margin="0,1.5,6,0" Text="muzsh" /> <TextBlock Margin="0,1.5,6,0" Text="muzsh" />
<TextBlock Margin="0,1.5,6,0" Text="gyj120" /> <TextBlock Margin="0,1.5,6,0" Text="gyj120" />
<TextBlock Margin="0,1.5,6,0" Text="IC1805" /> <TextBlock Margin="0,1.5,6,0" Text="IC1805" />
<TextBlock Margin="0,1.5,6,0" Text="凌·秋烨" />
<TextBlock Margin="0,1.5,6,0" Text="logical" /> <TextBlock Margin="0,1.5,6,0" Text="logical" />
<TextBlock Margin="0,1.5,6,0" Text="bit...bit" /> <TextBlock Margin="0,1.5,6,0" Text="bit...bit" />
<TextBlock Margin="0,1.5,6,0" Text="N0rdiK" /> <TextBlock Margin="0,1.5,6,0" Text="N0rdiK" />
<TextBlock Margin="0,1.5,6,0" Text="Sphinx" />
<TextBlock Margin="0,1.5,6,0" Text="kimma" />
<TextBlock Margin="0,1.5,6,0" Text="techzjc" /> <TextBlock Margin="0,1.5,6,0" Text="techzjc" />
<TextBlock Margin="0,1.5,6,0" Text="Keiskei" /> <TextBlock Margin="0,1.5,6,0" Text="Keiskei" />
<TextBlock Margin="0,1.5,6,0" Text="EMO龚" /> <TextBlock Margin="0,1.5,6,0" Text="EMO龚" />
<TextBlock Margin="0,1.5,6,0" Text="Thgink" /> <TextBlock Margin="0,1.5,6,0" Text="Thgink" />
<TextBlock Margin="0,1.5,6,0" Text="forever" /> <TextBlock Margin="0,1.5,6,0" Text="forever" />
<TextBlock Margin="0,1.5,6,0" Text="114514" />
<TextBlock Margin="0,1.5,6,0" Text="manbo" /> <TextBlock Margin="0,1.5,6,0" Text="manbo" />
<TextBlock Margin="0,1.5,6,0" Text="114514" /> <TextBlock Margin="0,1.5,6,0" Text="114514" />
<TextBlock Margin="0,1.5,6,0" Text="Gemini" /> <TextBlock Margin="0,1.5,6,0" Text="Gemini" />
@@ -407,43 +482,59 @@
<TextBlock Margin="0,1.5,6,0" Text="mneng" /> <TextBlock Margin="0,1.5,6,0" Text="mneng" />
<TextBlock Margin="0,1.5,6,0" Text="YEYEYE" /> <TextBlock Margin="0,1.5,6,0" Text="YEYEYE" />
<TextBlock Margin="0,1.5,6,0" Text="Phuket" /> <TextBlock Margin="0,1.5,6,0" Text="Phuket" />
<TextBlock Margin="0,1.5,6,0" Text="Atomic" />
<TextBlock Margin="0,1.5,6,0" Text="Kabuto" /> <TextBlock Margin="0,1.5,6,0" Text="Kabuto" />
<TextBlock Margin="0,1.5,6,0" Text=".懒子:(" /> <TextBlock Margin="0,1.5,6,0" Text=".懒子:(" />
<TextBlock Margin="0,1.5,6,0" Text="ZyR3Xx" /> <TextBlock Margin="0,1.5,6,0" Text="ZyR3Xx" />
<TextBlock Margin="0,1.5,6,0" Text="DrQuin" /> <TextBlock Margin="0,1.5,6,0" Text="DrQuin" />
<TextBlock Margin="0,1.5,6,0" Text="sund3a" /> <TextBlock Margin="0,1.5,6,0" Text="sund3a" />
<TextBlock Margin="0,1.5,6,0" Text="Snowill" /> <TextBlock Margin="0,1.5,6,0" Text="Snowill" />
<TextBlock Margin="0,1.5,6,0" Text="kvmvvx" />
<TextBlock Margin="0,1.5,6,0" Text="ling141" />
<TextBlock Margin="0,1.5,6,0" Text="Charile." /> <TextBlock Margin="0,1.5,6,0" Text="Charile." />
<TextBlock Margin="0,1.5,6,0" Text="夜未央S" /> <TextBlock Margin="0,1.5,6,0" Text="夜未央S" />
<TextBlock Margin="0,1.5,6,0" Text="Esykaul" /> <TextBlock Margin="0,1.5,6,0" Text="Esykaul" />
<TextBlock Margin="0,1.5,6,0" Text="粑8博弈" /> <TextBlock Margin="0,1.5,6,0" Text="粑8博弈" />
<TextBlock Margin="0,1.5,6,0" Text="GY9965" /> <TextBlock Margin="0,1.5,6,0" Text="GY9965" />
<TextBlock Margin="0,1.5,6,0" Text="果冻1号" /> <TextBlock Margin="0,1.5,6,0" Text="果冻1号" />
<TextBlock Margin="0,1.5,6,0" Text="Decade" />
<TextBlock Margin="0,1.5,6,0" Text="laobide" />
<TextBlock Margin="0,1.5,6,0" Text="ccb大神" />
<TextBlock Margin="0,1.5,6,0" Text="chicken" /> <TextBlock Margin="0,1.5,6,0" Text="chicken" />
<TextBlock Margin="0,1.5,6,0" Text="阿毛mjy" /> <TextBlock Margin="0,1.5,6,0" Text="阿毛mjy" />
<TextBlock Margin="0,1.5,6,0" Text="CRF1SH" /> <TextBlock Margin="0,1.5,6,0" Text="CRF1SH" />
<TextBlock Margin="0,1.5,6,0" Text="kill1122" />
<TextBlock Margin="0,1.5,6,0" Text="EDream" /> <TextBlock Margin="0,1.5,6,0" Text="EDream" />
<TextBlock Margin="0,1.5,6,0" Text="-Guard-" /> <TextBlock Margin="0,1.5,6,0" Text="-Guard-" />
<TextBlock Margin="0,1.5,6,0" Text="Stridder" /> <TextBlock Margin="0,1.5,6,0" Text="Stridder" />
<TextBlock Margin="0,1.5,6,0" Text="猫yi巴草" />
<TextBlock Margin="0,1.5,6,0" Text="Lennyes" /> <TextBlock Margin="0,1.5,6,0" Text="Lennyes" />
<TextBlock Margin="0,1.5,6,0" Text="Aspirike" /> <TextBlock Margin="0,1.5,6,0" Text="Aspirike" />
<TextBlock Margin="0,1.5,6,0" Text="Paprosa" /> <TextBlock Margin="0,1.5,6,0" Text="Paprosa" />
<TextBlock Margin="0,1.5,6,0" Text="weather" /> <TextBlock Margin="0,1.5,6,0" Text="weather" />
<TextBlock Margin="0,1.5,6,0" Text="qwptpw" /> <TextBlock Margin="0,1.5,6,0" Text="qwptpw" />
<TextBlock Margin="0,1.5,6,0" Text="RedLink" /> <TextBlock Margin="0,1.5,6,0" Text="RedLink" />
<TextBlock Margin="0,1.5,6,0" Text="Starying" />
<TextBlock Margin="0,1.5,6,0" Text="longday" /> <TextBlock Margin="0,1.5,6,0" Text="longday" />
<TextBlock Margin="0,1.5,6,0" Text="wwwww" /> <TextBlock Margin="0,1.5,6,0" Text="wwwww" />
<TextBlock Margin="0,1.5,6,0" Text="疾驰火车" />
<TextBlock Margin="0,1.5,6,0" Text="鸿星天帝" />
<TextBlock Margin="0,1.5,6,0" Text="我不在线" /> <TextBlock Margin="0,1.5,6,0" Text="我不在线" />
<TextBlock Margin="0,1.5,6,0" Text="脏仔牛奶" /> <TextBlock Margin="0,1.5,6,0" Text="脏仔牛奶" />
<TextBlock Margin="0,1.5,6,0" Text="金禾向暖" />
<TextBlock Margin="0,1.5,6,0" Text="贤者摸鱼" /> <TextBlock Margin="0,1.5,6,0" Text="贤者摸鱼" />
<TextBlock Margin="0,1.5,6,0" Text="只见伊人" /> <TextBlock Margin="0,1.5,6,0" Text="只见伊人" />
<TextBlock Margin="0,1.5,6,0" Text="苏家阿辰" />
<TextBlock Margin="0,1.5,6,0" Text="未知用户" />
<TextBlock Margin="0,1.5,6,0" Text="小鱼干儿" /> <TextBlock Margin="0,1.5,6,0" Text="小鱼干儿" />
<TextBlock Margin="0,1.5,6,0" Text="逆浪千秋" /> <TextBlock Margin="0,1.5,6,0" Text="逆浪千秋" />
<TextBlock Margin="0,1.5,6,0" Text="南宫若兮" /> <TextBlock Margin="0,1.5,6,0" Text="南宫若兮" />
<TextBlock Margin="0,1.5,6,0" Text="二十四誓" /> <TextBlock Margin="0,1.5,6,0" Text="二十四誓" />
<TextBlock Margin="0,1.5,6,0" Text="浮世三千" /> <TextBlock Margin="0,1.5,6,0" Text="浮世三千" />
<TextBlock Margin="0,1.5,6,0" Text="英白拉多" />
<TextBlock Margin="0,1.5,6,0" Text="逐兔寻鲸" /> <TextBlock Margin="0,1.5,6,0" Text="逐兔寻鲸" />
<TextBlock Margin="0,1.5,6,0" Text="氮气炸锅" /> <TextBlock Margin="0,1.5,6,0" Text="氮气炸锅" />
<TextBlock Margin="0,1.5,6,0" Text="小小小马" />
<TextBlock Margin="0,1.5,6,0" Text="爱莉希雅" /> <TextBlock Margin="0,1.5,6,0" Text="爱莉希雅" />
<TextBlock Margin="0,1.5,6,0" Text="容我三思" /> <TextBlock Margin="0,1.5,6,0" Text="容我三思" />
<TextBlock Margin="0,1.5,6,0" Text="正经云泽" /> <TextBlock Margin="0,1.5,6,0" Text="正经云泽" />
@@ -452,6 +543,7 @@
<TextBlock Margin="0,1.5,6,0" Text="小茵fans" /> <TextBlock Margin="0,1.5,6,0" Text="小茵fans" />
<TextBlock Margin="0,1.5,6,0" Text="杰克刀哥" /> <TextBlock Margin="0,1.5,6,0" Text="杰克刀哥" />
<TextBlock Margin="0,1.5,6,0" Text="风止于夏" /> <TextBlock Margin="0,1.5,6,0" Text="风止于夏" />
<TextBlock Margin="0,1.5,6,0" Text="村里村夫" />
<TextBlock Margin="0,1.5,6,0" Text="汇流成莹" /> <TextBlock Margin="0,1.5,6,0" Text="汇流成莹" />
<TextBlock Margin="0,1.5,6,0" Text="霜灵雾屿" /> <TextBlock Margin="0,1.5,6,0" Text="霜灵雾屿" />
<TextBlock Margin="0,1.5,6,0" Text="依宸不在" /> <TextBlock Margin="0,1.5,6,0" Text="依宸不在" />
@@ -491,6 +583,22 @@
<TextBlock Margin="0,1.5,6,0" Text="琉璃柏影" /> <TextBlock Margin="0,1.5,6,0" Text="琉璃柏影" />
<TextBlock Margin="0,1.5,6,0" Text="白鸢鲸落" /> <TextBlock Margin="0,1.5,6,0" Text="白鸢鲸落" />
<TextBlock Margin="0,1.5,6,0" Text="陌刀云一" /> <TextBlock Margin="0,1.5,6,0" Text="陌刀云一" />
<TextBlock Margin="0,1.5,6,0" Text="柠岫汐峪" />
<TextBlock Margin="0,1.5,6,0" Text="敷衍了事" />
<TextBlock Margin="0,1.5,6,0" Text="天穹流星" />
<TextBlock Margin="0,1.5,6,0" Text="歪嘴战神" />
<TextBlock Margin="0,1.5,6,0" Text="南荒北愚" />
<TextBlock Margin="0,1.5,6,0" Text="青衫故人" />
<TextBlock Margin="0,1.5,6,0" Text="幽烛漠鸢" />
<TextBlock Margin="0,1.5,6,0" Text="煎饼硌牙" />
<TextBlock Margin="0,1.5,6,0" Text="无铭芝式" />
<TextBlock Margin="0,1.5,6,0" Text="殷野猫音" />
<TextBlock Margin="0,1.5,6,0" Text="龙门朔辰" />
<TextBlock Margin="0,1.5,6,0" Text="null_000" />
<TextBlock Margin="0,1.5,6,0" Text="霜寒千星" />
<TextBlock Margin="0,1.5,6,0" Text="虫草絮语" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼冻肉" />
<TextBlock Margin="0,1.5,6,0" Text="六六六折" />
<TextBlock Margin="0,1.5,6,0" Text="(=^x^=)" /> <TextBlock Margin="0,1.5,6,0" Text="(=^x^=)" />
<TextBlock Margin="0,1.5,6,0" Text="Milkyink" /> <TextBlock Margin="0,1.5,6,0" Text="Milkyink" />
<TextBlock Margin="0,1.5,6,0" Text="houteng" /> <TextBlock Margin="0,1.5,6,0" Text="houteng" />
@@ -506,6 +614,9 @@
<TextBlock Margin="0,1.5,6,0" Text="PoiliPoili" /> <TextBlock Margin="0,1.5,6,0" Text="PoiliPoili" />
<TextBlock Margin="0,1.5,6,0" Text="777seese" /> <TextBlock Margin="0,1.5,6,0" Text="777seese" />
<TextBlock Margin="0,1.5,6,0" Text=" 脖子右拧" /> <TextBlock Margin="0,1.5,6,0" Text=" 脖子右拧" />
<TextBlock Margin="0,1.5,6,0" Text="NicoACG" />
<TextBlock Margin="0,1.5,6,0" Text="许和0331" />
<TextBlock Margin="0,1.5,6,0" Text="Vergilius." />
<TextBlock Margin="0,1.5,6,0" Text="User9075" /> <TextBlock Margin="0,1.5,6,0" Text="User9075" />
<TextBlock Margin="0,1.5,6,0" Text="Bai_Yang" /> <TextBlock Margin="0,1.5,6,0" Text="Bai_Yang" />
<TextBlock Margin="0,1.5,6,0" Text="平凡-仁友" /> <TextBlock Margin="0,1.5,6,0" Text="平凡-仁友" />
@@ -522,6 +633,7 @@
<TextBlock Margin="0,1.5,6,0" Text="断网没mu" /> <TextBlock Margin="0,1.5,6,0" Text="断网没mu" />
<TextBlock Margin="0,1.5,6,0" Text="THOPING" /> <TextBlock Margin="0,1.5,6,0" Text="THOPING" />
<TextBlock Margin="0,1.5,6,0" Text="EXcloudZ" /> <TextBlock Margin="0,1.5,6,0" Text="EXcloudZ" />
<TextBlock Margin="0,1.5,6,0" Text="想rua狐狸" />
<TextBlock Margin="0,1.5,6,0" Text="Leisurelyz" /> <TextBlock Margin="0,1.5,6,0" Text="Leisurelyz" />
<TextBlock Margin="0,1.5,6,0" Text="white白鸽" /> <TextBlock Margin="0,1.5,6,0" Text="white白鸽" />
<TextBlock Margin="0,1.5,6,0" Text="有用的小B" /> <TextBlock Margin="0,1.5,6,0" Text="有用的小B" />
@@ -533,6 +645,7 @@
<TextBlock Margin="0,1.5,6,0" Text="ZMMMM" /> <TextBlock Margin="0,1.5,6,0" Text="ZMMMM" />
<TextBlock Margin="0,1.5,6,0" Text="sensei425" /> <TextBlock Margin="0,1.5,6,0" Text="sensei425" />
<TextBlock Margin="0,1.5,6,0" Text="aslillusory" /> <TextBlock Margin="0,1.5,6,0" Text="aslillusory" />
<TextBlock Margin="0,1.5,6,0" Text="androidhi" />
<TextBlock Margin="0,1.5,6,0" Text="fjh321008" /> <TextBlock Margin="0,1.5,6,0" Text="fjh321008" />
<TextBlock Margin="0,1.5,6,0" Text="ai_114514" /> <TextBlock Margin="0,1.5,6,0" Text="ai_114514" />
<TextBlock Margin="0,1.5,6,0" Text="BlackGary" /> <TextBlock Margin="0,1.5,6,0" Text="BlackGary" />
@@ -542,6 +655,7 @@
<TextBlock Margin="0,1.5,6,0" Text="R2hyb3Ro" /> <TextBlock Margin="0,1.5,6,0" Text="R2hyb3Ro" />
<TextBlock Margin="0,1.5,6,0" Text="暮幽&amp;星辰" /> <TextBlock Margin="0,1.5,6,0" Text="暮幽&amp;星辰" />
<TextBlock Margin="0,1.5,6,0" Text="DoorDoor" /> <TextBlock Margin="0,1.5,6,0" Text="DoorDoor" />
<TextBlock Margin="0,1.5,6,0" Text="shiroNeko" />
<TextBlock Margin="0,1.5,6,0" Text="乄罒丶灬彡" /> <TextBlock Margin="0,1.5,6,0" Text="乄罒丶灬彡" />
<TextBlock Margin="0,1.5,6,0" Text="众所又周知" /> <TextBlock Margin="0,1.5,6,0" Text="众所又周知" />
<TextBlock Margin="0,1.5,6,0" Text="一小片雨霖" /> <TextBlock Margin="0,1.5,6,0" Text="一小片雨霖" />
@@ -550,6 +664,7 @@
<TextBlock Margin="0,1.5,6,0" Text="不浇会枯花" /> <TextBlock Margin="0,1.5,6,0" Text="不浇会枯花" />
<TextBlock Margin="0,1.5,6,0" Text="想喝冰可乐" /> <TextBlock Margin="0,1.5,6,0" Text="想喝冰可乐" />
<TextBlock Margin="0,1.5,6,0" Text="残阳墨雨柒" /> <TextBlock Margin="0,1.5,6,0" Text="残阳墨雨柒" />
<TextBlock Margin="0,1.5,6,0" Text="欢呼与果糖" />
<TextBlock Margin="0,1.5,6,0" Text="忘却的旋律" /> <TextBlock Margin="0,1.5,6,0" Text="忘却的旋律" />
<TextBlock Margin="0,1.5,6,0" Text="迪奥的迪克" /> <TextBlock Margin="0,1.5,6,0" Text="迪奥的迪克" />
<TextBlock Margin="0,1.5,6,0" Text="封于修不修" /> <TextBlock Margin="0,1.5,6,0" Text="封于修不修" />
@@ -583,18 +698,31 @@
<TextBlock Margin="0,1.5,6,0" Text="烂鱼一条线" /> <TextBlock Margin="0,1.5,6,0" Text="烂鱼一条线" />
<TextBlock Margin="0,1.5,6,0" Text="欲买桂花酒" /> <TextBlock Margin="0,1.5,6,0" Text="欲买桂花酒" />
<TextBlock Margin="0,1.5,6,0" Text="慢悠悠报表" /> <TextBlock Margin="0,1.5,6,0" Text="慢悠悠报表" />
<TextBlock Margin="0,1.5,6,0" Text="蓝莓要健康" />
<TextBlock Margin="0,1.5,6,0" Text="Salted fish" />
<TextBlock Margin="0,1.5,6,0" Text="深根地缚灵" />
<TextBlock Margin="0,1.5,6,0" Text="群管机器人" />
<TextBlock Margin="0,1.5,6,0" Text="鱼儿爱上猫" />
<TextBlock Margin="0,1.5,6,0" Text="Anhydride" />
<TextBlock Margin="0,1.5,6,0" Text="帕秋莉~go" />
<TextBlock Margin="0,1.5,6,0" Text="玉玉小南娘" />
<TextBlock Margin="0,1.5,6,0" Text="欣喜的掌声" />
<TextBlock Margin="0,1.5,6,0" Text="Myst-FOEY" /> <TextBlock Margin="0,1.5,6,0" Text="Myst-FOEY" />
<TextBlock Margin="0,1.5,6,0" Text="qaz155808" /> <TextBlock Margin="0,1.5,6,0" Text="qaz155808" />
<TextBlock Margin="0,1.5,6,0" Text="289775340" /> <TextBlock Margin="0,1.5,6,0" Text="289775340" />
<TextBlock Margin="0,1.5,6,0" Text="Executarea" /> <TextBlock Margin="0,1.5,6,0" Text="Executarea" />
<TextBlock Margin="0,1.5,6,0" Text="rosewhisky" /> <TextBlock Margin="0,1.5,6,0" Text="rosewhisky" />
<TextBlock Margin="0,1.5,6,0" Text="mreaaaaay" /> <TextBlock Margin="0,1.5,6,0" Text="mreaaaaay" />
<TextBlock Margin="0,1.5,6,0" Text="Swampday" />
<TextBlock Margin="0,1.5,6,0" Text="GreyFalcon" /> <TextBlock Margin="0,1.5,6,0" Text="GreyFalcon" />
<TextBlock Margin="0,1.5,6,0" Text="Neko_2333" /> <TextBlock Margin="0,1.5,6,0" Text="Neko_2333" />
<TextBlock Margin="0,1.5,6,0" Text="Stellar_Red" /> <TextBlock Margin="0,1.5,6,0" Text="Stellar_Red" />
<TextBlock Margin="0,1.5,6,0" Text="Kizuner630" />
<TextBlock Margin="0,1.5,6,0" Text="陶纸Mr.Tao" /> <TextBlock Margin="0,1.5,6,0" Text="陶纸Mr.Tao" />
<TextBlock Margin="0,1.5,6,0" Text="Hhhsalfkhs" /> <TextBlock Margin="0,1.5,6,0" Text="Hhhsalfkhs" />
<TextBlock Margin="0,1.5,6,0" Text="地灵989898" /> <TextBlock Margin="0,1.5,6,0" Text="地灵989898" />
<TextBlock Margin="0,1.5,6,0" Text="loading182" />
<TextBlock Margin="0,1.5,6,0" Text="hhhjtqdydz" />
<TextBlock Margin="0,1.5,6,0" Text="小啊北Devo" /> <TextBlock Margin="0,1.5,6,0" Text="小啊北Devo" />
<TextBlock Margin="0,1.5,6,0" Text=" 花落碎人心" /> <TextBlock Margin="0,1.5,6,0" Text=" 花落碎人心" />
<TextBlock Margin="0,1.5,6,0" Text="TravellerISX" /> <TextBlock Margin="0,1.5,6,0" Text="TravellerISX" />
@@ -605,13 +733,16 @@
<TextBlock Margin="0,1.5,6,0" Text="时时雨Sama" /> <TextBlock Margin="0,1.5,6,0" Text="时时雨Sama" />
<TextBlock Margin="0,1.5,6,0" Text="永远的Elysia" /> <TextBlock Margin="0,1.5,6,0" Text="永远的Elysia" />
<TextBlock Margin="0,1.5,6,0" Text="2127864647" /> <TextBlock Margin="0,1.5,6,0" Text="2127864647" />
<TextBlock Margin="0,1.5,6,0" Text="Hashtag233" />
<TextBlock Margin="0,1.5,6,0" Text="yu🐟 ζ°)))彡" /> <TextBlock Margin="0,1.5,6,0" Text="yu🐟 ζ°)))彡" />
<TextBlock Margin="0,1.5,6,0" Text="COImos071_" /> <TextBlock Margin="0,1.5,6,0" Text="COImos071_" />
<TextBlock Margin="0,1.5,6,0" Text="QingYiLiang" /> <TextBlock Margin="0,1.5,6,0" Text="QingYiLiang" />
<TextBlock Margin="0,1.5,6,0" Text="arcueid1023" />
<TextBlock Margin="0,1.5,6,0" Text="诺万_Norvan" /> <TextBlock Margin="0,1.5,6,0" Text="诺万_Norvan" />
<TextBlock Margin="0,1.5,6,0" Text="amazingball" /> <TextBlock Margin="0,1.5,6,0" Text="amazingball" />
<TextBlock Margin="0,1.5,6,0" Text="边骂边摆的驴" /> <TextBlock Margin="0,1.5,6,0" Text="边骂边摆的驴" />
<TextBlock Margin="0,1.5,6,0" Text="万物不及欣然" /> <TextBlock Margin="0,1.5,6,0" Text="万物不及欣然" />
<TextBlock Margin="0,1.5,6,0" Text="十六枚铜币丶" />
<TextBlock Margin="0,1.5,6,0" Text="桓桓在等高铁" /> <TextBlock Margin="0,1.5,6,0" Text="桓桓在等高铁" />
<TextBlock Margin="0,1.5,6,0" Text="随便写的名字" /> <TextBlock Margin="0,1.5,6,0" Text="随便写的名字" />
<TextBlock Margin="0,1.5,6,0" Text="我就是萝莉控" /> <TextBlock Margin="0,1.5,6,0" Text="我就是萝莉控" />
@@ -634,6 +765,10 @@
<TextBlock Margin="0,1.5,6,0" Text="打泡泡SAMA" /> <TextBlock Margin="0,1.5,6,0" Text="打泡泡SAMA" />
<TextBlock Margin="0,1.5,6,0" Text="猫的龙车吸引" /> <TextBlock Margin="0,1.5,6,0" Text="猫的龙车吸引" />
<TextBlock Margin="0,1.5,6,0" Text="谁念桥边红药" /> <TextBlock Margin="0,1.5,6,0" Text="谁念桥边红药" />
<TextBlock Margin="0,1.5,6,0" Text="酱汁饼大可爱" />
<TextBlock Margin="0,1.5,6,0" Text="下水道的鼠鼠" />
<TextBlock Margin="0,1.5,6,0" Text="萨卡兹大蟑螂" />
<TextBlock Margin="0,1.5,6,0" Text="小石潭记qwq" />
<TextBlock Margin="0,1.5,6,0" Text="centuryplant" /> <TextBlock Margin="0,1.5,6,0" Text="centuryplant" />
<TextBlock Margin="0,1.5,6,0" Text="Suber_agiley" /> <TextBlock Margin="0,1.5,6,0" Text="Suber_agiley" />
<TextBlock Margin="0,1.5,6,0" Text="NoBody_MO" /> <TextBlock Margin="0,1.5,6,0" Text="NoBody_MO" />
@@ -644,8 +779,11 @@
<TextBlock Margin="0,1.5,6,0" Text="小喜出品1239" /> <TextBlock Margin="0,1.5,6,0" Text="小喜出品1239" />
<TextBlock Margin="0,1.5,6,0" Text="Changephon" /> <TextBlock Margin="0,1.5,6,0" Text="Changephon" />
<TextBlock Margin="0,1.5,6,0" Text="Emo真的emo" /> <TextBlock Margin="0,1.5,6,0" Text="Emo真的emo" />
<TextBlock Margin="0,1.5,6,0" Text="Omori_sunny" />
<TextBlock Margin="0,1.5,6,0" Text="路过一下的lsp" /> <TextBlock Margin="0,1.5,6,0" Text="路过一下的lsp" />
<TextBlock Margin="0,1.5,6,0" Text="qingtian4135" />
<TextBlock Margin="0,1.5,6,0" Text="Nakano Nino" /> <TextBlock Margin="0,1.5,6,0" Text="Nakano Nino" />
<TextBlock Margin="0,1.5,6,0" Text="guduzihaoge" />
<TextBlock Margin="0,1.5,6,0" Text="minecraft风竹" /> <TextBlock Margin="0,1.5,6,0" Text="minecraft风竹" />
<TextBlock Margin="0,1.5,6,0" Text="huangweijian" /> <TextBlock Margin="0,1.5,6,0" Text="huangweijian" />
<TextBlock Margin="0,1.5,6,0" Text="Kecdl_Chacha" /> <TextBlock Margin="0,1.5,6,0" Text="Kecdl_Chacha" />
@@ -666,9 +804,17 @@
<TextBlock Margin="0,1.5,6,0" Text="泪水打湿泪水湿" /> <TextBlock Margin="0,1.5,6,0" Text="泪水打湿泪水湿" />
<TextBlock Margin="0,1.5,6,0" Text="みやぐにあかり" /> <TextBlock Margin="0,1.5,6,0" Text="みやぐにあかり" />
<TextBlock Margin="0,1.5,6,0" Text="苇名剑圣有地绫" /> <TextBlock Margin="0,1.5,6,0" Text="苇名剑圣有地绫" />
<TextBlock Margin="0,1.5,6,0" Text="搔首弄姿那些年" />
<TextBlock Margin="0,1.5,6,0" Text="逐梦青年当自强" />
<TextBlock Margin="0,1.5,6,0" Text="哈基米南北路多" />
<TextBlock Margin="0,1.5,6,0" Text="休伯利安养老院" />
<TextBlock Margin="0,1.5,6,0" Text="SummerAlway_" /> <TextBlock Margin="0,1.5,6,0" Text="SummerAlway_" />
<TextBlock Margin="0,1.5,6,0" Text="照井黎Terui_Rei" />
<TextBlock Margin="0,1.5,6,0" Text="CHENDASHUAI" /> <TextBlock Margin="0,1.5,6,0" Text="CHENDASHUAI" />
<TextBlock Margin="0,1.5,6,0" Text="约翰·冯·海格力斯" />
<TextBlock Margin="0,1.5,6,0" Text="柚子_grapefruit_" /> <TextBlock Margin="0,1.5,6,0" Text="柚子_grapefruit_" />
<TextBlock Margin="0,1.5,6,0" Text="某不知名的GWM" />
<TextBlock Margin="0,1.5,6,0" Text="PolarPanda2333" />
<TextBlock Margin="0,1.5,6,0" Text="天下第一可爱芝麻" /> <TextBlock Margin="0,1.5,6,0" Text="天下第一可爱芝麻" />
<TextBlock Margin="0,1.5,6,0" Text="Hendestroyer149" /> <TextBlock Margin="0,1.5,6,0" Text="Hendestroyer149" />
<TextBlock Margin="0,1.5,6,0" Text="一名热爱mc的玩家" /> <TextBlock Margin="0,1.5,6,0" Text="一名热爱mc的玩家" />
@@ -677,10 +823,14 @@
<TextBlock Margin="0,1.5,6,0" Text="WerewolfwolfyXD" /> <TextBlock Margin="0,1.5,6,0" Text="WerewolfwolfyXD" />
<TextBlock Margin="0,1.5,6,0" Text="All systems normal" /> <TextBlock Margin="0,1.5,6,0" Text="All systems normal" />
<TextBlock Margin="0,1.5,6,0" Text="传奇幻想乡冰之勇者" /> <TextBlock Margin="0,1.5,6,0" Text="传奇幻想乡冰之勇者" />
<TextBlock Margin="0,1.5,6,0" Text="山有扶苏,隰有荷华" />
<TextBlock Margin="0,1.5,6,0" Text="月亮呼了星星一巴掌" />
<TextBlock Margin="0,1.5,6,0" Text="窝绰承保拾憶闪富拉" />
<TextBlock Margin="0,1.5,6,0" Text="NepentheAria-ゆせ" /> <TextBlock Margin="0,1.5,6,0" Text="NepentheAria-ゆせ" />
<TextBlock Margin="0,1.5,6,0" Text="Mercuryearedrabbit" /> <TextBlock Margin="0,1.5,6,0" Text="Mercuryearedrabbit" />
<TextBlock Margin="0,1.5,6,0" Text="Exeller(没钱的腐竹)" /> <TextBlock Margin="0,1.5,6,0" Text="Exeller(没钱的腐竹)" />
<TextBlock Margin="0,1.5,6,0" Text="荒漠迷城第一突破手凑友希娜" /> <TextBlock Margin="0,1.5,6,0" Text="荒漠迷城第一突破手凑友希娜" />
<TextBlock Margin="0,1.5,6,0" Text="沒錢點UberEats也不會變有錢" />
<TextBlock Margin="0,1.5,6,0" Text="我*:《蚊子》【*】亖**蚊子引雷" /> <TextBlock Margin="0,1.5,6,0" Text="我*:《蚊子》【*】亖**蚊子引雷" />
</WrapPanel> </WrapPanel>
<Grid Height="35"> <Grid Height="35">
@@ -690,7 +840,7 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" /> <local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://afdian.com/a/LTCat" /> <local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://meloong.com/afd/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid> </Grid>
@@ -5,9 +5,9 @@
Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面 '是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False Dim IsHiddenPage As Boolean = False
If ItemHelp.Checked AndAlso Setup.Get("UiHiddenOtherHelp") Then IsHiddenPage = True If ItemHelp.Checked AndAlso Settings.Get("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Setup.Get("UiHiddenOtherAbout") Then IsHiddenPage = True If ItemAbout.Checked AndAlso Settings.Get("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Setup.Get("UiHiddenOtherTest") Then IsHiddenPage = True If ItemTest.Checked AndAlso Settings.Get("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误,或尚未加载,则继续 '若页面错误,或尚未加载,则继续
If IsLoad AndAlso Not IsHiddenPage Then Return If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -16,9 +16,9 @@
PageSetupUI.HiddenRefresh() PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If IsPageSwitched Then Return If IsPageSwitched Then Return
If Not Setup.Get("UiHiddenOtherHelp") Then If Not Settings.Get("UiHiddenOtherHelp") Then
ItemHelp.SetChecked(True, False, False) ItemHelp.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ItemAbout.SetChecked(True, False, False) ItemAbout.SetChecked(True, False, False)
Else Else
ItemTest.SetChecked(True, False, False) ItemTest.SetChecked(True, False, False)
@@ -37,9 +37,9 @@
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If Not Setup.Get("UiHiddenOtherHelp") Then If Not Settings.Get("UiHiddenOtherHelp") Then
PageID = FormMain.PageSubType.OtherHelp PageID = FormMain.PageSubType.OtherHelp
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
PageID = FormMain.PageSubType.OtherAbout PageID = FormMain.PageSubType.OtherAbout
Else Else
PageID = FormMain.PageSubType.OtherTest PageID = FormMain.PageSubType.OtherTest
@@ -119,7 +119,7 @@
Hint("正在刷新……", Log:=False) Hint("正在刷新……", Log:=False)
End Sub End Sub
Public Shared Sub RefreshHelp() Public Shared Sub RefreshHelp()
Setup.Set("SystemHelpVersion", 0) '强制重新解压文件 Settings.Set("SystemHelpVersion", 0) '强制重新解压文件
FrmOtherHelp.PageLoaderRestart() FrmOtherHelp.PageLoaderRestart()
FrmOtherHelp.SearchBox.Text = "" FrmOtherHelp.SearchBox.Text = ""
End Sub End Sub
@@ -34,7 +34,7 @@
'添加控件 '添加控件
Dim ContMenu As ContextMenu = Nothing Dim ContMenu As ContextMenu = Nothing
Select Case Folder.Type Select Case Folder.Type
Case McFolder.Types.Original Case McFolder.Types.Vanilla
ContMenu = GetObjectFromXML( ContMenu = GetObjectFromXML(
<ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2"> <ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2">
<local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/> <local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/>
@@ -43,7 +43,7 @@
<local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="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 "/> <local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="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 "/>
</ContextMenu> </ContextMenu>
) )
Case McFolder.Types.RenamedOriginal Case McFolder.Types.RenamedVanilla
ContMenu = GetObjectFromXML( ContMenu = GetObjectFromXML(
<ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2"> <ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2">
<local:MyMenuItem x:Name="Remove" Header="复原名称" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/> <local:MyMenuItem x:Name="Remove" Header="复原名称" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/>
@@ -64,9 +64,9 @@
</ContextMenu> </ContextMenu>
) )
End Select End Select
If (Folder.Type = McFolder.Types.Original OrElse Folder.Type = McFolder.Types.RenamedOriginal) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.Count = 1 Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空" If (Folder.Type = McFolder.Types.Vanilla OrElse Folder.Type = McFolder.Types.RenamedVanilla) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.IsSingle Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空"
'注册事件 '注册事件
If Not Folder.Type = McFolder.Types.Original Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click)) If Not Folder.Type = McFolder.Types.Vanilla Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click))
CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click)) CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click))
CType(ContMenu.FindName("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click)) CType(ContMenu.FindName("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click))
CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click)) CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click))
@@ -133,7 +133,7 @@
If Not McFolderList.Any() Then If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹") Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
Else Else
Setup.Set("LaunchFolderSelect", McFolderList(0).Location.Replace(Path, "$")) McFolderSelected = McFolderList.First.Location
CType(FrmSelectLeft.PanList.Children(1), MyListItem).Checked = True CType(FrmSelectLeft.PanList.Children(1), MyListItem).Checked = True
End If End If
@@ -178,7 +178,7 @@
RunInThread( RunInThread(
Sub() Sub()
Try Try
If Not FolderPath.EndsWith("\") Then FolderPath &= "\" '加上斜杠…… If Not FolderPath.EndsWithF("\") Then FolderPath &= "\"
'检查文件夹权限 '检查文件夹权限
If Not CheckPermission(FolderPath) Then If Not CheckPermission(FolderPath) Then
If ShowHint Then If ShowHint Then
@@ -198,7 +198,7 @@
Next Next
End If End If
'判断是否已经添加过,若添加过则直接修改自定义名 '判断是否已经添加过,若添加过则直接修改自定义名
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|"))
Dim IsAdded As Boolean = False Dim IsAdded As Boolean = False
Dim IsReplace As Boolean = False Dim IsReplace As Boolean = False
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
@@ -220,9 +220,9 @@
'如果没有添加过,则添加进去 '如果没有添加过,则添加进去
If Not IsAdded Then Folders.Add(DisplayName & ">" & FolderPath) If Not IsAdded Then Folders.Add(DisplayName & ">" & FolderPath)
'保存 '保存
Setup.Set("LaunchFolders", Join(Folders.ToArray, "|")) Settings.Set("LaunchFolders", Folders.Join("|"))
'切换选择并更新列表 '切换选择并更新列表
Setup.Set("LaunchFolderSelect", FolderPath.Replace(Path, "$")) McFolderSelected = FolderPath
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
'提示 '提示
If IsReplace Then Return If IsReplace Then Return
@@ -243,8 +243,8 @@
Dim ModIndieFolder As New DirectoryInfo(Instance.PathVersion & "mods\") Dim ModIndieFolder As New DirectoryInfo(Instance.PathVersion & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return
'满足以上全部条件则视为根目录整合包 '满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Instance:=Instance) Settings.Set("VersionArgumentIndie", 2, Instance:=Instance)
Setup.Set("VersionArgumentIndieV2", False, Instance:=Instance) Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, LogLevel.Debug) Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, LogLevel.Debug)
Next Next
Catch ex As Exception Catch ex As Exception
@@ -260,29 +260,32 @@
Hint("在下载任务进行时,无法创建游戏文件夹!", HintType.Red) Hint("在下载任务进行时,无法创建游戏文件夹!", HintType.Red)
Return Return
End If End If
If Not Directory.Exists(Path & ".minecraft\") Then CreateMcFolderInCurrentPath()
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
Setup.Set("LaunchFolderSelect", "$.minecraft\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
Hint("新建 .minecraft 文件夹成功!", HintType.Green) Hint("新建 .minecraft 文件夹成功!", HintType.Green)
End Sub
Public Shared Sub CreateMcFolderInCurrentPath()
McFolderSelected = Path & ".minecraft\"
If Not Directory.Exists(McFolderSelected) Then
Directory.CreateDirectory(McFolderSelected)
Directory.CreateDirectory(McFolderSelected & "versions\")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
End If End If
McFolderListLoader.Start(IsForceRestart:=True) AddFolder(McFolderSelected, GetFolderNameFromPath(Path), False)
End Sub End Sub
'右键菜单 '右键菜单
Public Sub Remove_Click(sender As Object, e As RoutedEventArgs) Public Sub Remove_Click(sender As Object, e As RoutedEventArgs)
Try Try
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Target As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
'若为 “移除”,则提醒是否删除 PCL 的配置文件 '若为 “移除”,则提醒是否删除 PCL 的配置文件
If Folder.Type = McFolder.Types.Custom Then If Target.Type = McFolder.Types.Custom Then
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件?" & vbCrLf & "这包括各个版本的独立设置(如自定义图标、第三方登录配置)等,对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消") Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件?" & vbCrLf & "这包括各个版本的独立设置(如自定义图标、第三方登录配置)等,对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1 Case 1
'删除配置文件 '删除配置文件
If File.Exists(Folder.Location & "PCL.ini") Then File.Delete(Folder.Location & "PCL.ini") If File.Exists(Target.Location & "PCL.ini") Then File.Delete(Target.Location & "PCL.ini")
If Directory.Exists(Folder.Location & "versions\") Then If Directory.Exists(Target.Location & "versions\") Then
For Each InstanceInfo In New DirectoryInfo(Folder.Location & "versions\").EnumerateDirectories For Each InstanceInfo In New DirectoryInfo(Target.Location & "versions\").EnumerateDirectories
If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then Directory.Delete(InstanceInfo.FullName & "\PCL\", True) If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then Directory.Delete(InstanceInfo.FullName & "\PCL\", True)
Next Next
End If End If
@@ -293,61 +296,59 @@
Return Return
End Select End Select
End If End If
'若修改了本部分代码,应对应修改 Delete_Click 中的代码 Dim DeletedName As String = RemoveFolderFromSetup(Target)
'获取并删除列表项 Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|"))
Dim Name As String = ""
For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Location) Then
Name = Folders(i).ToString.BeforeFirst(">")
Folders.RemoveAt(i)
Exit For
End If
Next
'保存
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
Hint(If(Folder.Type = McFolder.Types.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
Log(ex, "从列表中移除游戏文件夹失败", LogLevel.Feedback) Log(ex, "从列表中移除游戏文件夹失败", LogLevel.Feedback)
End Try End Try
End Sub End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs) Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Target As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
Dim DeleteText As String = If((Folder.Type = McFolder.Types.Original OrElse Folder.Type = McFolder.Types.RenamedOriginal) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.Count = 1, "清空", "删除") Dim DeleteText As String = If((Target.Type = McFolder.Types.Vanilla OrElse Target.Type = McFolder.Types.RenamedVanilla) AndAlso Target.Location = Path & ".minecraft\" AndAlso McFolderList.IsSingle, "清空", "删除")
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf & "目标文件夹:" & Folder.Location & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失,且不可恢复!", "删除警告", "取消", "确认", "取消") <> 2 Then Return If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf &
If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件,这些文件也会被一同删除!" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失,请在仔细确认后再继续!" & vbCrLf & "目标文件夹:" & Folder.Location & vbCrLf & vbCrLf & "这是最后一次警告!", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Return "目标文件夹:" & Target.Location & vbCrLf & vbCrLf &
'移出列表 "该文件夹中的游戏存档、游戏版本,以及 MC 之外的其他文件,都会永久丢失,不可恢复!", "警告", "取消", "确认", "取消") <> 2 Then Return
If Folder.Type = McFolder.Types.Custom Then If MyMsgBoxInput("删除确认",
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) "该文件夹中的游戏存档、游戏版本,以及 MC 之外的其他文件,都会永久丢失,不可恢复!" & vbCrLf &
For i = 0 To Folders.Count - 1 "目标文件夹:" & Target.Location & vbCrLf & vbCrLf &
If Folders(i) = "" Then Exit For "如果确实要删除,请在下面输入【确认删除】以继续。",
If Folders(i).ToString.EndsWith(Folder.Location) Then ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateSame("确认删除", $"请输入 {vbLQ}确认删除{vbRQ} 这四个字!")},
'Name = Folders(i).ToString.Before(">") Button1:="永久删除文件夹", Button2:="取消", IsWarn:=True) Is Nothing Then Return
Folders.RemoveAt(i) RemoveFolderFromSetup(Target)
Exit For
End If
Next
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
End If
RunInNewThread( RunInNewThread(
Sub() Sub()
'删除文件夹 '删除文件夹
Try Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Blue) Hint("正在" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Blue)
DeleteDirectory(Folder.Location) DeleteDirectory(Target.Location)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Location) If DeleteText = "清空" Then Directory.CreateDirectory(Target.Location)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Green) Hint("已" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint) Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", LogLevel.Hint)
Finally Finally
'刷新列表 '刷新列表
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
End Try End Try
End Sub, "Folder Delete " & GetUuid(), ThreadPriority.BelowNormal) End Sub, "Folder Delete " & GetUuid(), ThreadPriority.BelowNormal)
End Sub End Sub
''' <summary>
''' 从设置的文件夹列表中删除指定的文件夹。
''' 返回被删除的文件夹的显示名称。如果没有,返回 Nothing。
''' </summary>
Private Shared Function RemoveFolderFromSetup(Target As McFolder) As String
Dim DeletedName As String = Nothing
Dim Folders = Settings.Get("LaunchFolders").ToString.Split({"|"c}, StringSplitOptions.RemoveEmptyEntries).ToList
For Each Folder In Folders.ToList
If Not Folder.EndsWithF(Target.Location) Then Continue For
DeletedName = Folder.BeforeFirst(">")
Folders.Remove(Folder)
Exit For
Next
Settings.Set("LaunchFolders", Folders.Join("|"))
Return DeletedName
End Function
Public Sub Open_Click(sender As Object, e As RoutedEventArgs) Public Sub Open_Click(sender As Object, e As RoutedEventArgs)
OpenExplorer(CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Info) OpenExplorer(CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Info)
End Sub End Sub
@@ -371,7 +372,7 @@
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})}) New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Return If String.IsNullOrWhiteSpace(NewName) Then Return
'修改自定义名 '修改自定义名
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|"))
Dim IsAdded As Boolean = False Dim IsAdded As Boolean = False
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i) Dim FolderCurrent As String = Folders(i)
@@ -391,7 +392,7 @@
If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Location) If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Location)
Hint("文件夹名称已更新为 " & NewName & " !", HintType.Green) Hint("文件夹名称已更新为 " & NewName & " !", HintType.Green)
'保存 '保存
Setup.Set("LaunchFolders", Join(Folders.ToArray, "|")) Settings.Set("LaunchFolders", Folders.Join("|"))
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
Log(ex, "重命名文件夹失败", LogLevel.Feedback) Log(ex, "重命名文件夹失败", LogLevel.Feedback)
@@ -408,7 +409,7 @@
Return Return
End If End If
'更换 '更换
Setup.Set("LaunchFolderSelect", CType(sender.Tag, McFolder).Location.Replace(Path, "$")) McFolderSelected = CType(sender.Tag, McFolder).Location
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Sub End Sub
@@ -102,7 +102,7 @@
Else Else
LabEmptyTitle.Text = "无可用版本" LabEmptyTitle.Text = "无可用版本"
LabEmptyContent.Text = "未找到任何版本的游戏,请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏,请在左边的列表中选择添加文件夹,选择 .minecraft 文件夹将其导入。" LabEmptyContent.Text = "未找到任何版本的游戏,请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏,请在左边的列表中选择添加文件夹,选择 .minecraft 文件夹将其导入。"
BtnEmptyDownload.Visibility = If(Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible) BtnEmptyDownload.Visibility = If(Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If End If
Else Else
PanBack.Visibility = Visibility.Visible PanBack.Visibility = Visibility.Visible
@@ -184,7 +184,6 @@
If New McInstance(Instance.PathVersion).Check Then If New McInstance(Instance.PathVersion).Check Then
'正常版本 '正常版本
McInstanceSelected = Instance McInstanceSelected = Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmMain.PageBack() FrmMain.PageBack()
Else Else
'错误版本 '错误版本
@@ -246,7 +245,7 @@
End Sub End Sub
Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded
Dim NewVisibility = If((Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible) Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible)
If BtnEmptyDownload.Visibility <> NewVisibility Then If BtnEmptyDownload.Visibility <> NewVisibility Then
BtnEmptyDownload.Visibility = NewVisibility BtnEmptyDownload.Visibility = NewVisibility
PanLoad.TriggerForceResize() PanLoad.TriggerForceResize()
@@ -1,767 +0,0 @@
Public Class ModSetup
Private Const VersionSetup As Integer = 1
''' <summary>
''' 设置列表。
''' </summary>
Private ReadOnly SetupDict As New Dictionary(Of String, SetupEntry) From {
{"Identify", New SetupEntry("", Source:=SetupSource.Registry)},
{"WindowHeight", New SetupEntry(550)},
{"WindowWidth", New SetupEntry(900)},
{"HintDownloadThread", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintNotice", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintDownload", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintHide", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintHandInstall", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintBuy", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintClearRubbish", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintUpdateMod", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintCustomCommand", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintCustomWarn", New SetupEntry(False, Source:=SetupSource.Registry)},
{"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)}, '仅老版本兼容,现已换用 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)},
{"SystemHighestSavedBetaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestBetaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestAlphaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemSetupVersionReg", New SetupEntry(VersionSetup, Source:=SetupSource.Registry)},
{"SystemSetupVersionIni", New SetupEntry(VersionSetup)},
{"SystemHelpVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"SystemDebugMode", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemDebugAnim", New SetupEntry(9, Source:=SetupSource.Registry)},
{"SystemDebugDelay", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemDebugSkipCopy", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemSystemCache", New SetupEntry("", Source:=SetupSource.Registry)},
{"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)},
{"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)},
{"CacheDrops", New SetupEntry("", 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)},
{"CacheMsOAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Migrated", New SetupEntry(False, Source:=SetupSource.Registry)},
{"CacheMsV2OAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Access", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2ProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Uuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Name", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideClient", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideUsername", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNidePass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideServer", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthClient", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthUsername", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthPass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerServer", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerRegister", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheDownloadFolder", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheJavaListVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LoginRemember", New SetupEntry(True, Source:=SetupSource.Registry, Encoded:=True)},
{"LoginLegacyName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginMsJson", New SetupEntry("{}", Source:=SetupSource.Registry, Encoded:=True)}, '{UserName: OAuthToken, ...}
{"LoginNideEmail", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginNidePass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginAuthEmail", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginAuthPass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginType", New SetupEntry(McLoginType.Legacy, Source:=SetupSource.Registry)},
{"LoginPageType", New SetupEntry(0)},
{"LaunchSkinID", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchSkinType", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LaunchSkinSlim", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LaunchVersionSelect", New SetupEntry("")},
{"LaunchFolderSelect", New SetupEntry("")},
{"LaunchFolders", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchArgumentTitle", New SetupEntry("")},
{"LaunchArgumentInfo", New SetupEntry("PCL")},
{"LaunchArgumentJavaSelect", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchArgumentJavaAll", New SetupEntry("[]", Source:=SetupSource.Registry)},
{"LaunchArgumentIndie", New SetupEntry(0)},
{"LaunchArgumentIndieV2", New SetupEntry(4)},
{"LaunchArgumentVisible", New SetupEntry(5, Source:=SetupSource.Registry)},
{"LaunchArgumentPriority", New SetupEntry(1, Source:=SetupSource.Registry)},
{"LaunchArgumentWindowWidth", New SetupEntry(854)},
{"LaunchArgumentWindowHeight", New SetupEntry(480)},
{"LaunchArgumentWindowType", New SetupEntry(1)},
{"LaunchArgumentRam", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LaunchAdvanceJvm", New SetupEntry("-XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")},
{"LaunchAdvanceGame", New SetupEntry("")},
{"LaunchAdvanceRun", New SetupEntry("")},
{"LaunchAdvanceRunWait", New SetupEntry(True)},
{"LaunchAdvanceDisableJLW", New SetupEntry(False)},
{"LaunchAdvanceGraphicCard", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LaunchAdvanceGC", New SetupEntry(1)},
{"LaunchRamType", New SetupEntry(0)},
{"LaunchRamCustom", New SetupEntry(15)},
{"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkLatencyMode", New SetupEntry(0, 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)},
{"ToolDownloadSource", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadVersion", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadTranslateV2", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadMod", New SetupEntry(2, Source:=SetupSource.Registry)},
{"ToolModLocalNameStyle", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateReleaseLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"ToolUpdateSnapshotLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"UiLauncherTransparent", New SetupEntry(600)}, '避免与 PCL1 设置冲突(UiLauncherOpacity)
{"UiLauncherHue", New SetupEntry(180)},
{"UiLauncherSat", New SetupEntry(80)},
{"UiLauncherDelta", New SetupEntry(90)},
{"UiLauncherLight", New SetupEntry(20)},
{"UiLauncherTheme", New SetupEntry(0)},
{"UiLauncherThemeGold", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherThemeHide", New SetupEntry("0|1|2|3|4", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherThemeHide2", New SetupEntry("0|1|2|3|4", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherLogo", New SetupEntry(True)},
{"UiLauncherEmail", New SetupEntry(False)},
{"UiBackgroundColorful", New SetupEntry(True)},
{"UiBackgroundOpacity", New SetupEntry(1000)},
{"UiBackgroundBlur", New SetupEntry(0)},
{"UiBackgroundSuit", New SetupEntry(0)},
{"UiCustomType", New SetupEntry(0)},
{"UiCustomPreset", New SetupEntry(0)},
{"UiCustomNet", New SetupEntry("")},
{"UiLogoType", New SetupEntry(1)},
{"UiLogoText", New SetupEntry("")},
{"UiLogoLeft", New SetupEntry(False)},
{"UiMusicVolume", New SetupEntry(500)},
{"UiMusicStop", New SetupEntry(False)},
{"UiMusicStart", New SetupEntry(False)},
{"UiMusicRandom", New SetupEntry(True)},
{"UiMusicAuto", New SetupEntry(True)},
{"UiHiddenPageDownload", New SetupEntry(False)},
{"UiHiddenPageLink", New SetupEntry(False)},
{"UiHiddenPageSetup", New SetupEntry(False)},
{"UiHiddenPageOther", New SetupEntry(False)},
{"UiHiddenFunctionSelect", New SetupEntry(False)},
{"UiHiddenFunctionModUpdate", New SetupEntry(False)},
{"UiHiddenFunctionHidden", New SetupEntry(False)},
{"UiHiddenSetupLaunch", New SetupEntry(False)},
{"UiHiddenSetupUi", New SetupEntry(False)},
{"UiHiddenSetupLink", New SetupEntry(False)},
{"UiHiddenSetupSystem", New SetupEntry(False)},
{"UiHiddenOtherHelp", New SetupEntry(False)},
{"UiHiddenOtherFeedback", New SetupEntry(False)},
{"UiHiddenOtherVote", New SetupEntry(False)},
{"UiHiddenOtherAbout", New SetupEntry(False)},
{"UiHiddenOtherTest", New SetupEntry(False)},
{"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableModUpdate", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceGC", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Instance)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Instance)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Instance)},
{"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Instance)},
{"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionServerNide", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Instance)}
}
#Region "基础"
Private Enum SetupSource
Normal
Registry
Instance
End Enum
Private Class SetupEntry
Public Encoded As Boolean
Public DefaultValue
Public DefaultValueEncoded
Public Value
Public Source As SetupSource
''' <summary>
''' 加载状态:0/未读取 1/已读取未处理 2/已处理
''' 我也不知道当年写这坨的时候为啥没用 Enum……
''' </summary>
Public State As Byte = 0
Public Type As Type
Public Sub New(Value, Optional Source = SetupSource.Normal, Optional Encoded = False)
Try
Me.DefaultValue = Value
Me.Encoded = Encoded
Me.Value = Value
Me.Source = Source
Me.Type = If(Value, New Object).GetType
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & Identify), Value)
Catch ex As Exception
Log(ex, "初始化 SetupEntry 失败", LogLevel.Feedback) '#5095 的 fallback
End Try
End Sub
End Class
''' <summary>
''' 改变某个设置项的值。
''' </summary>
Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
[Set](Key, Value, SetupDict(Key), ForceReload, Instance)
End Sub
''' <summary>
''' 写入某个未经加密的设置项。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Sub SetSafe(Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止写入加密设置项:" & Key)
[Set](Key, Instance, ForceReload, Instance)
End Sub
Private Sub [Set](Key As String, Value As Object, E As SetupEntry, ForceReload As Boolean, Instance As McInstance)
Try
Value = CTypeDynamic(Value, E.Type)
If E.State = 2 Then
'如果已应用,且值相同,则无需再次更改
If E.Value = Value AndAlso Not ForceReload Then Return
Else
'如果未应用,则直接更改并应用
If E.Source <> SetupSource.Instance Then E.State = 2
End If
'设置新值
E.Value = Value
'写入值
If E.Encoded Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & Identify)
Catch ex As Exception
Log(ex, "加密设置失败:" & Key, LogLevel.Developer)
End Try
End If
Select Case E.Source
Case SetupSource.Normal
WriteIni("Setup", Key, Value)
Case SetupSource.Registry
WriteReg(Key, Value)
Case SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本")
WriteIni(Instance.PathVersion & "PCL\Setup.ini", Key, Value)
End Select
'应用
'例如 VersionServerLogin 要求在设置之后再引发事件
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {Value})
Catch ex As Exception
Log(ex, "设置设置项时出错(" & Key & ", " & Value & ")", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 应用某个设置项的值。
''' </summary>
Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
Return Load(Key, SetupDict(Key), ForceReload, Instance)
End Function
Private Function Load(Key As String, E As SetupEntry, ForceReload As Boolean, Instance As McInstance)
'如果已经应用过,则什么也不干
If E.State = 2 AndAlso Not ForceReload Then Return E.Value
'读取,应用并设置状态
Read(Key, E, Instance)
If E.Source <> SetupSource.Instance Then E.State = 2
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {E.Value})
Return E.Value
End Function
''' <summary>
''' 获取某个设置项的值。
''' </summary>
Public Function [Get](Key As String, Optional Instance As McInstance = Nothing)
If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
Return [Get](Key, SetupDict(Key), Instance)
End Function
''' <summary>
''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Function GetSafe(Key As String, Optional Instance As McInstance = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止读取加密设置项:" & Key)
Return [Get](Key, Instance)
End Function
Private Function [Get](Key As String, E As SetupEntry, Instance As McInstance)
'获取强制值
Dim Force As String = ForceValue(Key)
If Force IsNot Nothing Then
E.Value = CTypeDynamic(Force, E.Type)
E.State = 1
End If
'如果尚未读取过,则读取
If E.State = 0 Then
Read(Key, E, Instance)
If E.Source <> SetupSource.Instance Then E.State = 1
End If
'返回现在的值
Return E.Value
End Function
''' <summary>
''' 初始化某个设置项的值。
''' </summary>
Public Sub Reset(Key As String, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
Dim E As SetupEntry = SetupDict(Key)
[Set](Key, E.DefaultValue, E, ForceReload, Instance)
Select Case SetupDict(Key).Source
Case SetupSource.Normal
DeleteIniKey("Setup", Key)
Case SetupSource.Registry
DeleteReg(Key)
Case Else 'SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本")
DeleteIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
End Sub
''' <summary>
''' 获取某个设置项的默认值。
''' </summary>
Public Function GetDefault(Key As String) As String
Return SetupDict(Key).DefaultValue
End Function
''' <summary>
''' 某个设置项是否从未被设置过。
''' </summary>
Public Function IsUnset(Key As String, Optional Instance As McInstance = Nothing) As Boolean
Select Case SetupDict(Key).Source
Case SetupSource.Normal
Return Not HasIniKey("Setup", Key)
Case SetupSource.Registry
Return Not HasReg(Key)
Case Else 'SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本")
Return Not HasIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
End Function
''' <summary>
''' 读取设置。
''' </summary>
Private Sub Read(Key As String, ByRef E As SetupEntry, Instance As McInstance)
Try
If Not E.State = 0 Then Return
Dim SourceValue As String = Nothing '先用 String 储存,避免类型转换
Select Case E.Source
Case SetupSource.Normal
SourceValue = ReadIni("Setup", Key, E.DefaultValueEncoded)
Case SetupSource.Registry
SourceValue = ReadReg(Key, E.DefaultValueEncoded)
Case SetupSource.Instance
If Instance Is Nothing Then
Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本")
Else
SourceValue = ReadIni(Instance.PathVersion & "PCL\Setup.ini", Key, E.DefaultValueEncoded)
End If
End Select
If E.Encoded Then
If SourceValue.Equals(E.DefaultValueEncoded) Then
SourceValue = E.DefaultValue
Else
Try
SourceValue = SecretDecrypt(SourceValue, "PCL" & Identify)
Catch ex As Exception
Log(ex, "解密设置失败:" & Key, LogLevel.Developer)
SourceValue = E.DefaultValue
Setup.Set(Key, E.DefaultValue, True)
End Try
End If
End If
E.Value = CTypeDynamic(SourceValue, E.Type)
Catch ex As Exception
Log(ex, "读取设置失败:" & Key, LogLevel.Hint)
E.Value = CTypeDynamic(E.DefaultValue, E.Type)
End Try
End Sub
'对部分设置强制赋值
Private Function ForceValue(Key As String) As String
#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
#End Region
#Region "Launch"
'切换选择
Public Sub LaunchVersionSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 版本:" & Value)
WriteIni(McFolderSelected & "PCL.ini", "Version", If(IsNothing(McInstanceSelected), "", McInstanceSelected.Name))
End Sub
Public Sub LaunchFolderSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 文件夹:" & Value.ToString.Replace("$", Path))
McFolderSelected = Value.ToString.Replace("$", Path)
End Sub
'游戏内存
Public Sub LaunchRamType(Type As Integer)
If FrmSetupLaunch Is Nothing Then Return
FrmSetupLaunch.RamType(Type)
End Sub
'离线皮肤
Public Sub LaunchSkinType(Value As Integer)
RunInUi(Sub()
If Not IsNothing(FrmSetupLaunch) Then
Select Case Value
Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 3 '正版
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Visible
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 4 '自定义
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Visible
End Select
FrmSetupLaunch.CardSkin.TriggerForceResize()
End If
PageLaunchLeft.SkinLegacy.Start()
End Sub)
End Sub
Public Sub LaunchSkinID(Value As String)
PageLaunchLeft.SkinLegacy.Start()
End Sub
#End Region
#Region "Tool"
Public Sub ToolDownloadThread(Value As Integer)
NetTaskThreadLimit = Value + 1
End Sub
Public Sub ToolDownloadCert(Value As Boolean)
ServicePointManager.ServerCertificateValidationCallback =
Function(Sender, Certificate, Chain, Failure)
Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest)
If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证
'基于 #3018 和 #5879,只在访问正版登录 API 时跳过证书验证
Log($"[System] 未通过 SSL 证书验证({Failure}),提供的证书为 {Certificate?.Subject},URL:{Request?.Address}", LogLevel.Debug)
If Request Is Nothing Then
Return Not Value
ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then
Return Not Value '根据设置决定是否忽略错误
Else
Return False
End If
End Function
End Sub
Public Sub ToolDownloadSpeed(Value As Integer)
If Value <= 14 Then
NetTaskSpeedLimitHigh = (Value + 1) * 0.1 * 1024 * 1024L
ElseIf Value <= 31 Then
NetTaskSpeedLimitHigh = (Value - 11) * 0.5 * 1024 * 1024L
ElseIf Value <= 41 Then
NetTaskSpeedLimitHigh = (Value - 21) * 1024 * 1024L
Else
NetTaskSpeedLimitHigh = -1
End If
End Sub
#End Region
#Region "UI"
'启动器
Public Sub UiLauncherTransparent(Value As Integer)
FrmMain.Opacity = Value / 1000 + 0.4
End Sub
Public Sub UiLauncherTheme(Value As Integer)
ThemeRefresh(Value)
End Sub
Public Sub UiBackgroundColorful(Value As Boolean)
ThemeRefresh()
End Sub
'背景图片
Public Sub UiBackgroundOpacity(Value As Integer)
FrmMain.ImgBack.Opacity = Value / 1000
End Sub
Public Sub UiBackgroundBlur(Value As Integer)
If Value = 0 Then
FrmMain.ImgBack.Effect = Nothing
Else
FrmMain.ImgBack.Effect = New Effects.BlurEffect With {.Radius = Value + 1}
End If
FrmMain.ImgBack.Margin = New Thickness(-(Value + 1) / 1.8)
End Sub
Public Sub UiBackgroundSuit(Value As Integer)
If FrmMain.ImgBack.Background Is Nothing Then Return
Dim Brush As ImageBrush = CType(FrmMain.ImgBack.Background, ImageBrush)
If Value = 0 Then
'智能:当图片较小时平铺,较大时适应
If Brush.ImageSource.Width < FrmMain.PanMain.ActualWidth / 2 AndAlso Brush.ImageSource.Height < FrmMain.PanMain.ActualHeight / 2 Then
Value = 4 '平铺
Else
Value = 2 '适应
End If
End If
Brush.Stretch = Stretch.UniformToFill
Brush.TileMode = TileMode.None
Brush.Viewport = New Rect(0, 0, 1, 1)
Brush.ViewportUnits = BrushMappingMode.RelativeToBoundingBox
Select Case Value
Case 2 '适应
Case 3 '拉伸
Brush.Stretch = Stretch.Fill
Case 4 '平铺
Brush.Stretch = Stretch.None
Brush.TileMode = TileMode.Tile
Brush.Viewport = New Rect(0, 0, Brush.ImageSource.Width, Brush.ImageSource.Height)
Brush.ViewportUnits = BrushMappingMode.Absolute
Case 1 '中
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Center
Case 5 '左上
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Top
Case 6 '右上
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Top
Case 7 '左下
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Bottom
Case 8 '右下
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Bottom
Case 9 '左
Brush.AlignmentX = AlignmentX.Left
Brush.AlignmentY = AlignmentY.Center
Case 10 '右
Brush.AlignmentX = AlignmentX.Right
Brush.AlignmentY = AlignmentY.Center
Case 11 '上
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Top
Case 12 '下
Brush.AlignmentX = AlignmentX.Center
Brush.AlignmentY = AlignmentY.Bottom
End Select
End Sub
'主页
Public Sub UiCustomType(Value As Integer)
If FrmSetupUI Is Nothing Then Return
Select Case Value
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
Case 1 '本地
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.None)
Case 2 '联网
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
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
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
End Select
FrmSetupUI.CardCustom.TriggerForceResize()
End Sub
'顶部栏
Public Sub UiLogoType(Value As Integer)
Select Case Value
Case 0 '无
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Visible
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 1 '默认
FrmMain.ShapeTitleLogo.Visibility = Visibility.Visible
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 2 '文本
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Visible
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Visible
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Setup.Load("UiLogoText", True)
Case 3 '图片
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Visible
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png"
Catch ex As Exception
FrmMain.ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", LogLevel.Msgbox)
End Try
End Select
Setup.Load("UiLogoLeft", True)
If Not IsNothing(FrmSetupUI) Then FrmSetupUI.CardLogo.TriggerForceResize()
End Sub
Public Sub UiLogoText(Value As String)
FrmMain.LabTitleLogo.Text = Value
End Sub
Public Sub UiLogoLeft(Value As Boolean)
FrmMain.PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Value AndAlso (Setup.Get("UiLogoType") = 0), 0, 1), GridUnitType.Star)
End Sub
'功能隐藏
Public Sub UiHiddenPageLink(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageDownload(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageSetup(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageOther(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenFunctionSelect(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenFunctionModUpdate(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenFunctionHidden(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupLaunch(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupUi(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupLink(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupSystem(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherHelp(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherFeedback(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherVote(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherAbout(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherTest(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
#End Region
#Region "System"
'调试选项
Public Sub SystemDebugMode(Value As Boolean)
ModeDebug = Value
End Sub
Public Sub SystemDebugAnim(Value As Integer)
AniSpeed = If(Value >= 30, 200, MathClamp(Value * 0.1 + 0.1, 0.1, 3))
End Sub
#End Region
#Region "Version"
'游戏内存
Public Sub VersionRamType(Type As Integer)
If FrmInstanceSetup Is Nothing Then Return
FrmInstanceSetup.RamType(Type)
End Sub
'服务器
Public Sub VersionServerLogin(Type As Integer)
If FrmInstanceSetup Is Nothing Then Return
'为第三方登录清空缓存以更新描述
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "")
If PageInstanceLeft.Instance Is Nothing Then Return
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
#End Region
End Class
@@ -32,18 +32,25 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" /> <TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentIndieV2" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentIndieV2" Grid.Column="1" <local:MyComboBox local:SettingService.Key="LaunchArgumentIndieV2" x:Name="ComboArgumentIndieV2"
Grid.Row="0" Grid.ColumnSpan="2" Grid.Column="1"
ToolTip="当安装新版本时,据此自动设置新版本的隔离选项。&#xa;若想调整已有版本的隔离策略,请前往它的版本设置。"> ToolTip="当安装新版本时,据此自动设置新版本的隔离选项。&#xa;若想调整已有版本的隔离策略,请前往它的版本设置。">
<local:MyComboBoxItem Content="关闭" ToolTip="所有版本均使用同一档案,存档、Mod、资源包等均为公用。&#xa;若存在多个安装了 Mod 的版本,可能会导致 Mod 冲突。" /> <local:MyComboBoxItem Content="关闭"
<local:MyComboBoxItem Content="隔离可安装 Mod 的版本" IsSelected="True" ToolTip="可安装 Mod 的版本(例如 Forge、Fabric)均互相独立以避免 Mod 冲突,其他版本(例如原版)则不会被隔离。" /> ToolTip="所有版本均使用同一档案,存档、Mod、资源包等均为公用。&#xa;若存在多个安装了 Mod 的版本,可能会导致 Mod 冲突。" />
<local:MyComboBoxItem Content="隔离非正式版" ToolTip="将 Minecraft 快照、预发布版、远古版本、愚人节版本与其他版本进行隔离" /> <local:MyComboBoxItem Content="隔离可安装 Mod 的版本"
ToolTip="可安装 Mod 的版本(例如 Forge、Fabric)均互相独立以避免 Mod 冲突,其他版本(例如原版)则不会被隔离。" />
<local:MyComboBoxItem Content="隔离非正式版"
ToolTip="将 Minecraft 快照、预发布版、远古版本、愚人节版本与其他版本进行隔离" />
<local:MyComboBoxItem Content="隔离可安装 Mod 的版本与非正式版" /> <local:MyComboBoxItem Content="隔离可安装 Mod 的版本与非正式版" />
<local:MyComboBoxItem Content="隔离所有版本" ToolTip="不同版本之间的存档、Mod、资源包等均不互通。&#xa;这会导致不同原版版本间的存档不能共用,所以一般不推荐。" /> <local:MyComboBoxItem Content="隔离所有版本"
ToolTip="不同版本之间的存档、Mod、资源包等均不互通。&#xa;这会导致不同原版版本间的存档不能共用,所以一般不推荐。" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" /> <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;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" /> <local:MyTextBox local:SettingService.Key="LaunchArgumentTitle"
Grid.Row="2" Grid.ColumnSpan="2" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" /> <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 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。"> <local:MyTextBox local:SettingService.Key="LaunchArgumentInfo"
Grid.Row="4" Grid.ColumnSpan="2" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateExcept> <local:ValidateExcept>
<local:ValidateExcept.Excepts> <local:ValidateExcept.Excepts>
@@ -55,18 +62,18 @@
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
<TextBlock VerticalAlignment="Center" Grid.Row="6" HorizontalAlignment="Left" Text="启动器可见性" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="6" HorizontalAlignment="Left" Text="启动器可见性" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentVisibie" Grid.Row="6" Grid.ColumnSpan="2" Tag="LaunchArgumentVisible" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="LaunchArgumentVisible"
x:Name="ComboArgumentVisibie" Grid.Row="6" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="游戏启动后立即关闭" /> <local:MyComboBoxItem Content="游戏启动后立即关闭" />
<local:MyComboBoxItem Content="" IsEnabled="False" Visibility="Collapsed" /> <local:MyComboBoxItem Content="游戏启动后隐藏,游戏退出后自动关闭" local:SettingService.Value="2" />
<local:MyComboBoxItem Content="游戏启动后隐藏,游戏退出后自动关闭" /> <local:MyComboBoxItem Content="游戏启动后隐藏,游戏退出后重新打开" local:SettingService.Value="3" />
<local:MyComboBoxItem Content="游戏启动后隐藏,游戏退出后重新打开" /> <local:MyComboBoxItem Content="游戏启动后最小化" local:SettingService.Value="4" />
<local:MyComboBoxItem Content="游戏启动后最小化" /> <local:MyComboBoxItem Content="游戏启动后仍保持不变" local:SettingService.Value="5" />
<local:MyComboBoxItem Content="游戏启动后仍保持不变" IsSelected="True" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="8" HorizontalAlignment="Left" Text="进程优先级" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="8" HorizontalAlignment="Left" Text="进程优先级" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentPriority" Grid.Row="8" Grid.ColumnSpan="2" Tag="LaunchArgumentPriority" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="LaunchArgumentPriority" Grid.Row="8" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="高(优先保证游戏运行,游戏性能更佳,但可能造成其他程序卡顿)" /> <local:MyComboBoxItem Content="高(优先保证游戏运行,游戏性能更佳,但可能造成其他程序卡顿)" />
<local:MyComboBoxItem Content="中(平衡)" IsSelected="True" /> <local:MyComboBoxItem Content="中(平衡)" />
<local:MyComboBoxItem Content="低(优先保证其他程序运行,但可能让游戏卡顿,适合挂机时使用)" /> <local:MyComboBoxItem Content="低(优先保证其他程序运行,但可能让游戏卡顿,适合挂机时使用)" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="窗口大小" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="窗口大小" Margin="0,0,25,0" />
@@ -77,20 +84,22 @@
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyComboBox x:Name="ComboArgumentWindowType" Tag="LaunchArgumentWindowType"> <local:MyComboBox local:SettingService.Key="LaunchArgumentWindowType" x:Name="ComboArgumentWindowType">
<local:MyComboBoxItem Content="全屏" /> <local:MyComboBoxItem Content="全屏" />
<local:MyComboBoxItem Content="默认" IsSelected="True" /> <local:MyComboBoxItem Content="默认" />
<local:MyComboBoxItem Content="与启动器尺寸一致" /> <local:MyComboBoxItem Content="与启动器尺寸一致" />
<local:MyComboBoxItem Content="自定义尺寸" ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" /> <local:MyComboBoxItem Content="自定义尺寸" ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" />
<local:MyComboBoxItem Content="最大化" /> <local:MyComboBoxItem Content="最大化" />
</local:MyComboBox> </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 local:SettingService.Key="LaunchArgumentWindowWidth" x:Name="TextArgumentWindowWidth"
Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="1" Margin="50,0,0,0" Width="60" HorizontalContentAlignment="Center" Text="854">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="99999" /> <local:ValidateInteger Min="1" Max="99999" />
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
<TextBlock x:Name="LabArgumentWindowMiddle" Visibility="Collapsed" Grid.Column="2" Text=" × " VerticalAlignment="Center" FontSize="18" /> <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" <local:MyTextBox local:SettingService.Key="LaunchArgumentWindowHeight" x:Name="TextArgumentWindowHeight"
Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="3" Width="60" HorizontalContentAlignment="Center" Text="480"
ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5"> ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="99999" /> <local:ValidateInteger Min="1" Max="99999" />
@@ -98,7 +107,7 @@
</local:MyTextBox> </local:MyTextBox>
</Grid> </Grid>
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" MaxDropDownHeight="240" <local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1"
ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它"> ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" /> <ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />--> <!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
@@ -131,11 +140,14 @@
<RowDefinition Height="9" /> <RowDefinition Height="9" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<local:MyRadioBox Text="自动配置" Width="110" Checked="True" x:Name="RadioRamType0" Tag="LaunchRamType/0" Margin="0,0,20,0" <local:MyRadioBox local:SettingService.Key="LaunchRamType" local:SettingService.Value="0"
Text="自动配置" Width="110" Checked="True" x:Name="RadioRamType0" Margin="0,0,20,0"
ToolTip="根据安装的 Mod 量与电脑剩余内存,动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" /> ToolTip="根据安装的 Mod 量与电脑剩余内存,动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" />
<local:MyRadioBox Grid.Row="2" Text="自定义" x:Name="RadioRamType1" Tag="LaunchRamType/1" Margin="0,0,20,0" /> <local:MyRadioBox local:SettingService.Key="LaunchRamType" local:SettingService.Value="1"
<local:MySlider Grid.Row="2" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="LaunchRamCustom" MaxValue="49" Value="13" /> Grid.Row="2" Text="自定义" x:Name="RadioRamType1" Margin="0,0,20,0" />
<local:MyCheckBox Grid.Row="4" Grid.ColumnSpan="3" Text="启动游戏前进行内存优化" Height="22" x:Name="CheckArgumentRam" Tag="LaunchArgumentRam" <local:MySlider Grid.Row="2" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" local:SettingService.Key="LaunchRamCustom" MaxValue="49" Value="13" />
<local:MyCheckBox local:SettingService.Key="LaunchArgumentRam"
Grid.Row="4" Grid.ColumnSpan="3" Text="启动游戏前进行内存优化" Height="22" x:Name="CheckArgumentRam"
ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30" ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30"
ToolTip="内存优化能将当前物理内存占用降低约 1/3,不仅限于 MC!&#xa;如果使用机械硬盘,这还可能会导致一小段时间的严重卡顿。&#xa;使用 --memory 参数启动 PCL 可以静默执行内存优化。" /> ToolTip="内存优化能将当前物理内存占用降低约 1/3,不仅限于 MC!&#xa;如果使用机械硬盘,这还可能会导致一小段时间的严重卡顿。&#xa;使用 --memory 参数启动 PCL 可以静默执行内存优化。" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />--> <!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
@@ -182,11 +194,21 @@
<ColumnDefinition /> <ColumnDefinition />
<ColumnDefinition /> <ColumnDefinition />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyRadioBox Text="随机" x:Name="RadioSkinType0" Height="22" Tag="LaunchSkinType/0" Grid.Column="0" ToolTip="随机选择一个默认皮肤" /> <local:MyRadioBox local:SettingService.Key="LaunchSkinType" local:SettingService.Value="0"
<local:MyRadioBox Text="Steve" x:Name="RadioSkinType1" Height="22" Tag="LaunchSkinType/1" Grid.Column="1" /> x:Name="RadioSkinType0" Height="22" Grid.Column="0"
<local:MyRadioBox Text="Alex" x:Name="RadioSkinType2" Height="22" Tag="LaunchSkinType/2" Grid.Column="2" /> Text="随机" ToolTip="随机选择一个默认皮肤" />
<local:MyRadioBox Text="正版皮肤" x:Name="RadioSkinType3" Height="22" Tag="LaunchSkinType/3" Grid.Column="3" ToolTip="使用某个正版玩家的皮肤" /> <local:MyRadioBox local:SettingService.Key="LaunchSkinType" local:SettingService.Value="1"
<local:MyRadioBox Text="自定义" x:Name="RadioSkinType4" Height="22" Tag="LaunchSkinType/4" Grid.Column="4" ToolTip="以资源包的形式加载自定义皮肤。&#xa;使用此方式更换的皮肤在多人游戏中仅自己可见,且会替换游戏中所有的角色。" /> x:Name="RadioSkinType1" Height="22" Grid.Column="1"
Text="Steve" />
<local:MyRadioBox local:SettingService.Key="LaunchSkinType" local:SettingService.Value="2"
x:Name="RadioSkinType2" Height="22" Grid.Column="2"
Text="Alex" />
<local:MyRadioBox local:SettingService.Key="LaunchSkinType" local:SettingService.Value="3"
x:Name="RadioSkinType3" Height="22" Grid.Column="3"
Text="正版皮肤" ToolTip="使用某个正版玩家的皮肤" />
<local:MyRadioBox local:SettingService.Key="LaunchSkinType" local:SettingService.Value="4"
x:Name="RadioSkinType4" Height="22" Grid.Column="4"
Text="自定义" ToolTip="以资源包的形式加载自定义皮肤。&#xa;使用此方式更换的皮肤在多人游戏中仅自己可见,且会替换游戏中所有的角色。" />
</Grid> </Grid>
<Grid x:Name="PanSkinID" Margin="0,14,0,2" Visibility="Collapsed"> <Grid x:Name="PanSkinID" Margin="0,14,0,2" Visibility="Collapsed">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -198,7 +220,7 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="正版玩家名" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="正版玩家名" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextSkinID" Tag="LaunchSkinID" Grid.Column="1" MaxLength="50" /> <local:MyTextBox local:SettingService.Key="LaunchSkinID" Grid.Column="1" MaxLength="50" />
<Grid Height="35" Grid.Row="1" Grid.ColumnSpan="2" Margin="0,14,0,0"> <Grid Height="35" Grid.Row="1" Grid.ColumnSpan="2" Margin="0,14,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
@@ -242,30 +264,33 @@
ToolTip="还原" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" 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" /> 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> </StackPanel>
<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" <local:MyTextBox local:SettingService.Key="LaunchAdvanceJvm" x:Name="TextAdvanceJvm" Grid.ColumnSpan="2" 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" /> 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" /> <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;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" /> <local:MyTextBox local:SettingService.Key="LaunchAdvanceGame" x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" 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" /> <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="" <local:MyTextBox local:SettingService.Key="LaunchAdvanceRun" x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Grid.Column="1" HintText=""
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 文件夹。" /> 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" <local:MyCheckBox local:SettingService.Key="LaunchAdvanceRunWait" x:Name="CheckAdvanceRunWait" Grid.Row="5" Grid.Column="1" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" /> Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<TextBlock VerticalAlignment="Center" Grid.Row="7" HorizontalAlignment="Left" Text="内存管理" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="7" HorizontalAlignment="Left" Text="内存管理" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboAdvanceGC" Grid.Row="7" Grid.ColumnSpan="2" Tag="LaunchAdvanceGC" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="LaunchAdvanceGC" Grid.Row="7" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用 ZGC(激进)" <local:MyComboBoxItem Content="尽量使用 ZGC"
ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC。&#xa;在 Java 25+ 额外添加 -XX:+UseCompactObjectHeaders。&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC。&#xa;ZGC 的内存占用比 G1GC 更高,不过在回收内存时不会导致卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="尽量使用分代 ZGC(平衡)" IsSelected="True" <local:MyComboBoxItem Content="尽量使用分代 ZGC"
ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20- 使用 G1GC。&#xa;在 Java 25+ 额外添加 -XX:+UseCompactObjectHeaders。&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="在 Java 21+ 使用分代 ZGC,20- 使用 G1GC。&#xa;ZGC 的内存占用比 G1GC 更高,不过在回收内存时不会导致卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="仅 G1GC" <local:MyComboBoxItem Content="标准 G1GC"
ToolTipService.BetweenShowDelay="0" ToolTip="固定使用以下参数:&#xa;-XX:+UseG1GC -XX:+UnlockExperimentalVMOptions -XX:G1NewSizePercent=20 -XX:G1ReservePercent=20 -XX:MaxGCPauseMillis=50 -XX:G1HeapRegionSize=32M&#xa;&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="总是使用 G1GC,附带 Mojang 官方的优化参数。&#xa;G1GC 的内存占用比 ZGC 更低,但在回收内存时会导致突然的卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="不指定(可自定义)" <local:MyComboBoxItem Content="调优 G1GC" local:SettingService.Value="4"
ToolTipService.BetweenShowDelay="0" ToolTip="不自动添加 GC 参数。&#xa;&#xa;仅当选择此项时,你可以在 “Java 虚拟机参数” 设置中手动添加 GC 参数。" /> ToolTipService.BetweenShowDelay="0" ToolTip="总是使用 G1GC,附带 PCL 调优过的优化参数。&#xa;G1GC 的内存占用比 ZGC 更低,但在回收内存时会导致突然的卡顿。&#xa;覆盖 “Java 虚拟机参数” 设置中的 GC 相关参数。" />
<local:MyComboBoxItem Content="不指定(可自定义)" local:SettingService.Value="3"
ToolTipService.BetweenShowDelay="0" ToolTip="不自动添加 GC 参数。&#xa;仅当选择此项时,你可以在 “Java 虚拟机参数” 设置中手动添加 GC 参数。" />
</local:MyComboBox> </local:MyComboBox>
<StackPanel Margin="0,12,0,4" Grid.Row="8" Grid.ColumnSpan="2" HorizontalAlignment="Left"> <StackPanel Margin="0,12,0,4" Grid.Row="8" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="LaunchAdvanceDisableJLW" <local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" local:SettingService.Key="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截,或遇到其他问题,也可以将其关闭。" /> ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截,或遇到其他问题,也可以将其关闭。" />
<local:MyCheckBox Height="28" Text="使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard" <local:MyCheckBox Height="28" Text="使用高性能显卡" local:SettingService.Key="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡,这能确保 MC 使用独立显卡进行渲染,以大幅提高帧率。" /> ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡,这能确保 MC 使用独立显卡进行渲染,以大幅提高帧率。" />
</StackPanel> </StackPanel>
<local:MyHint Text="版本独立设置中还有更多高级选项可供调整。" Margin="0,5,0,10" Theme="Blue" Grid.Row="9" Grid.ColumnSpan="2" <local:MyHint Text="版本独立设置中还有更多高级选项可供调整。" Margin="0,5,0,10" Theme="Blue" Grid.Row="9" Grid.ColumnSpan="2"
@@ -1,64 +1,31 @@
Public Class PageSetupLaunch Public Class PageSetupLaunch
Private IsLoad As Boolean = False
Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'重复加载部分 '重复加载部分
PanBack.ScrollToHome() PanBack.ScrollToHome()
RefreshRam(False) RefreshRam(False)
If McInstanceSelected Is Nothing Then BtnSwitch.Visibility = If(McInstanceSelected Is Nothing, Visibility.Collapsed, Visibility.Visible)
BtnSwitch.Visibility = Visibility.Collapsed
Else
BtnSwitch.Visibility = Visibility.Visible
End If
'非重复加载部分 '非重复加载部分
If IsLoad Then Return Static Reloaded As Boolean = False
IsLoad = True If Reloaded Then Return
Reloaded = True
AniControlEnabled += 1 AniControlEnabled += 1
Reload() Refresh()
AniControlEnabled -= 1 AniControlEnabled -= 1
'内存自动刷新 '内存自动刷新
Dim timer As New Threading.DispatcherTimer With {.Interval = New TimeSpan(0, 0, 0, 1)} Dim timer As New Threading.DispatcherTimer With {.Interval = New TimeSpan(0, 0, 0, 1)}
AddHandler timer.Tick, AddressOf RefreshRam AddHandler timer.Tick, AddressOf RefreshRam
timer.Start() timer.Start()
End Sub End Sub
Public Sub Reload() Public Sub Refresh()
Try Try
SettingService.RefreshSettings(Me)
'离线皮肤 UpdateSkinType()
CType(FindName("RadioSkinType" & Setup.Load("LaunchSkinType")), MyRadioBox).Checked = True UpdateRamType()
TextSkinID.Text = Setup.Get("LaunchSkinID") UpdateJavaComboBox()
'启动参数
TextArgumentTitle.Text = Setup.Get("LaunchArgumentTitle")
TextArgumentInfo.Text = Setup.Get("LaunchArgumentInfo")
ComboArgumentIndieV2.SelectedIndex = Setup.Get("LaunchArgumentIndieV2")
ComboArgumentVisibie.SelectedIndex = Setup.Get("LaunchArgumentVisible")
ComboArgumentPriority.SelectedIndex = Setup.Get("LaunchArgumentPriority")
ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType")
TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth")
TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight")
CheckArgumentRam.Checked = Setup.Get("LaunchArgumentRam")
RefreshJavaComboBox()
'游戏内存
CType(FindName("RadioRamType" & Setup.Load("LaunchRamType")), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("LaunchRamCustom")
'高级设置
TextAdvanceJvm.Text = Setup.Get("LaunchAdvanceJvm")
TextAdvanceGame.Text = Setup.Get("LaunchAdvanceGame")
TextAdvanceRun.Text = Setup.Get("LaunchAdvanceRun")
ComboAdvanceGC.SelectedIndex = Setup.Get("LaunchAdvanceGC")
CheckAdvanceRunWait.Checked = Setup.Get("LaunchAdvanceRunWait")
CheckAdvanceDisableJLW.Checked = Setup.Get("LaunchAdvanceDisableJLW")
CheckAdvanceGraphicCard.Checked = Setup.Get("LaunchAdvanceGraphicCard")
Catch ex As NullReferenceException Catch ex As NullReferenceException
Log(ex, "启动设置项存在异常,已被自动重置", LogLevel.Msgbox) Log(ex, "启动设置项存在异常,已被自动重置", LogLevel.Msgbox)
Reset() Reset()
@@ -66,58 +33,18 @@
Log(ex, "重载启动设置时出错", LogLevel.Feedback) Log(ex, "重载启动设置时出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
'初始化
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("LaunchArgumentTitle") SettingService.ResetSettings(Me)
Setup.Reset("LaunchArgumentInfo") Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2"))
Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndieV2")) Settings.Reset("LaunchArgumentJavaAll")
Setup.Reset("LaunchArgumentVisible") Settings.Reset("LaunchArgumentJavaSelect")
Setup.Reset("LaunchArgumentWindowType")
Setup.Reset("LaunchArgumentWindowWidth")
Setup.Reset("LaunchArgumentWindowHeight")
Setup.Reset("LaunchArgumentPriority")
Setup.Reset("LaunchArgumentRam")
Setup.Reset("LaunchRamType")
Setup.Reset("LaunchRamCustom")
Setup.Reset("LaunchSkinType")
Setup.Reset("LaunchSkinID")
Setup.Reset("LaunchAdvanceJvm")
Setup.Reset("LaunchAdvanceGame")
Setup.Reset("LaunchAdvanceRun")
Setup.Reset("LaunchAdvanceGC")
Setup.Reset("LaunchAdvanceRunWait")
Setup.Reset("LaunchAdvanceDisableJLW")
Setup.Reset("LaunchAdvanceGraphicCard")
Setup.Reset("LaunchArgumentJavaAll")
Setup.Reset("LaunchArgumentJavaSelect")
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已初始化启动设置!", HintType.Green)
Log("[Setup] 已初始化启动设置")
Hint("已初始化启动设置!", HintType.Green, False)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化启动设置失败", LogLevel.Msgbox) Log(ex, "初始化启动设置失败", LogLevel.Msgbox)
End Try End Try
Refresh()
Reload()
End Sub
'将控件改变路由到设置改变
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioSkinType0.Check, RadioSkinType1.Check, RadioSkinType2.Check, RadioSkinType3.Check, RadioSkinType4.Check, RadioRamType0.Check, RadioRamType1.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)))
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSkinID.ValidatedTextChanged, TextArgumentWindowHeight.ValidatedTextChanged, TextArgumentWindowWidth.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged, ComboAdvanceGC.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckArgumentRam.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceGraphicCard.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub End Sub
#Region "离线皮肤" #Region "离线皮肤"
@@ -158,7 +85,7 @@
NewBitmap.Save(PathAppdata & "CustomSkin.png") NewBitmap.Save(PathAppdata & "CustomSkin.png")
End If End If
'更新设置 '更新设置
Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim) Settings.Set("LaunchSkinSlim", SkinInfo.IsSlim)
ChangeSkin = True ChangeSkin = True
Catch ex As Exception Catch ex As Exception
Log(ex, "改变离线皮肤失败", LogLevel.Msgbox) Log(ex, "改变离线皮肤失败", LogLevel.Msgbox)
@@ -184,13 +111,31 @@
MySkin.RefreshCache(Nothing) MySkin.RefreshCache(Nothing)
End Sub End Sub
Public Shared Sub UpdateSkinType()
PageLaunchLeft.SkinLegacy.Start()
'设置 UI 改变
If FrmSetupLaunch Is Nothing Then Return
Select Case Settings.Get("LaunchSkinType")
Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 3 '正版
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Visible
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 4 '自定义
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Visible
End Select
FrmSetupLaunch.CardSkin.TriggerForceResize()
End Sub
#End Region #End Region
#Region "游戏内存" #Region "游戏内存"
Public Sub RamType(Type As Integer) Public Shared Sub UpdateRamType()
If SliderRamCustom Is Nothing Then Return If FrmSetupLaunch?.SliderRamCustom Is Nothing Then Return
SliderRamCustom.IsEnabled = (Type = 1) FrmSetupLaunch.SliderRamCustom.IsEnabled = Settings.Get("LaunchRamType") = 1
End Sub End Sub
''' <summary> ''' <summary>
@@ -333,7 +278,7 @@
'------------------------------------------ '------------------------------------------
Dim RamGive As Double Dim RamGive As Double
If Setup.Get("LaunchRamType") = 0 Then If Settings.Get("LaunchRamType") = 0 Then
'自动配置 '自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值 '确定需求的内存值
@@ -345,7 +290,7 @@
If Instance IsNot Nothing AndAlso Instance.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\") Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50 RamTarget2 = 2.7 + ModCount / 50
@@ -389,7 +334,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else Else
'手动配置 '手动配置
Dim Value As Integer = Setup.Get("LaunchRamCustom") Dim Value As Integer = Settings.Get("LaunchRamCustom")
If Value <= 12 Then If Value <= 12 Then
RamGive = Value * 0.1 + 0.3 RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then ElseIf Value <= 25 Then
@@ -410,14 +355,14 @@ PreFin:
#Region "Java 选择" #Region "Java 选择"
'刷新 Java 下拉框显示 '刷新 Java 下拉框显示
Public Sub RefreshJavaComboBox() Public Sub UpdateJavaComboBox()
If ComboArgumentJava Is Nothing Then Return If ComboArgumentJava Is Nothing Then Return
'初始化列表 '初始化列表
ComboArgumentJava.Items.Clear() ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表 '更新列表
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect") Dim SelectedBySetup As String = Settings.Get("LaunchArgumentJavaSelect")
Try Try
For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion) For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -428,7 +373,7 @@ PreFin:
If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem
Next Next
Catch ex As Exception Catch ex As Exception
Setup.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback) Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback)
End Try End Try
'更新选择项 '更新选择项
@@ -457,11 +402,11 @@ PreFin:
Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag
If "自动选择".Equals(SelectedJava) Then If "自动选择".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Setup.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Log("[Java] 修改 Java 选择设置:自动选择") Log("[Java] 修改 Java 选择设置:自动选择")
Else Else
'选择指定项 '选择指定项
Setup.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None))
Log("[Java] 修改 Java 选择设置:" & SelectedJava.ToString) Log("[Java] 修改 Java 选择设置:" & SelectedJava.ToString)
End If End If
RefreshRam(True) RefreshRam(True)
@@ -483,12 +428,12 @@ PreFin:
NewEntry.Check() NewEntry.Check()
'加入列表 '加入列表
Dim JavaNewList As New JArray From {NewEntry.ToJson} Dim JavaNewList As New JArray From {NewEntry.ToJson}
For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll")) For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
Dim Entry = JavaEntry.FromJson(JsonEntry) Dim Entry = JavaEntry.FromJson(JsonEntry)
If Entry.PathFolder = NewEntry.PathFolder Then Continue For If Entry.PathFolder = NewEntry.PathFolder Then Continue For
JavaNewList.Add(JsonEntry) JavaNewList.Add(JsonEntry)
Next Next
Setup.Set("LaunchArgumentJavaAll", JavaNewList.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LaunchArgumentJavaAll", JavaNewList.ToString(Newtonsoft.Json.Formatting.None))
'重新加载列表 '重新加载列表
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已将该 Java 加入 Java 列表!", HintType.Green) Hint("已将该 Java 加入 Java 列表!", HintType.Green)
@@ -520,16 +465,10 @@ PreFin:
#Region "其他选项" #Region "其他选项"
Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged
If ComboArgumentWindowType Is Nothing Then Return Dim IsVisibie = (ComboArgumentWindowType.SelectedIndex = 3).ToVisibility
If ComboArgumentWindowType.SelectedIndex = 3 AndAlso LabArgumentWindowMiddle IsNot Nothing AndAlso LabArgumentWindowMiddle.Visibility = Visibility.Collapsed Then TextArgumentWindowHeight.Visibility = IsVisibie
LabArgumentWindowMiddle.Visibility = Visibility.Visible LabArgumentWindowMiddle.Visibility = IsVisibie
TextArgumentWindowHeight.Visibility = Visibility.Visible TextArgumentWindowWidth.Visibility = IsVisibie
TextArgumentWindowWidth.Visibility = Visibility.Visible
ElseIf ComboArgumentWindowType.SelectedIndex <> 3 AndAlso LabArgumentWindowMiddle IsNot Nothing AndAlso LabArgumentWindowMiddle.Visibility = Visibility.Visible Then
LabArgumentWindowMiddle.Visibility = Visibility.Collapsed
TextArgumentWindowHeight.Visibility = Visibility.Collapsed
TextArgumentWindowWidth.Visibility = Visibility.Collapsed
End If
End Sub End Sub
'可见性选择直接关闭的警告 '可见性选择直接关闭的警告
@@ -571,11 +510,20 @@ PreFin:
'JVM 参数重设 'JVM 参数重设
Private Sub TextAdvanceJvm_TextChanged() Handles TextAdvanceJvm.ValidatedTextChanged Private Sub TextAdvanceJvm_TextChanged() Handles TextAdvanceJvm.ValidatedTextChanged
BtnAdvanceJvmReset.Visibility = If(TextAdvanceJvm.Text = Setup.GetDefault("LaunchAdvanceJvm"), Visibility.Hidden, Visibility.Visible) BtnAdvanceJvmReset.Visibility = If(TextAdvanceJvm.Text = Settings.GetDefault("LaunchAdvanceJvm"), Visibility.Hidden, Visibility.Visible)
End Sub End Sub
Private Sub BtnAdvanceJvmReset_Click(sender As Object, e As EventArgs) Handles BtnAdvanceJvmReset.Click Private Sub BtnAdvanceJvmReset_Click(sender As Object, e As EventArgs) Handles BtnAdvanceJvmReset.Click
Setup.Reset("LaunchAdvanceJvm") Settings.Reset("LaunchAdvanceJvm")
Reload() Refresh()
End Sub
'去除参数中的回车
Private Sub ReplaceEnter(sender As MyTextBox, e As TextChangedEventArgs) Handles TextAdvanceJvm.TextChanged, TextAdvanceGame.TextChanged
Dim NewText = sender.Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ")
If NewText = sender.Text Then Return
Dim CaretIndex = sender.CaretIndex
sender.Text = NewText
sender.CaretIndex = Math.Max(0, CaretIndex - 1)
End Sub End Sub
#End Region #End Region
@@ -587,12 +535,4 @@ PreFin:
FrmMain.PageChange(FormMain.PageType.InstanceSetup, FormMain.PageSubType.InstanceSetup) FrmMain.PageChange(FormMain.PageType.InstanceSetup, FormMain.PageSubType.InstanceSetup)
End Sub End Sub
'去除参数中的回车
Private Sub ReplaceEnter(sender As MyTextBox, e As TextChangedEventArgs) Handles TextAdvanceJvm.TextChanged, TextAdvanceGame.TextChanged
Dim NewText = sender.Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ")
If NewText = sender.Text Then Return
Dim CaretIndex = sender.CaretIndex
sender.Text = NewText
sender.CaretIndex = Math.Max(0, CaretIndex - 1)
End Sub
End Class End Class
@@ -5,10 +5,10 @@
Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面 '是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False Dim IsHiddenPage As Boolean = False
If ItemLaunch.Checked AndAlso Setup.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True If ItemLaunch.Checked AndAlso Settings.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Setup.Get("UiHiddenSetupUi") Then IsHiddenPage = True If ItemUI.Checked AndAlso Settings.Get("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Setup.Get("UiHiddenSetupSystem") Then IsHiddenPage = True If ItemSystem.Checked AndAlso Settings.Get("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Setup.Get("UiHiddenSetupLink") Then IsHiddenPage = True If ItemLink.Checked AndAlso Settings.Get("UiHiddenSetupLink") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误,或尚未加载,则继续 '若页面错误,或尚未加载,则继续
If IsLoad AndAlso Not IsHiddenPage Then Return If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -17,13 +17,13 @@
PageSetupUI.HiddenRefresh() PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If IsPageSwitched Then Return If IsPageSwitched Then Return
If Not Setup.Get("UiHiddenSetupLaunch") Then If Not Settings.Get("UiHiddenSetupLaunch") Then
ItemLaunch.SetChecked(True, False, False) ItemLaunch.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenSetupUi") Then ElseIf Not Settings.Get("UiHiddenSetupUi") Then
ItemUI.SetChecked(True, False, False) ItemUI.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenSetupSystem") Then ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
ItemSystem.SetChecked(True, False, False) ItemSystem.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenSetupLink") Then ElseIf Not Settings.Get("UiHiddenSetupLink") Then
ItemLink.SetChecked(True, False, False) ItemLink.SetChecked(True, False, False)
Else Else
ItemLaunch.SetChecked(True, False, False) ItemLaunch.SetChecked(True, False, False)
@@ -42,13 +42,13 @@
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If Not Setup.Get("UiHiddenSetupLaunch") Then If Not Settings.Get("UiHiddenSetupLaunch") Then
PageID = FormMain.PageSubType.SetupLaunch PageID = FormMain.PageSubType.SetupLaunch
ElseIf Not Setup.Get("UiHiddenSetupUi") Then ElseIf Not Settings.Get("UiHiddenSetupUi") Then
PageID = FormMain.PageSubType.SetupUI PageID = FormMain.PageSubType.SetupUI
ElseIf Not Setup.Get("UiHiddenSetupSystem") Then ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
PageID = FormMain.PageSubType.SetupSystem PageID = FormMain.PageSubType.SetupSystem
ElseIf Not Setup.Get("UiHiddenSetupLink") Then ElseIf Not Settings.Get("UiHiddenSetupLink") Then
PageID = FormMain.PageSubType.SetupLink PageID = FormMain.PageSubType.SetupLink
Else Else
PageID = FormMain.PageSubType.SetupLaunch PageID = FormMain.PageSubType.SetupLaunch
@@ -17,15 +17,15 @@
End Sub End Sub
Public Sub Reload() Public Sub Reload()
ComboLatencyMode.SelectedIndex = Setup.Get("LinkLatencyMode") ComboLatencyMode.SelectedIndex = Settings.Get("LinkLatencyMode")
TextCustomPeer.Text = Setup.Get("LinkCustomPeer") TextCustomPeer.Text = Settings.Get("LinkCustomPeer")
End Sub End Sub
'初始化 '初始化
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("LinkLatencyMode") Settings.Reset("LinkLatencyMode")
Setup.Reset("LinkCustomPeer") Settings.Reset("LinkCustomPeer")
Log("[Setup] 已初始化联机页设置") Log("[Setup] 已初始化联机页设置")
Hint("已初始化联机页设置!", HintType.Green, False) Hint("已初始化联机页设置!", HintType.Green, False)
@@ -38,10 +38,10 @@
'将控件改变路由到设置改变 '将控件改变路由到设置改变
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Text)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboLatencyMode.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboLatencyMode.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex)
End Sub End Sub
End Class End Class
@@ -27,62 +27,62 @@
Public Sub Reload() Public Sub Reload()
'下载 '下载
SliderDownloadThread.Value = Setup.Get("ToolDownloadThread") SliderDownloadThread.Value = Settings.Get("ToolDownloadThread")
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed") SliderDownloadSpeed.Value = Settings.Get("ToolDownloadSpeed")
ComboDownloadSource.SelectedIndex = Setup.Get("ToolDownloadSource") ComboDownloadSource.SelectedIndex = Settings.Get("ToolDownloadSource")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion") ComboDownloadVersion.SelectedIndex = Settings.Get("ToolDownloadVersion")
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert") CheckDownloadCert.Checked = Settings.Get("ToolDownloadCert")
'Mod 与整合包 'Mod 与整合包
ComboDownloadTranslateV2.SelectedIndex = Setup.Get("ToolDownloadTranslateV2") ComboDownloadTranslateV2.SelectedIndex = Settings.Get("ToolDownloadTranslateV2")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod") ComboDownloadMod.SelectedIndex = Settings.Get("ToolDownloadMod")
ComboModLocalNameStyle.SelectedIndex = Setup.Get("ToolModLocalNameStyle") ComboModLocalNameStyle.SelectedIndex = Settings.Get("ToolModLocalNameStyle")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") CheckDownloadIgnoreQuilt.Checked = Settings.Get("ToolDownloadIgnoreQuilt")
'Minecraft 更新提示 'Minecraft 更新提示
CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease") CheckUpdateRelease.Checked = Settings.Get("ToolUpdateRelease")
CheckUpdateSnapshot.Checked = Setup.Get("ToolUpdateSnapshot") CheckUpdateSnapshot.Checked = Settings.Get("ToolUpdateSnapshot")
'辅助设置 '辅助设置
CheckHelpChinese.Checked = Setup.Get("ToolHelpChinese") CheckHelpChinese.Checked = Settings.Get("ToolHelpChinese")
'系统设置 '系统设置
ComboSystemUpdate.SelectedIndex = Setup.Get("SystemSystemUpdate") ComboSystemUpdate.SelectedIndex = Settings.Get("SystemSystemUpdate")
ComboSystemActivity.SelectedIndex = Setup.Get("SystemSystemActivity") ComboSystemActivity.SelectedIndex = Settings.Get("SystemSystemActivity")
TextSystemCache.Text = Setup.Get("SystemSystemCache") TextSystemCache.Text = Settings.Get("SystemSystemCache")
CheckSystemTelemetry.Checked = Setup.Get("SystemSystemTelemetry") CheckSystemTelemetry.Checked = Settings.Get("SystemSystemTelemetry")
'调试选项 '调试选项
CheckDebugMode.Checked = Setup.Get("SystemDebugMode") CheckDebugMode.Checked = Settings.Get("SystemDebugMode")
SliderDebugAnim.Value = Setup.Get("SystemDebugAnim") SliderDebugAnim.Value = Settings.Get("SystemDebugAnim")
CheckDebugDelay.Checked = Setup.Get("SystemDebugDelay") CheckDebugDelay.Checked = Settings.Get("SystemDebugDelay")
CheckDebugSkipCopy.Checked = Setup.Get("SystemDebugSkipCopy") CheckDebugSkipCopy.Checked = Settings.Get("SystemDebugSkipCopy")
End Sub End Sub
'初始化 '初始化
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("ToolDownloadThread") Settings.Reset("ToolDownloadThread")
Setup.Reset("ToolDownloadSpeed") Settings.Reset("ToolDownloadSpeed")
Setup.Reset("ToolDownloadSource") Settings.Reset("ToolDownloadSource")
Setup.Reset("ToolDownloadVersion") Settings.Reset("ToolDownloadVersion")
Setup.Reset("ToolDownloadTranslateV2") Settings.Reset("ToolDownloadTranslateV2")
Setup.Reset("ToolDownloadIgnoreQuilt") Settings.Reset("ToolDownloadIgnoreQuilt")
Setup.Reset("ToolDownloadCert") Settings.Reset("ToolDownloadCert")
Setup.Reset("ToolDownloadMod") Settings.Reset("ToolDownloadMod")
Setup.Reset("ToolModLocalNameStyle") Settings.Reset("ToolModLocalNameStyle")
Setup.Reset("ToolUpdateRelease") Settings.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot") Settings.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese") Settings.Reset("ToolHelpChinese")
Setup.Reset("SystemDebugMode") Settings.Reset("SystemDebugMode")
Setup.Reset("SystemDebugAnim") Settings.Reset("SystemDebugAnim")
Setup.Reset("SystemDebugDelay") Settings.Reset("SystemDebugDelay")
Setup.Reset("SystemDebugSkipCopy") Settings.Reset("SystemDebugSkipCopy")
Setup.Reset("SystemSystemCache") Settings.Reset("SystemSystemCache")
Setup.Reset("SystemSystemUpdate") Settings.Reset("SystemSystemUpdate")
Setup.Reset("SystemSystemActivity") Settings.Reset("SystemSystemActivity")
Setup.Reset("SystemSystemTelemetry") Settings.Reset("SystemSystemTelemetry")
Log("[Setup] 已初始化启动器页设置") Log("[Setup] 已初始化启动器页设置")
Hint("已初始化启动器页设置!", HintType.Green, False) Hint("已初始化启动器页设置!", HintType.Green, False)
@@ -95,16 +95,16 @@
'将控件改变路由到设置改变 '将控件改变路由到设置改变
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change, CheckSystemTelemetry.Change Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change, CheckSystemTelemetry.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked)
End Sub End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Value)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadSource.SelectionChanged, ComboDownloadMod.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadSource.SelectionChanged, ComboDownloadMod.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Text)
End Sub End Sub
'滑动条 '滑动条
@@ -127,8 +127,8 @@
End Sub End Sub
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
If SliderDownloadThread.Value < 100 Then Return If SliderDownloadThread.Value < 100 Then Return
If Not Setup.Get("HintDownloadThread") Then If Not Settings.Get("HintDownloadThread") Then
Setup.Set("HintDownloadThread", True) Settings.Set("HintDownloadThread", True)
MyMsgBox("如果设置过多的下载线程,可能会导致下载时出现非常严重的卡顿。" & vbCrLf & MyMsgBox("如果设置过多的下载线程,可能会导致下载时出现非常严重的卡顿。" & vbCrLf &
"一般设置 64 线程即可满足大多数下载需求,除非你知道你在干什么,否则不建议设置更多的线程数!", "警告", "我知道了", IsWarn:=True) "一般设置 64 线程即可满足大多数下载需求,除非你知道你在干什么,否则不建议设置更多的线程数!", "警告", "我知道了", IsWarn:=True)
End If End If
@@ -23,15 +23,20 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,20,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,20,0" />
<local:MySlider Grid.ColumnSpan="5" x:Name="SliderLauncherOpacity" Tag="UiLauncherTransparent" MaxValue="600" ValueByKey="10" Grid.Column="1" /> <local:MySlider local:SettingService.Key="UiLauncherTransparent"
MaxValue="600" ValueByKey="10" Grid.ColumnSpan="5" x:Name="SliderLauncherTransparent" Grid.Column="1" />
<TextBlock Grid.Row="1" VerticalAlignment="Center" Name="LabLauncherHue" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调" Margin="0,10,20,0" /> <TextBlock Grid.Row="1" VerticalAlignment="Center" Name="LabLauncherHue" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调" Margin="0,10,20,0" />
<local:MySlider Grid.Row="1" Grid.Column="1" x:Name="SliderLauncherHue" Tag="UiLauncherHue" Visibility="Collapsed" MaxValue="360" ValueByKey="10" Margin="0,10,0,0" /> <local:MySlider local:SettingService.Key="UiLauncherHue"
Grid.Row="1" Grid.Column="1" x:Name="SliderLauncherHue" Visibility="Collapsed" MaxValue="360" ValueByKey="10" Margin="0,10,0,0" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" Name="LabLauncherDelta" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调渐变" Margin="0,10,20,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" Name="LabLauncherDelta" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调渐变" Margin="0,10,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="1" x:Name="SliderLauncherDelta" Tag="UiLauncherDelta" Visibility="Collapsed" MaxValue="180" ValueByKey="5" Margin="0,10,0,0" /> <local:MySlider local:SettingService.Key="UiLauncherDelta"
Grid.Row="2" Grid.Column="1" x:Name="SliderLauncherDelta" Visibility="Collapsed" MaxValue="180" ValueByKey="5" Margin="0,10,0,0" />
<TextBlock Grid.Row="1" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherSat" Visibility="Collapsed" HorizontalAlignment="Left" Text="饱和度" Margin="0,10,20,0" /> <TextBlock Grid.Row="1" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherSat" Visibility="Collapsed" HorizontalAlignment="Left" Text="饱和度" Margin="0,10,20,0" />
<local:MySlider Grid.Row="1" Grid.Column="4" x:Name="SliderLauncherSat" Tag="UiLauncherSat" Visibility="Collapsed" MaxValue="100" ValueByKey="5" Margin="0,10,0,0" /> <local:MySlider local:SettingService.Key="UiLauncherSat"
Grid.Row="1" Grid.Column="4" x:Name="SliderLauncherSat" Visibility="Collapsed" MaxValue="100" ValueByKey="5" Margin="0,10,0,0" />
<TextBlock Grid.Row="2" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherLight" Visibility="Collapsed" HorizontalAlignment="Left" Text="亮度" Margin="0,10,20,0" /> <TextBlock Grid.Row="2" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherLight" Visibility="Collapsed" HorizontalAlignment="Left" Text="亮度" Margin="0,10,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="4" x:Name="SliderLauncherLight" Tag="UiLauncherLight" Visibility="Collapsed" MaxValue="40" ValueByKey="5" Margin="0,10,0,0" /> <local:MySlider local:SettingService.Key="UiLauncherLight"
Grid.Row="2" Grid.Column="4" x:Name="SliderLauncherLight" Visibility="Collapsed" MaxValue="40" ValueByKey="5" Margin="0,10,0,0" />
</Grid> </Grid>
<Grid x:Name="PanLauncherTheme" Height="90" Margin="0,0,0,7"> <Grid x:Name="PanLauncherTheme" Height="90" Margin="0,0,0,7">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -49,33 +54,49 @@
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主题" Margin="0,0,20,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主题" Margin="0,0,20,0" />
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="隐藏主题" Margin="0,0,20,0" Grid.Row="1" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="隐藏主题" Margin="0,0,20,0" Grid.Row="1" />
<local:MyRadioBox Grid.Column="1" Grid.Row="0" Text="龙猫蓝" x:Name="RadioLauncherTheme0" Tag="UiLauncherTheme/0" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="0"
<local:MyRadioBox Grid.Column="2" Grid.Row="0" Text="甜柠青" x:Name="RadioLauncherTheme1" Tag="UiLauncherTheme/1" /> Grid.Column="1" Grid.Row="0" Text="龙猫蓝" x:Name="RadioLauncherTheme0" />
<local:MyRadioBox Grid.Column="3" Grid.Row="0" Text="小草绿" x:Name="RadioLauncherTheme2" Tag="UiLauncherTheme/2" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="1"
<local:MyRadioBox Grid.Column="4" Grid.Row="0" Text="菠萝黄" x:Name="RadioLauncherTheme3" Tag="UiLauncherTheme/3" /> Grid.Column="2" Grid.Row="0" Text="甜柠青" x:Name="RadioLauncherTheme1" />
<local:MyRadioBox Grid.Column="5" Grid.Row="0" Text="橡木棕" x:Name="RadioLauncherTheme4" Tag="UiLauncherTheme/4" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="2"
<local:MyRadioBox Grid.Column="1" Grid.Row="1" Text="玄素黑" x:Name="RadioLauncherTheme5" Tag="UiLauncherTheme/5" Opacity="0" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" /> Grid.Column="3" Grid.Row="0" Text="小草绿" x:Name="RadioLauncherTheme2" />
<local:MyRadioBox Grid.Column="1" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme5Gray" IsEnabled="False" Opacity="1" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="3"
Grid.Column="4" Grid.Row="0" Text="菠萝黄" x:Name="RadioLauncherTheme3" />
<local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="4"
Grid.Column="5" Grid.Row="0" Text="橡木棕" x:Name="RadioLauncherTheme4" />
<local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="5"
Grid.Column="1" Grid.Row="1" Text="玄素黑" x:Name="RadioLauncherTheme5" Opacity="0" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="1" Grid.Row="1" Text="玄素黑" x:Name="RadioLauncherTheme5Gray" IsEnabled="False" Opacity="1" />
<TextBlock Grid.Column="1" Grid.Row="1" x:Name="LabLauncherTheme5Unlock" Background="{StaticResource ColorBrushSemiTransparent}" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" /> <TextBlock Grid.Column="1" Grid.Row="1" x:Name="LabLauncherTheme5Unlock" Background="{StaticResource ColorBrushSemiTransparent}" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="2" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme12" Tag="UiLauncherTheme/12" IsEnabled="False" ToolTip="滑稽树上滑稽果,滑稽树下你和我,滑稽之日搞事情,欢乐多又多" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="12"
<local:MyRadioBox Grid.Column="3" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme6" Tag="UiLauncherTheme/6" IsEnabled="False" ToolTip="99 次重逢的喜悦" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" /> Grid.Column="2" Grid.Row="1" Text="滑稽彩" x:Name="RadioLauncherTheme12" IsEnabled="False" ToolTip="滑稽树上滑稽果,滑稽树下你和我,滑稽之日搞事情,欢乐多又多" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="4" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme7" Tag="UiLauncherTheme/7" IsEnabled="False" ToolTip="072 101 108 112 032 068 101 118 032 048 046 052 046 052" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="6"
<local:MyRadioBox Grid.Column="5" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme13" Tag="UiLauncherTheme/13" IsEnabled="False" ToolTip="这就是传说中的欧皇了吧" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" /> Grid.Column="3" Grid.Row="1" Text="铁杆粉" x:Name="RadioLauncherTheme6" IsEnabled="False" ToolTip="99 次重逢的喜悦" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="1" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme8" Tag="UiLauncherTheme/8" IsEnabled="False" ToolTipService.Placement="Bottom" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="7"
Grid.Column="4" Grid.Row="1" Text="神秘紫" x:Name="RadioLauncherTheme7" IsEnabled="False" ToolTip="072 101 108 112 032 068 101 118 032 048 046 052 046 052" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="13"
Grid.Column="5" Grid.Row="1" Text="欧皇彩" x:Name="RadioLauncherTheme13" IsEnabled="False" ToolTip="这就是传说中的欧皇了吧" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="8"
Grid.Column="1" Grid.Row="2" Text="秋仪金" x:Name="RadioLauncherTheme8" IsEnabled="False" ToolTipService.Placement="Bottom" />
<TextBlock Grid.Column="1" Grid.Row="2" x:Name="LabLauncherTheme8Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" /> <TextBlock Grid.Column="1" Grid.Row="2" x:Name="LabLauncherTheme8Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="2" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme9" Tag="UiLauncherTheme/9" IsEnabled="False" ToolTipService.Placement="Bottom" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="9"
Grid.Column="2" Grid.Row="2" Text="活跃橙" x:Name="RadioLauncherTheme9" IsEnabled="False" ToolTipService.Placement="Bottom" />
<TextBlock Grid.Column="2" Grid.Row="2" x:Name="LabLauncherTheme9Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" /> <TextBlock Grid.Column="2" Grid.Row="2" x:Name="LabLauncherTheme9Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="3" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme10" Tag="UiLauncherTheme/10" IsEnabled="False" ToolTip="进行一次正版登录,支持正版游戏!" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="10"
<local:MyRadioBox Grid.Column="4" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme11" Tag="UiLauncherTheme/11" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="右键打开解密游戏入口" /> Grid.Column="3" Grid.Row="2" Text="跳票红" x:Name="RadioLauncherTheme10" IsEnabled="False" ToolTip="进行一次正版登录,支持正版游戏!" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="11"
Grid.Column="4" Grid.Row="2" Text="极客蓝" x:Name="RadioLauncherTheme11" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="右键打开解密游戏入口" />
<TextBlock Grid.Column="4" Grid.Row="2" x:Name="LabLauncherTheme11Click" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" /> <TextBlock Grid.Column="4" Grid.Row="2" x:Name="LabLauncherTheme11Click" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="5" Grid.Row="2" Text="自定义" x:Name="RadioLauncherTheme14" Tag="UiLauncherTheme/14" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="需要解锁五个隐藏主题" ToolTipService.ShowOnDisabled="True" /> <local:MyRadioBox local:SettingService.Key="UiLauncherTheme" local:SettingService.Value="14"
Grid.Column="5" Grid.Row="2" Text="自定义" x:Name="RadioLauncherTheme14" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="需要解锁五个隐藏主题" ToolTipService.ShowOnDisabled="True" />
</Grid> </Grid>
<local:MyCheckBox Text="打开启动器时显示 PCL 图标" Margin="-1,0,0,1" Height="22" x:Name="CheckLauncherLogo" Tag="UiLauncherLogo" /> <local:MyCheckBox local:SettingService.Key="UiLauncherLogo" Text="打开启动器时显示 PCL 图标" Margin="-1,0,0,1" Height="22" />
</StackPanel> </StackPanel>
<Border Background="#DDDDDDDD" Margin="-8,23,-5,28" CornerRadius="4" Name="PanLauncherHide" Visibility="Collapsed"> <Border Background="#DDDDDDDD" Margin="-8,23,-5,28" CornerRadius="4" Name="PanLauncherHide" Visibility="Collapsed">
<StackPanel HorizontalAlignment="Center" VerticalAlignment="Center"> <StackPanel HorizontalAlignment="Center" VerticalAlignment="Center">
<TextBlock Text="如果可以小小赞助一下 PCL,就能解锁主题颜色更换功能啦……&#xa;多亏了大家的支持,PCL 才能在免费、无任何广告的情况下维持数年的更新(磕头)!" FontSize="13" Margin="0,0,0,0" /> <TextBlock Text="如果可以小小赞助一下 PCL,就能解锁主题颜色更换功能啦……&#xa;多亏了大家的支持,PCL 才能在免费、无任何广告的情况下维持数年的更新(磕头)!" FontSize="13" Margin="0,0,0,0" />
<local:MyButton Height="32" x:Name="BtnLauncherDonate" MinWidth="140" Text="支持 PCL 开发!" Padding="13,0" HorizontalAlignment="Center" Margin="0,9,0,0" ColorType="Highlight" /> <local:MyButton Height="32" MinWidth="140" Text="支持 PCL 开发!" Padding="13,0" HorizontalAlignment="Center" Margin="0,9,0,0" ColorType="Highlight"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://meloong.com/afd/a/LTCat" />
</StackPanel> </StackPanel>
</Border> </Border>
</Grid> </Grid>
@@ -88,20 +109,20 @@
<ColumnDefinition /> <ColumnDefinition />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自适应方式" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自适应方式" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboBackgroundSuit" Tag="UiBackgroundSuit" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="UiBackgroundSuit" Grid.Column="1">
<local:MyComboBoxItem Content="智能" IsSelected="True" ToolTip="当图片较小时选择平铺,较大时选择适应" /> <local:MyComboBoxItem local:SettingService.Value="0" Content="自动" ToolTip="当图片较小时选择平铺,较大时选择居中 (保持长宽比)" />
<local:MyComboBoxItem Content="居中" /> <local:MyComboBoxItem local:SettingService.Value="4" Content="平铺" />
<local:MyComboBoxItem Content="适应" ToolTip="拉伸图片并保持长宽比不变,直至填满整个窗口" /> <local:MyComboBoxItem local:SettingService.Value="1" Content="居中" />
<local:MyComboBoxItem Content="拉伸" ToolTip="拉伸图片使其恰好填满整个窗口,很可能会导致长宽比的改变" /> <local:MyComboBoxItem local:SettingService.Value="3" Content="拉伸" ToolTip="拉伸图片使其恰好填满整个窗口,很可能会导致长宽比的改变" />
<local:MyComboBoxItem Content="平铺" /> <local:MyComboBoxItem local:SettingService.Value="5" Content="左上 (保持长宽比)" />
<local:MyComboBoxItem Content="左上" /> <local:MyComboBoxItem local:SettingService.Value="9" Content="左中 (保持长宽比)" />
<local:MyComboBoxItem Content="右上" /> <local:MyComboBoxItem local:SettingService.Value="7" Content="左下 (保持长宽比)" />
<local:MyComboBoxItem Content="左下" /> <local:MyComboBoxItem local:SettingService.Value="11" Content="中上 (保持长宽比)" />
<local:MyComboBoxItem Content="右下" /> <local:MyComboBoxItem local:SettingService.Value="2" Content="居中 (保持长宽比)" />
<local:MyComboBoxItem Content="左" /> <local:MyComboBoxItem local:SettingService.Value="12" Content="中下 (保持长宽比)" />
<local:MyComboBoxItem Content="右" /> <local:MyComboBoxItem local:SettingService.Value="6" Content="右上 (保持长宽比)" />
<local:MyComboBoxItem Content="上" /> <local:MyComboBoxItem local:SettingService.Value="10" Content="右中 (保持长宽比)" />
<local:MyComboBoxItem Content="下" /> <local:MyComboBoxItem local:SettingService.Value="8" Content="右下 (保持长宽比)" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
<Grid x:Name="PanBackgroundOpacity" Height="22" Margin="0,0,0,7" Visibility="Collapsed"> <Grid x:Name="PanBackgroundOpacity" Height="22" Margin="0,0,0,7" Visibility="Collapsed">
@@ -110,7 +131,7 @@
<ColumnDefinition /> <ColumnDefinition />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderBackgroundOpacity" Tag="UiBackgroundOpacity" MaxValue="1000" ValueByKey="10" Grid.Column="1" /> <local:MySlider local:SettingService.Key="UiBackgroundOpacity" x:Name="SliderBackgroundOpacity" MaxValue="1000" ValueByKey="10" Grid.Column="1" />
</Grid> </Grid>
<Grid x:Name="PanBackgroundBlur" Height="22" Margin="0,0,0,10" Visibility="Collapsed"> <Grid x:Name="PanBackgroundBlur" Height="22" Margin="0,0,0,10" Visibility="Collapsed">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -118,9 +139,10 @@
<ColumnDefinition /> <ColumnDefinition />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="背景模糊" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="背景模糊" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderBackgroundBlur" Tag="UiBackgroundBlur" MaxValue="40" Grid.Column="1" ToolTip="较强的模糊会导致启动器严重掉帧,请谨慎使用。&#13;不建议在制作整合包时开启模糊,以确保 PCL 在低性能电脑上可以流畅运行。" /> <local:MySlider local:SettingService.Key="UiBackgroundBlur" x:Name="SliderBackgroundBlur" MaxValue="40" Grid.Column="1"
ToolTip="高度的模糊会严重掉帧,请谨慎。&#13;不建议在制作整合包时开启模糊,以确保 PCL 在低性能电脑上可以流畅运行。" />
</Grid> </Grid>
<local:MyCheckBox Text="叠加彩色背景" Margin="-1,0,0,8" Height="22" x:Name="CheckBackgroundColorful" Tag="UiBackgroundColorful" /> <local:MyCheckBox local:SettingService.Key="UiBackgroundColorful" Text="叠加彩色背景" Margin="-1,0,0,8" Height="22" />
<Grid Height="35" Margin="0,2,0,0"> <Grid Height="35" Margin="0,2,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
@@ -243,23 +265,23 @@
<ColumnDefinition /> <ColumnDefinition />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页预设" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页预设" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboCustomPreset" Grid.ColumnSpan="2" Tag="UiCustomPreset" Grid.Column="1"> <local:MyComboBox local:SettingService.Key="UiCustomPreset" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="你知道吗?" IsSelected="True" /> <local:MyComboBoxItem local:SettingService.Value="0" Content="你知道吗?" />
<local:MyComboBoxItem Content="回声洞" /> <local:MyComboBoxItem local:SettingService.Value="1" Content="回声洞" />
<local:MyComboBoxItem Content="Minecraft 新闻(作者:最亮的信标)" /> <local:MyComboBoxItem local:SettingService.Value="2" Content="Minecraft 新闻(作者:最亮的信标)" />
<local:MyComboBoxItem Content="简单主页(作者:MFn233)" /> <local:MyComboBoxItem local:SettingService.Value="3" Content="简单主页(作者:MFn233)" />
<local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" /> <local:MyComboBoxItem local:SettingService.Value="4" Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" /> <local:MyComboBoxItem local:SettingService.Value="5" Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" /> <local:MyComboBoxItem local:SettingService.Value="6" Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
<local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" /> <local:MyComboBoxItem local:SettingService.Value="7" Content="PCL 主页市场(作者:凌云)" />
<local:MyComboBoxItem Content="PCL 新闻速报(作者:Joker2184)" Visibility="Collapsed" /> <!--<local:MyComboBoxItem local:SettingService.Value="8" Content="PCL 新闻速报(作者:Joker2184)" />-->
<local:MyComboBoxItem Content="PCL 新功能说明书(作者:WForst-Breeze)" /> <local:MyComboBoxItem local:SettingService.Value="9" Content="PCL 新功能说明书(作者:WForst-Breeze)" />
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" Visibility="Collapsed" /> <!--<local:MyComboBoxItem local:SettingService.Value="10" Content="OpenMCIM 仪表盘(作者:SALTWOOD)" />-->
<local:MyComboBoxItem Content="杂志主页(作者:CreeperIsASpy)" /> <local:MyComboBoxItem local:SettingService.Value="11" Content="杂志主页(作者:CreeperIsASpy)" />
<local:MyComboBoxItem Content="PCL GitHub 仪表盘(作者:Deep-Dark-Forest)" /> <local:MyComboBoxItem local:SettingService.Value="12" Content="PCL GitHub 仪表盘(作者:Deep-Dark-Forest)" />
<local:MyComboBoxItem Content="Minecraft 更新摘要(作者:pynickle,部分由 AI 生成)" /> <local:MyComboBoxItem local:SettingService.Value="13" Content="Minecraft 更新摘要(作者:pynickle)" />
<local:MyComboBoxItem Content="今日新闻热点(作者:EYicheng,部分由 AI 生成)" /> <local:MyComboBoxItem local:SettingService.Value="14" Content="今日新闻热点(作者:EYicheng)" />
<local:MyComboBoxItem Content="Minecraft 芝士站(作者:awaEric233,部分由 AI 生成)" /> <local:MyComboBoxItem local:SettingService.Value="15" Content="Minecraft 芝士站(作者:awaEric233)" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
</StackPanel> </StackPanel>
@@ -1,37 +1,30 @@
Public Class PageSetupUI Public Class PageSetupUI
Public Shadows IsLoaded As Boolean = False
Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'重复加载部分 '重复加载部分
PanBack.ScrollToHome() PanBack.ScrollToHome()
ThemeCheckAll(True) ThemeCheckAll(True)
If ThemeDontClick <> 0 Then If ThemeDontClick <> 0 Then
Dim NewText As String Dim NewText As String = Nothing
Select Case ThemeDontClick Select Case ThemeDontClick
Case 1 Case 1
NewText = "眼瞎白" NewText = "眼瞎白"
Case 2 Case 2
NewText = "真·滑稽彩" NewText = "真·滑稽彩"
Case Else
NewText = "???"
End Select End Select
For Each Control In PanLauncherTheme.Children For Each Control In PanLauncherTheme.Children
If (TypeOf Control Is MyRadioBox) AndAlso CType(Control, MyRadioBox).IsEnabled Then If (TypeOf Control Is MyRadioBox) AndAlso CType(Control, MyRadioBox).IsEnabled Then CType(Control, MyRadioBox).Text = NewText
CType(Control, MyRadioBox).Text = NewText
End If
Next Next
End If End If
AniControlEnabled += 1 AniControlEnabled += 1
Reload() '#4826,在每次进入页面时都刷新一下 Refresh() '#4826
AniControlEnabled -= 1 AniControlEnabled -= 1
'非重复加载部分 '非重复加载部分
If IsLoaded Then Return Static Reloaded As Boolean = False
IsLoaded = True If Reloaded Then Return
Reloaded = True
SliderLoad() SliderLoad()
@@ -47,68 +40,50 @@
'极客蓝的处理在 ThemeCheck 中 '极客蓝的处理在 ThemeCheck 中
End Sub End Sub
Public Sub Reload() Public Sub Refresh()
Try Try
SettingService.RefreshSettings(Me)
'启动器
SliderLauncherOpacity.Value = Setup.Get("UiLauncherTransparent")
SliderLauncherHue.Value = Setup.Get("UiLauncherHue")
SliderLauncherSat.Value = Setup.Get("UiLauncherSat")
SliderLauncherDelta.Value = Setup.Get("UiLauncherDelta")
SliderLauncherLight.Value = Setup.Get("UiLauncherLight")
If Setup.Get("UiLauncherTheme") <= 14 Then CType(FindName("RadioLauncherTheme" & Setup.Get("UiLauncherTheme")), MyRadioBox).Checked = True
CheckLauncherLogo.Checked = Setup.Get("UiLauncherLogo")
CheckLauncherEmail.Checked = Setup.Get("UiLauncherEmail")
'背景图片
SliderBackgroundOpacity.Value = Setup.Get("UiBackgroundOpacity")
SliderBackgroundBlur.Value = Setup.Get("UiBackgroundBlur")
ComboBackgroundSuit.SelectedIndex = Setup.Get("UiBackgroundSuit")
CheckBackgroundColorful.Checked = Setup.Get("UiBackgroundColorful")
BackgroundRefresh(False, False) BackgroundRefresh(False, False)
'标题栏 '标题栏
CType(FindName("RadioLogoType" & Setup.Get("UiLogoType")), MyRadioBox).Checked = True CType(FindName("RadioLogoType" & Settings.Get("UiLogoType")), MyRadioBox).Checked = True
CheckLogoLeft.Visibility = If(RadioLogoType0.Checked, Visibility.Visible, Visibility.Collapsed) CheckLogoLeft.Visibility = If(RadioLogoType0.Checked, Visibility.Visible, Visibility.Collapsed)
PanLogoText.Visibility = If(RadioLogoType2.Checked, Visibility.Visible, Visibility.Collapsed) PanLogoText.Visibility = If(RadioLogoType2.Checked, Visibility.Visible, Visibility.Collapsed)
PanLogoChange.Visibility = If(RadioLogoType3.Checked, Visibility.Visible, Visibility.Collapsed) PanLogoChange.Visibility = If(RadioLogoType3.Checked, Visibility.Visible, Visibility.Collapsed)
TextLogoText.Text = Setup.Get("UiLogoText") TextLogoText.Text = Settings.Get("UiLogoText")
CheckLogoLeft.Checked = Setup.Get("UiLogoLeft") CheckLogoLeft.Checked = Settings.Get("UiLogoLeft")
'背景音乐 '背景音乐
CheckMusicRandom.Checked = Setup.Get("UiMusicRandom") CheckMusicRandom.Checked = Settings.Get("UiMusicRandom")
CheckMusicAuto.Checked = Setup.Get("UiMusicAuto") CheckMusicAuto.Checked = Settings.Get("UiMusicAuto")
CheckMusicStop.Checked = Setup.Get("UiMusicStop") CheckMusicStop.Checked = Settings.Get("UiMusicStop")
CheckMusicStart.Checked = Setup.Get("UiMusicStart") CheckMusicStart.Checked = Settings.Get("UiMusicStart")
SliderMusicVolume.Value = Setup.Get("UiMusicVolume") SliderMusicVolume.Value = Settings.Get("UiMusicVolume")
MusicRefreshUI() MusicRefreshUI()
'主页 '主页
Try CType(FindName("RadioCustomType" & Settings.Get("UiCustomType")), MyRadioBox).Checked = True
ComboCustomPreset.SelectedIndex = Setup.Get("UiCustomPreset") OnUiCustomTypeChanged(Settings.Get("UiCustomType"))
Catch TextCustomNet.Text = Settings.Get("UiCustomNet")
Setup.Reset("UiCustomPreset")
End Try
CType(FindName("RadioCustomType" & Setup.Load("UiCustomType", ForceReload:=True)), MyRadioBox).Checked = True
TextCustomNet.Text = Setup.Get("UiCustomNet")
'功能隐藏 '功能隐藏
CheckHiddenPageDownload.Checked = Setup.Get("UiHiddenPageDownload") CheckLauncherEmail.Checked = Settings.Get("UiLauncherEmail")
CheckHiddenPageLink.Checked = Setup.Get("UiHiddenPageLink") CheckHiddenPageDownload.Checked = Settings.Get("UiHiddenPageDownload")
CheckHiddenPageSetup.Checked = Setup.Get("UiHiddenPageSetup") CheckHiddenPageLink.Checked = Settings.Get("UiHiddenPageLink")
CheckHiddenPageOther.Checked = Setup.Get("UiHiddenPageOther") CheckHiddenPageSetup.Checked = Settings.Get("UiHiddenPageSetup")
CheckHiddenFunctionSelect.Checked = Setup.Get("UiHiddenFunctionSelect") CheckHiddenPageOther.Checked = Settings.Get("UiHiddenPageOther")
CheckHiddenFunctionModUpdate.Checked = Setup.Get("UiHiddenFunctionModUpdate") CheckHiddenFunctionSelect.Checked = Settings.Get("UiHiddenFunctionSelect")
CheckHiddenFunctionHidden.Checked = Setup.Get("UiHiddenFunctionHidden") CheckHiddenFunctionModUpdate.Checked = Settings.Get("UiHiddenFunctionModUpdate")
CheckHiddenSetupLaunch.Checked = Setup.Get("UiHiddenSetupLaunch") CheckHiddenFunctionHidden.Checked = Settings.Get("UiHiddenFunctionHidden")
CheckHiddenSetupUI.Checked = Setup.Get("UiHiddenSetupUi") CheckHiddenSetupLaunch.Checked = Settings.Get("UiHiddenSetupLaunch")
CheckHiddenSetupLink.Checked = Setup.Get("UiHiddenSetupLink") CheckHiddenSetupUI.Checked = Settings.Get("UiHiddenSetupUi")
CheckHiddenSetupSystem.Checked = Setup.Get("UiHiddenSetupSystem") CheckHiddenSetupLink.Checked = Settings.Get("UiHiddenSetupLink")
CheckHiddenOtherAbout.Checked = Setup.Get("UiHiddenOtherAbout") CheckHiddenSetupSystem.Checked = Settings.Get("UiHiddenSetupSystem")
CheckHiddenOtherFeedback.Checked = Setup.Get("UiHiddenOtherFeedback") CheckHiddenOtherAbout.Checked = Settings.Get("UiHiddenOtherAbout")
CheckHiddenOtherVote.Checked = Setup.Get("UiHiddenOtherVote") CheckHiddenOtherFeedback.Checked = Settings.Get("UiHiddenOtherFeedback")
CheckHiddenOtherHelp.Checked = Setup.Get("UiHiddenOtherHelp") CheckHiddenOtherVote.Checked = Settings.Get("UiHiddenOtherVote")
CheckHiddenOtherTest.Checked = Setup.Get("UiHiddenOtherTest") CheckHiddenOtherHelp.Checked = Settings.Get("UiHiddenOtherHelp")
CheckHiddenOtherTest.Checked = Settings.Get("UiHiddenOtherTest")
Catch ex As NullReferenceException Catch ex As NullReferenceException
Log(ex, "个性化设置项存在异常,已被自动重置", LogLevel.Msgbox) Log(ex, "个性化设置项存在异常,已被自动重置", LogLevel.Msgbox)
@@ -121,45 +96,35 @@
'初始化 '初始化
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("UiLauncherTransparent") SettingService.ResetSettings(Me)
Setup.Reset("UiLauncherTheme") Settings.Reset("UiLauncherLogo")
Setup.Reset("UiLauncherLogo") Settings.Reset("UiLauncherEmail")
Setup.Reset("UiLauncherHue") Settings.Reset("UiLogoType")
Setup.Reset("UiLauncherSat") Settings.Reset("UiLogoText")
Setup.Reset("UiLauncherDelta") Settings.Reset("UiLogoLeft")
Setup.Reset("UiLauncherLight") Settings.Reset("UiMusicVolume")
Setup.Reset("UiLauncherEmail") Settings.Reset("UiMusicStop")
Setup.Reset("UiBackgroundColorful") Settings.Reset("UiMusicStart")
Setup.Reset("UiBackgroundOpacity") Settings.Reset("UiMusicRandom")
Setup.Reset("UiBackgroundBlur") Settings.Reset("UiMusicAuto")
Setup.Reset("UiBackgroundSuit") Settings.Reset("UiCustomType")
Setup.Reset("UiLogoType") Settings.Reset("UiCustomNet")
Setup.Reset("UiLogoText") Settings.Reset("UiHiddenPageDownload")
Setup.Reset("UiLogoLeft") Settings.Reset("UiHiddenPageLink")
Setup.Reset("UiMusicVolume") Settings.Reset("UiHiddenPageSetup")
Setup.Reset("UiMusicStop") Settings.Reset("UiHiddenPageOther")
Setup.Reset("UiMusicStart") Settings.Reset("UiHiddenFunctionSelect")
Setup.Reset("UiMusicRandom") Settings.Reset("UiHiddenFunctionModUpdate")
Setup.Reset("UiMusicAuto") Settings.Reset("UiHiddenFunctionHidden")
Setup.Reset("UiCustomType") Settings.Reset("UiHiddenSetupLaunch")
Setup.Reset("UiCustomPreset") Settings.Reset("UiHiddenSetupUi")
Setup.Reset("UiCustomNet") Settings.Reset("UiHiddenSetupLink")
Setup.Reset("UiHiddenPageDownload") Settings.Reset("UiHiddenSetupSystem")
Setup.Reset("UiHiddenPageLink") Settings.Reset("UiHiddenOtherAbout")
Setup.Reset("UiHiddenPageSetup") Settings.Reset("UiHiddenOtherFeedback")
Setup.Reset("UiHiddenPageOther") Settings.Reset("UiHiddenOtherVote")
Setup.Reset("UiHiddenFunctionSelect") Settings.Reset("UiHiddenOtherHelp")
Setup.Reset("UiHiddenFunctionModUpdate") Settings.Reset("UiHiddenOtherTest")
Setup.Reset("UiHiddenFunctionHidden")
Setup.Reset("UiHiddenSetupLaunch")
Setup.Reset("UiHiddenSetupUi")
Setup.Reset("UiHiddenSetupLink")
Setup.Reset("UiHiddenSetupSystem")
Setup.Reset("UiHiddenOtherAbout")
Setup.Reset("UiHiddenOtherFeedback")
Setup.Reset("UiHiddenOtherVote")
Setup.Reset("UiHiddenOtherHelp")
Setup.Reset("UiHiddenOtherTest")
Log("[Setup] 已初始化个性化设置!") Log("[Setup] 已初始化个性化设置!")
Hint("已初始化个性化设置", HintType.Green, False) Hint("已初始化个性化设置", HintType.Green, False)
@@ -167,24 +132,21 @@
Log(ex, "初始化个性化设置失败", LogLevel.Msgbox) Log(ex, "初始化个性化设置失败", LogLevel.Msgbox)
End Try End Try
Reload() Refresh()
End Sub End Sub
'将控件改变路由到设置改变 '将控件改变路由到设置改变
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderBackgroundOpacity.Change, SliderBackgroundBlur.Change, SliderLauncherOpacity.Change, SliderMusicVolume.Change, SliderLauncherHue.Change, SliderLauncherLight.Change, SliderLauncherSat.Change, SliderLauncherDelta.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderMusicVolume.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Value)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboBackgroundSuit.SelectionChanged, ComboCustomPreset.SelectionChanged Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckLogoLeft.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenFunctionModUpdate.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenFunctionModUpdate.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLogoText.ValidatedTextChanged, TextCustomNet.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLogoText.ValidatedTextChanged, TextCustomNet.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Text)
End Sub End Sub
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioLogoType0.Check, RadioLogoType1.Check, RadioLogoType2.Check, RadioLogoType3.Check, RadioLauncherTheme0.Check, RadioLauncherTheme1.Check, RadioLauncherTheme2.Check, RadioLauncherTheme3.Check, RadioLauncherTheme4.Check, RadioLauncherTheme5.Check, RadioLauncherTheme6.Check, RadioLauncherTheme7.Check, RadioLauncherTheme8.Check, RadioLauncherTheme9.Check, RadioLauncherTheme10.Check, RadioLauncherTheme11.Check, RadioLauncherTheme12.Check, RadioLauncherTheme13.Check, RadioLauncherTheme14.Check, RadioCustomType0.Check, RadioCustomType1.Check, RadioCustomType2.Check, RadioCustomType3.Check Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioLogoType0.Check, RadioLogoType1.Check, RadioLogoType2.Check, RadioLogoType3.Check, RadioCustomType0.Check, RadioCustomType1.Check, RadioCustomType2.Check, RadioCustomType3.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1))) If AniControlEnabled = 0 Then Settings.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)))
End Sub End Sub
'背景图片 '背景图片
@@ -230,7 +192,7 @@
Directory.CreateDirectory(Path & "PCL\Pictures\") Directory.CreateDirectory(Path & "PCL\Pictures\")
Dim Pic As New List(Of String) Dim Pic As New List(Of String)
For Each File In EnumerateFiles(Path & "PCL\Pictures\") For Each File In EnumerateFiles(Path & "PCL\Pictures\")
If File.Extension.ToLower <> ".ini" AndAlso File.Extension.ToLower <> ".db" Then '文件夹可能会被加入 .ini 和 thumbs.db If File.Extension.Lower <> ".ini" AndAlso File.Extension.Lower <> ".db" Then '文件夹可能会被加入 .ini 和 thumbs.db
Pic.Add(File.FullName) Pic.Add(File.FullName)
End If End If
Next Next
@@ -251,8 +213,8 @@
Try Try
Log("[UI] 加载背景图片:" & Address) Log("[UI] 加载背景图片:" & Address)
FrmMain.ImgBack.Background = New MyBitmap(Address) FrmMain.ImgBack.Background = New MyBitmap(Address)
Setup.Load("UiBackgroundSuit", True)
FrmMain.ImgBack.Visibility = Visibility.Visible FrmMain.ImgBack.Visibility = Visibility.Visible
FrmMain.UpdateBackgroundAndTitleBar()
If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Green, False) If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
Catch ex As Exception Catch ex As Exception
If ex.Message.Contains("参数无效") Then If ex.Message.Contains("参数无效") Then
@@ -358,7 +320,7 @@ Refresh:
PanMusicDetail.Visibility = Visibility.Visible PanMusicDetail.Visibility = Visibility.Visible
BtnMusicClear.Visibility = Visibility.Visible BtnMusicClear.Visibility = Visibility.Visible
CardMusic.Title = "背景音乐(" & CardMusic.Title = "背景音乐(" &
EnumerateFiles(Path & "PCL\Musics\").Count(Function(f) Not {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(f.Extension.ToLower)) & EnumerateFiles(Path & "PCL\Musics\").Count(Function(f) Not {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(f.Extension.Lower)) &
" 首)" " 首)"
Else Else
PanMusicVolume.Visibility = Visibility.Collapsed PanMusicVolume.Visibility = Visibility.Collapsed
@@ -428,16 +390,51 @@ Refresh:
"你可以在生成教学文件后直接刷新主页,对照着进行修改,更有助于理解。" & vbCrLf & "你可以在生成教学文件后直接刷新主页,对照着进行修改,更有助于理解。" & vbCrLf &
"直接将主页文件拖进 PCL 窗口也可以快捷加载。", "主页自定义教程") "直接将主页文件拖进 PCL 窗口也可以快捷加载。", "主页自定义教程")
End Sub End Sub
Public Shared Sub OnUiCustomTypeChanged(Value As Integer)
If FrmSetupUI Is Nothing Then Return
Select Case Value
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
Case 1 '本地
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.None)
Case 2 '联网
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
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
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
End Select
FrmSetupUI.CardCustom.TriggerForceResize()
End Sub
'主题 '主题
Private Sub LabLauncherTheme5Unlock_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles LabLauncherTheme5Unlock.MouseLeftButtonUp Private Sub LabLauncherTheme5Unlock_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles LabLauncherTheme5Unlock.MouseLeftButtonUp
RadioLauncherTheme5Gray.Opacity -= 0.23 RadioLauncherTheme5Gray.Opacity -= 0.7
RadioLauncherTheme5.Opacity += 0.23 RadioLauncherTheme5.Opacity += 0.7
AniStart({ AniStart({
AaOpacity(RadioLauncherTheme5Gray, 1, 1000 * AniSpeed), AaOpacity(RadioLauncherTheme5Gray, 1, 1000 * AniSpeed, 500 * AniSpeed, New AniEaseInFluent),
AaOpacity(RadioLauncherTheme5, -1, 1000 * AniSpeed) AaOpacity(RadioLauncherTheme5, -1, 1000 * AniSpeed, 500 * AniSpeed, New AniEaseInFluent)
}, "ThemeUnlock") }, "ThemeUnlock")
If RadioLauncherTheme5Gray.Opacity < 0.08 Then If RadioLauncherTheme5Gray.Opacity < 0.02 Then
ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!") ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!")
AniStop("ThemeUnlock") AniStop("ThemeUnlock")
RadioLauncherTheme5.Checked = True RadioLauncherTheme5.Checked = True
@@ -452,12 +449,12 @@ Refresh:
"若违规,可能会被从任意相关群中踢出!", "若违规,可能会被从任意相关群中踢出!",
"解密游戏的基本规则", "我知道了", "恕我拒绝") = 1 Then "解密游戏的基本规则", "我知道了", "恕我拒绝") = 1 Then
MyMsgBox("你需要用自己的智慧来找到下一步的线索……" & vbCrLf & MyMsgBox("你需要用自己的智慧来找到下一步的线索……" & vbCrLf &
"初始线索:gnp.dorC61\60\20\0202\moc.x1xa.2s\\:sp" & "T".ToLower & "th", "解密游戏") '防止触发病毒检测规则 "初始线索:gnp.dorC61\60\20\0202\moc.x1xa.2s\\:sp" & "T".Lower & "th", "解密游戏") '防止触发病毒检测规则
End If End If
End If End If
End Sub End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp, RadioLauncherTheme8.MouseRightButtonUp Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp, RadioLauncherTheme8.MouseRightButtonUp
OpenWebsite("https://afdian.com/a/LTCat") OpenWebsite("https://meloong.com/afd/a/LTCat")
End Sub End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp, RadioLauncherTheme9.MouseRightButtonUp Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp, RadioLauncherTheme9.MouseRightButtonUp
PageOtherLeft.TryFeedback() PageOtherLeft.TryFeedback()
@@ -516,56 +513,56 @@ Refresh:
If FrmMain.PanTitleSelect Is Nothing OrElse Not FrmMain.PanTitleSelect.IsLoaded Then Return If FrmMain.PanTitleSelect Is Nothing OrElse Not FrmMain.PanTitleSelect.IsLoaded Then Return
Try Try
'顶部栏 '顶部栏
If Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload") AndAlso Setup.Get("UiHiddenPageLink") AndAlso Setup.Get("UiHiddenPageSetup") AndAlso Setup.Get("UiHiddenPageOther") Then If Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageDownload") AndAlso Settings.Get("UiHiddenPageLink") AndAlso Settings.Get("UiHiddenPageSetup") AndAlso Settings.Get("UiHiddenPageOther") Then
'顶部栏已被全部隐藏 '顶部栏已被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Collapsed FrmMain.PanTitleSelect.Visibility = Visibility.Collapsed
Else Else
'顶部栏未被全部隐藏 '顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Settings.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 = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If End If
'功能 '功能
FrmLaunchLeft.RefreshButtonsUI() FrmLaunchLeft.RefreshButtonsUI()
If FrmSetupUI IsNot Nothing Then If FrmSetupUI IsNot Nothing Then
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible) FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
End If End If
'设置子页面 '设置子页面
If FrmSetupLeft IsNot Nothing Then If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Settings.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 = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡 '隐藏左边选择卡
Dim AvaliableCount As Integer = 0 Dim AvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1 If Not Settings.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupUi") Then AvaliableCount += 1 If Not Settings.Get("UiHiddenSetupUi") Then AvaliableCount += 1
'If Not Setup.Get("UiHiddenSetupLink") Then AvaliableCount += 1 'If Not Settings.Get("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupSystem") Then AvaliableCount += 1 If Not Settings.Get("UiHiddenSetupSystem") Then AvaliableCount += 1
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If End If
'更多子页面 '更多子页面
Dim OtherAvaliableCount As Integer = 0 Dim OtherAvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenOtherHelp") Then OtherAvaliableCount += 1 If Not Settings.Get("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherAbout") Then OtherAvaliableCount += 1 If Not Settings.Get("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherTest") Then OtherAvaliableCount += 1 If Not Settings.Get("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1 If Not Settings.Get("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherVote") Then OtherAvaliableCount += 1 If Not Settings.Get("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If FrmOtherLeft IsNot Nothing Then If FrmOtherLeft IsNot Nothing Then
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡 '隐藏左边选择卡
FrmOtherLeft.PanItem.Visibility = If(OtherAvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible) FrmOtherLeft.PanItem.Visibility = If(OtherAvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If End If
If OtherAvaliableCount = 1 AndAlso Not HiddenForceShow Then If OtherAvaliableCount = 1 AndAlso Not HiddenForceShow Then
If Not Setup.Get("UiHiddenOtherHelp") Then If Not Settings.Get("UiHiddenOtherHelp") Then
FrmMain.BtnTitleSelect4.Text = "帮助" FrmMain.BtnTitleSelect4.Text = "帮助"
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
FrmMain.BtnTitleSelect4.Text = "关于" FrmMain.BtnTitleSelect4.Text = "关于"
Else Else
FrmMain.BtnTitleSelect4.Text = "百宝箱" FrmMain.BtnTitleSelect4.Text = "百宝箱"
@@ -595,7 +592,7 @@ Refresh:
CheckHiddenSetupUI.Checked = True CheckHiddenSetupUI.Checked = True
Else Else
'关闭 '关闭
If Setup.Get("UiHiddenSetupLaunch") AndAlso Setup.Get("UiHiddenSetupUi") AndAlso Setup.Get("UiHiddenSetupSystem") AndAlso Setup.Get("UiHiddenSetupLink") Then If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
CheckHiddenSetupLaunch.Checked = False CheckHiddenSetupLaunch.Checked = False
CheckHiddenSetupSystem.Checked = False CheckHiddenSetupSystem.Checked = False
CheckHiddenSetupLink.Checked = False CheckHiddenSetupLink.Checked = False
@@ -605,7 +602,7 @@ Refresh:
End Sub End Sub
Private Sub HiddenSetupSub() Handles CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change Private Sub HiddenSetupSub() Handles CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change
'设置子页面 '设置子页面
If Setup.Get("UiHiddenSetupLaunch") AndAlso Setup.Get("UiHiddenSetupUi") AndAlso Setup.Get("UiHiddenSetupSystem") AndAlso Setup.Get("UiHiddenSetupLink") Then If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
'已被全部隐藏 '已被全部隐藏
CheckHiddenPageSetup.Checked = True CheckHiddenPageSetup.Checked = True
Else Else
@@ -624,8 +621,8 @@ Refresh:
CheckHiddenOtherHelp.Checked = True CheckHiddenOtherHelp.Checked = True
Else Else
'关闭 '关闭
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") AndAlso If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
Setup.Get("UiHiddenOtherVote") AndAlso Setup.Get("UiHiddenOtherFeedback") Then Settings.Get("UiHiddenOtherVote") AndAlso Settings.Get("UiHiddenOtherFeedback") Then
CheckHiddenOtherAbout.Checked = False CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False CheckHiddenOtherTest.Checked = False
CheckHiddenOtherFeedback.Checked = False CheckHiddenOtherFeedback.Checked = False
@@ -636,7 +633,7 @@ Refresh:
End Sub End Sub
Private Sub HiddenOtherSub(sender As Object, user As Boolean) Handles CheckHiddenOtherHelp.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherTest.Change Private Sub HiddenOtherSub(sender As Object, user As Boolean) Handles CheckHiddenOtherHelp.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherTest.Change
'更多子页面(有具体内容的) '更多子页面(有具体内容的)
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") Then If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
'已被全部隐藏 '已被全部隐藏
CheckHiddenPageOther.Checked = True CheckHiddenPageOther.Checked = True
Else Else
@@ -645,7 +642,7 @@ Refresh:
End If End If
'修改无具体内容的项 '修改无具体内容的项
If Not user Then Return If Not user Then Return
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") Then If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
CheckHiddenOtherFeedback.Checked = True CheckHiddenOtherFeedback.Checked = True
CheckHiddenOtherVote.Checked = True CheckHiddenOtherVote.Checked = True
End If End If
@@ -653,8 +650,8 @@ Refresh:
Private Sub HiddenOtherNet(sender As Object, user As Boolean) Handles CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change Private Sub HiddenOtherNet(sender As Object, user As Boolean) Handles CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change
'更多子页面(无具体内容的) '更多子页面(无具体内容的)
If Not user Then Return If Not user Then Return
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") AndAlso If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
(Not Setup.Get("UiHiddenOtherFeedback") OrElse Not Setup.Get("UiHiddenOtherVote")) Then (Not Settings.Get("UiHiddenOtherFeedback") OrElse Not Settings.Get("UiHiddenOtherVote")) Then
CheckHiddenOtherAbout.Checked = False CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False CheckHiddenOtherTest.Checked = False
CheckHiddenOtherHelp.Checked = False CheckHiddenOtherHelp.Checked = False
@@ -668,15 +665,10 @@ Refresh:
#End Region #End Region
'赞助
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
'滑动条 '滑动条
Private Sub SliderLoad() Private Sub SliderLoad()
SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%" SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%"
SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%" SliderLauncherTransparent.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
SliderLauncherHue.GetHintText = Function(v) v & "°" SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherSat.GetHintText = Function(v) v & "%" SliderLauncherSat.GetHintText = Function(v) v & "%"
SliderLauncherDelta.GetHintText = SliderLauncherDelta.GetHintText =
@@ -0,0 +1,81 @@
Public Class SettingService
#Region "属性"
''' <summary>
''' 指定该控件所对应的设置项。
''' </summary>
Public Shared Function GetKey(obj As DependencyObject) As String
If obj Is Nothing Then Return Nothing
Return obj.GetValue(KeyProperty)
End Function
Public Shared Sub SetKey(obj As DependencyObject, value As String)
obj.SetValue(KeyProperty, value)
End Sub
Public Shared ReadOnly KeyProperty As DependencyProperty =
DependencyProperty.RegisterAttached("Key", GetType(String), GetType(SettingService), New PropertyMetadata(Nothing))
''' <summary>
''' 指定该控件所对应的设置值。
''' </summary>
Public Shared Function GetValue(obj As DependencyObject) As String
If obj Is Nothing Then Return Nothing
Return obj.GetValue(ValueProperty)
End Function
Public Shared Sub SetValue(obj As DependencyObject, value As String)
obj.SetValue(ValueProperty, value)
End Sub
Public Shared ReadOnly ValueProperty As DependencyProperty =
DependencyProperty.RegisterAttached("Value", GetType(String), GetType(SettingService), New PropertyMetadata(Nothing))
#End Region
''' <summary>
''' 重置该控件以及它所有的子控件的设置值。
''' </summary>
Public Shared Sub ResetSettings(Target As DependencyObject)
LogicalTreeHelper.GetChildren(Target).OfType(Of DependencyObject)().ForEach(Sub(c) ResetSettings(c)) '处理子控件
Dim Key = GetKey(Target)
If Key Is Nothing Then Return
Settings.Reset(Key, Instance:=PageInstanceLeft.Instance)
End Sub
''' <summary>
''' 更新该控件以及它所有的子控件当前显示的设置值。
''' </summary>
Public Shared Sub RefreshSettings(Target As DependencyObject)
LogicalTreeHelper.GetChildren(Target).OfType(Of DependencyObject)().ForEach(Sub(c) RefreshSettings(c)) '处理子控件
Dim Key = GetKey(Target)
If Key Is Nothing Then Return
Dim NewValue = Settings.Get(Key, Instance:=PageInstanceLeft.Instance)
If TypeOf Target Is ISettingControl Then DirectCast(Target, ISettingControl).RefreshSetting(NewValue)
End Sub
''' <summary>
''' 当控件对应的设置改变时,将内容保存到设置中。
''' </summary>
Public Shared Sub SaveSetting(sender As Object)
If AniControlEnabled <> 0 Then Return
If TypeOf sender IsNot ISettingControl Then Return
Dim Key = GetKey(sender)
If Key Is Nothing Then Return
Dim NewValue As String = DirectCast(sender, ISettingControl).GetCurrentSetting()
If NewValue Is Nothing Then Return
Settings.Set(Key, NewValue, Instance:=PageInstanceLeft.Instance)
End Sub
End Class
Public Interface ISettingControl
''' <summary>
''' 更新该控件当前所显示的设置值。
''' </summary>
Sub RefreshSetting(NewValue As String)
''' <summary>
''' 获取该控件当前设定的设置值。
''' 若不应当关联该设置值,则返回 Nothing。
''' </summary>
Function GetCurrentSetting() As String
End Interface
@@ -0,0 +1,400 @@
Public Class Settings
Private Shared ReadOnly Entries As Dictionary(Of String, Setting) = (New List(Of Setting) From {
New Setting("Identify", "", Source:=Sources.Registry),
New Setting("WindowHeight", 550),
New Setting("WindowWidth", 900),
New Setting("AprilDoneYear", 0, Source:=Sources.Registry),
New Setting("HintDownloadThread", False, Source:=Sources.Registry),
New Setting("HintNotice", 0, Source:=Sources.Registry),
New Setting("HintDownload", 0, Source:=Sources.Registry),
New Setting("HintHide", False, Source:=Sources.Registry),
New Setting("HintHandInstall", False, Source:=Sources.Registry),
New Setting("HintBuy", False, Source:=Sources.Registry),
New Setting("HintClearRubbish", 0, Source:=Sources.Registry),
New Setting("HintUpdateMod", False, Source:=Sources.Registry),
New Setting("HintCustomCommand", False, Source:=Sources.Registry),
New Setting("HintCustomWarn", False, Source:=Sources.Registry),
New Setting("HintMoreAdvancedSetup", False, Source:=Sources.Registry),
New Setting("HintIndieSetup", False, Source:=Sources.Registry),
New Setting("HintExportConfig", False, Source:=Sources.Registry),
New Setting("SystemEulaVersion", 0, Source:=Sources.Registry),
New Setting("SystemCount", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemLaunchCount", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemLastVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHighestSavedBetaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHighestBetaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHighestAlphaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHelpVersion", 0, Source:=Sources.Registry),
New Setting("SystemDebugMode", False, Source:=Sources.Registry),
New Setting("SystemDebugAnim", 9, Source:=Sources.Registry),
New Setting("SystemDebugDelay", False, Source:=Sources.Registry),
New Setting("SystemDebugSkipCopy", False, Source:=Sources.Registry),
New Setting("SystemSystemCache", "", Source:=Sources.Registry),
New Setting("SystemSystemUpdate", 0),
New Setting("SystemSystemActivity", 0),
New Setting("SystemSystemTelemetry", True, Source:=Sources.Registry),
New Setting("CacheDrops", "", Source:=Sources.Registry),
New Setting("CacheConfig", 0, Source:=Sources.Registry),
New Setting("CacheExportConfig", "", Source:=Sources.Registry),
New Setting("CacheSavedPageUrl", "", Source:=Sources.Registry),
New Setting("CacheSavedPageVersion", "", Source:=Sources.Registry),
New Setting("CacheMsOAuthRefresh", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsAccess", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsProfileJson", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsUuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Migrated", False, Source:=Sources.Registry),
New Setting("CacheMsV2OAuthRefresh", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Access", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2ProfileJson", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Uuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Name", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideAccess", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideClient", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideUuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideUsername", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNidePass", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideServer", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthAccess", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthClient", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthUuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthUsername", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthPass", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthServerServer", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthServerName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheAuthServerRegister", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheDownloadFolder", "", Source:=Sources.Registry),
New Setting("CacheJavaListVersion", 0, Source:=Sources.Registry),
New Setting("LoginRemember", True, Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginLegacyName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginMsJson", "{}", Source:=Sources.Registry, Encrypted:=True), '{UserName: OAuthToken, ...}
New Setting("LoginNideEmail", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginNidePass", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginAuthEmail", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginAuthPass", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("LoginType", McLoginType.Legacy, Source:=Sources.Registry),
New Setting("LoginPageType", 0),
New Setting("LaunchSkinID", "", Source:=Sources.Registry, OnChanged:=Sub() PageLaunchLeft.SkinLegacy.Start()),
New Setting("LaunchSkinType", 0, Source:=Sources.Registry, OnChanged:=AddressOf PageSetupLaunch.UpdateSkinType),
New Setting("LaunchSkinSlim", False, Source:=Sources.Registry),
New Setting("LaunchFolderSelect", ""),
New Setting("LaunchFolders", "", Source:=Sources.Registry),
New Setting("LaunchArgumentTitle", ""),
New Setting("LaunchArgumentInfo", "PCL"),
New Setting("LaunchArgumentJavaSelect", "", Source:=Sources.Registry),
New Setting("LaunchArgumentJavaAll", "[]", Source:=Sources.Registry),
New Setting("LaunchArgumentIndie", 0),
New Setting("LaunchArgumentIndieV2", 4),
New Setting("LaunchArgumentVisible", 5, Source:=Sources.Registry),
New Setting("LaunchArgumentPriority", 1, Source:=Sources.Registry),
New Setting("LaunchArgumentWindowWidth", 854),
New Setting("LaunchArgumentWindowHeight", 480),
New Setting("LaunchArgumentWindowType", 1),
New Setting("LaunchArgumentRam", False, Source:=Sources.Registry),
New Setting("LaunchAdvanceJvm", "-XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=True -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True"),
New Setting("LaunchAdvanceGame", ""),
New Setting("LaunchAdvanceRun", ""),
New Setting("LaunchAdvanceRunWait", True),
New Setting("LaunchAdvanceDisableJLW", False),
New Setting("LaunchAdvanceGraphicCard", True, Source:=Sources.Registry),
New Setting("LaunchAdvanceGC", 4),
New Setting("LaunchRamType", 0, OnChanged:=AddressOf PageSetupLaunch.UpdateRamType),
New Setting("LaunchRamCustom", 15),
New Setting("LinkLastAutoJoinInviteCode", "", Source:=Sources.Registry),
New Setting("LinkLatencyMode", 0, Source:=Sources.Registry),
New Setting("LinkCustomPeer", ""),
New Setting("LinkEasyTierVersion", -1, Source:=Sources.Registry),
New Setting("ToolHelpChinese", True, Source:=Sources.Registry),
New Setting("ToolDownloadThread", 63, Source:=Sources.Registry),
New Setting("ToolDownloadSpeed", 42, Source:=Sources.Registry, OnChanged:=AddressOf ModNet.UpdateNetTaskSpeedLimitHigh),
New Setting("ToolDownloadSource", 1, Source:=Sources.Registry),
New Setting("ToolDownloadVersion", 1, Source:=Sources.Registry),
New Setting("ToolDownloadTranslate", 0, Source:=Sources.Registry),
New Setting("ToolDownloadTranslateV2", 1, Source:=Sources.Registry),
New Setting("ToolDownloadIgnoreQuilt", True, Source:=Sources.Registry),
New Setting("ToolDownloadCert", False, Source:=Sources.Registry, OnChanged:=AddressOf ModNet.ShouldValidateSslCertificateOnLogin),
New Setting("ToolDownloadMod", 2, Source:=Sources.Registry),
New Setting("ToolModLocalNameStyle", 0, Source:=Sources.Registry),
New Setting("ToolUpdateRelease", False, Source:=Sources.Registry),
New Setting("ToolUpdateSnapshot", False, Source:=Sources.Registry),
New Setting("ToolUpdateReleaseLast", "", Source:=Sources.Registry),
New Setting("ToolUpdateSnapshotLast", "", Source:=Sources.Registry),
New Setting("UiLauncherTransparent", 600, OnChanged:=Sub(Value As Integer) If FrmMain IsNot Nothing Then FrmMain.Opacity = Value / 1000 + 0.4), '避免与 PCL1 设置冲突(UiLauncherOpacity)
New Setting("UiLauncherHue", 180),
New Setting("UiLauncherSat", 80),
New Setting("UiLauncherDelta", 90),
New Setting("UiLauncherLight", 20),
New Setting("UiLauncherTheme", 0, OnChanged:=AddressOf ThemeRefresh),
New Setting("UiLauncherThemeGold", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("UiLauncherThemeHide", "0|1|2|3|4", Source:=Sources.Registry, Encrypted:=True),
New Setting("UiLauncherThemeHide2", "0|1|2|3|4", Source:=Sources.Registry, Encrypted:=True),
New Setting("UiLauncherLogo", True),
New Setting("UiLauncherEmail", False),
New Setting("UiBackgroundColorful", True, OnChanged:=Sub() ThemeRefresh()), '不传入参数
New Setting("UiBackgroundOpacity", 1000, OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiBackgroundBlur", 0, OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiBackgroundSuit", 0, OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiCustomType", 0, OnChanged:=AddressOf PageSetupUI.OnUiCustomTypeChanged),
New Setting("UiCustomPreset", 0),
New Setting("UiCustomNet", ""),
New Setting("UiLogoType", 1, OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiLogoText", "", OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiLogoLeft", False, OnChanged:=AddressOf FormMain.UpdateBackgroundAndTitleBar),
New Setting("UiMusicVolume", 500),
New Setting("UiMusicStop", False),
New Setting("UiMusicStart", False),
New Setting("UiMusicRandom", True),
New Setting("UiMusicAuto", True),
New Setting("UiHiddenPageDownload", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenPageLink", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenPageSetup", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenPageOther", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenFunctionSelect", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenFunctionModUpdate", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenFunctionHidden", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenSetupLaunch", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenSetupUi", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenSetupLink", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenSetupSystem", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenOtherHelp", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenOtherFeedback", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenOtherVote", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenOtherAbout", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("UiHiddenOtherTest", False, OnChanged:=AddressOf PageSetupUI.HiddenRefresh),
New Setting("VersionAdvanceJvm", "", Source:=Sources.Instance),
New Setting("VersionAdvanceGame", "", Source:=Sources.Instance),
New Setting("VersionAdvanceAssets", 0, Source:=Sources.Instance),
New Setting("VersionAdvanceAssetsV2", False, Source:=Sources.Instance),
New Setting("VersionAdvanceJava", False, Source:=Sources.Instance),
New Setting("VersionAdvanceRun", "", Source:=Sources.Instance),
New Setting("VersionAdvanceRunWait", True, Source:=Sources.Instance),
New Setting("VersionAdvanceDisableJLW", False, Source:=Sources.Instance),
New Setting("VersionAdvanceDisableModUpdate", False, Source:=Sources.Instance),
New Setting("VersionAdvanceGC", 0, Source:=Sources.Instance),
New Setting("VersionRamType", 2, Source:=Sources.Instance, OnChanged:=AddressOf PageInstanceSetup.OnVersionRamTypeChanged),
New Setting("VersionRamCustom", 15, Source:=Sources.Instance),
New Setting("VersionRamOptimize", 0, Source:=Sources.Instance),
New Setting("VersionArgumentTitle", "", Source:=Sources.Instance),
New Setting("VersionArgumentInfo", "", Source:=Sources.Instance),
New Setting("VersionArgumentIndie", -1, Source:=Sources.Instance),
New Setting("VersionArgumentIndieV2", False, Source:=Sources.Instance),
New Setting("VersionArgumentJavaSelect", "使用全局设置", Source:=Sources.Instance),
New Setting("VersionServerEnter", "", Source:=Sources.Instance),
New Setting("VersionServerLogin", 0, Source:=Sources.Instance, OnChanged:=AddressOf PageInstanceSetup.OnVersionServerLoginChanged),
New Setting("VersionServerNide", "", Source:=Sources.Instance),
New Setting("VersionServerAuthRegister", "", Source:=Sources.Instance),
New Setting("VersionServerAuthName", "", Source:=Sources.Instance),
New Setting("VersionServerAuthServer", "", Source:=Sources.Instance)
}).ToDictionary(Function(e) e.Key)
Private Enum Sources
Normal
Registry
Instance
End Enum
Private Class Setting
Public Key As String
''' <summary>
''' 若已调用过 Get 方法,则为当前值;否则为 Nothing。
''' </summary>
Public Value = Nothing
Public Encrypted As Boolean
Public DefaultValue
Public Source As Sources
''' <summary>
''' 当设置项的值实际被改变时触发,参数为新值。
''' </summary>
Public OnChanged As Action(Of Object)
''' <summary>
''' 该设置的值的实际类型。
''' </summary>
Public Type As Type
Public Sub New(Key As String, Value As Object, Optional Source As Sources = Sources.Normal, Optional Encrypted As Boolean = False, Optional OnChanged As Action(Of Object) = Nothing)
Try
Me.Key = Key
Me.DefaultValue = Value
Me.Encrypted = Encrypted
Me.Source = Source
Me.Type = If(Value, "").GetType
Me.OnChanged = OnChanged
Catch ex As Exception
Log(ex, "初始化设置项失败", LogLevel.Feedback) '#5095 的 fallback
End Try
End Sub
End Class
''' <summary>
''' 改变某个设置项的值。
''' </summary>
Public Shared Sub [Set](Key As String, Value As Object, Optional Instance As McInstance = Nothing)
Dim Entry As Setting = Nothing
If Not Entries.TryGetValue(Key, Entry) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
Try
'判断是否一致
If Entry.Value Is Nothing Then [Get](Key, Instance)
Value = CTypeDynamic(Value, Entry.Type)
If Entry.Value = Value Then Return
'设置新值
Entry.Value = Value
If Entry.Encrypted Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & Identify)
Catch ex As Exception
Log(ex, "加密设置失败:" & Key, LogLevel.Developer)
End Try
End If
Select Case Entry.Source
Case Sources.Normal
WriteIni("Setup", Key, Value)
Case Sources.Registry
WriteReg(Key, Value)
Case Sources.Instance
If Instance Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本")
WriteIni(Instance.PathVersion & "PCL\Setup.ini", Key, Value)
End Select
'触发改变事件(必须在写入之后,以保证 VersionServerLogin 之类的在事件中读取到的是最新的值)
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Value)
Catch ex As Exception
Log(ex, "设置设置项时出错(" & Key & ", " & Value & ")", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 写入某个未经加密的设置项。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Shared Sub SetSafe(Key As String, Value As Object, Optional Instance As McInstance = Nothing)
Dim Entry As Setting = Nothing
If Not Entries.TryGetValue(Key, Entry) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
If Entry.Encrypted Then Throw New InvalidOperationException("禁止写入加密设置项:" & Key)
[Set](Key, Instance, Instance)
End Sub
''' <summary>
''' 获取某个设置项的值。
''' </summary>
Public Shared Function [Get](Key As String, Optional Instance As McInstance = Nothing)
Dim Entry As Setting = Nothing
If Not Entries.TryGetValue(Key, Entry) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
If Entry.Value IsNot Nothing Then Return Entry.Value
'对部分设置强制赋值
Static ForcedSettings As New Dictionary(Of String, Object) From {
{"UiHiddenPageLink", True},
{"UiHiddenSetupLink", True}
}
Dim ForcedSetting As Object = Nothing
If ForcedSettings.TryGetValue(Key, ForcedSetting) Then
Entry.Value = ForcedSetting
Return Entry.Value
End If
'正常读取
Try
Dim GotValue As String = Nothing '先用 String 储存,避免类型转换
Dim DefaultValue As String = If(Entry.Encrypted, SecretEncrypt(Entry.DefaultValue, "PCL" & Identify), Entry.DefaultValue)
Select Case Entry.Source
Case Sources.Normal
GotValue = ReadIni("Setup", Key, DefaultValue)
Case Sources.Registry
GotValue = ReadReg(Key, DefaultValue)
Case Sources.Instance
If Instance Is Nothing Then
Throw New Exception($"读取版本设置 {Key} 时未提供目标版本")
Else
GotValue = ReadIni(Instance.PathVersion & "PCL\Setup.ini", Key, DefaultValue)
End If
End Select
If Entry.Encrypted Then
If GotValue = DefaultValue Then
GotValue = Entry.DefaultValue
Else
Try
GotValue = SecretDecrypt(GotValue, "PCL" & Identify)
Catch ex As Exception
Log(ex, "解密设置失败:" & Key, LogLevel.Developer)
GotValue = Entry.DefaultValue
[Set](Key, Entry.DefaultValue)
End Try
End If
End If
Entry.Value = CTypeDynamic(GotValue, Entry.Type)
Catch ex As Exception
Log(ex, "读取设置失败:" & Key, LogLevel.Hint)
Entry.Value = CTypeDynamic(Entry.DefaultValue, Entry.Type)
End Try
Return Entry.Value
End Function
''' <summary>
''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密,则会抛出异常。
''' </summary>
Public Shared Function GetSafe(Key As String, Optional Instance As McInstance = Nothing)
Dim Entry As Setting = Nothing
If Not Entries.TryGetValue(Key, Entry) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
If Entry.Encrypted Then Throw New InvalidOperationException("禁止读取加密设置项:" & Key)
Return [Get](Key, Instance)
End Function
''' <summary>
''' 初始化某个设置项的值。
''' </summary>
Public Shared Sub Reset(Key As String, Optional Instance As McInstance = Nothing)
Dim Entry As Setting = Nothing
If Not Entries.TryGetValue(Key, Entry) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
Try
'判断是否一致
If Entry.Value Is Nothing Then [Get](Key, Instance)
If Entry.Value = Entry.DefaultValue Then Return
'设置新值
Entry.Value = Entry.DefaultValue
Select Case Entry.Source
Case Sources.Normal
DeleteIniKey("Setup", Key)
Case Sources.Registry
DeleteReg(Key)
Case Sources.Instance
If Instance Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本")
DeleteIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
'触发改变事件
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Entry.Value)
Catch ex As Exception
Log(ex, "重置设置项时出错(" & Key & ")", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 获取某个设置项的默认值。
''' </summary>
Public Shared Function GetDefault(Key As String) As String
Return Entries(Key).DefaultValue
End Function
''' <summary>
''' 对应的注册表或文件是否已经储存了某个设置项。
''' 若改成了和默认值一样的,在 2.12.3- 会储存更改,在 2.12.4+ 不会储存更改。
''' </summary>
Public Shared Function HasSaved(Key As String, Optional Instance As McInstance = Nothing) As Boolean
Select Case Entries(Key).Source
Case Sources.Normal
Return HasIniKey("Setup", Key)
Case Sources.Registry
Return HasReg(Key)
Case Else 'Source.Instance
If Instance Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本")
Return HasIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
End Function
''' <summary>
''' 当前版本改变时,要求所有版本独立设置需要重新读取。
''' </summary>
Public Shared Sub MakeInstanceDirty()
For Each Entry In Entries.Values
If Entry.Source = Sources.Instance Then Entry.Value = Nothing
Next
End Sub
End Class
@@ -140,7 +140,7 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "更新下载管理显示失败(" & Loader.State.ToString & ")", LogLevel.Feedback) Log(ex, "更新下载管理显示失败(" & Loader.State.ToString & ")", LogLevel.Feedback)
End Try End Try
ElseIf Not (Loader.State = LoadState.Aborted OrElse Loader.State = LoadState.Finished) Then ElseIf Not (Loader.State = LoadState.Interrupted OrElse Loader.State = LoadState.Finished) Then
Try Try
#Region "没有卡片且未中断或完成,添加新的卡片" #Region "没有卡片且未中断或完成,添加新的卡片"
Dim CardXAML As String = " Dim CardXAML As String = "
@@ -194,7 +194,7 @@
RightCards.Remove(Loader.Name) RightCards.Remove(Loader.Name)
LoaderTaskbar.Remove(Loader) LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 关闭下载管理卡片:{Loader.Name},且移出任务列表") Log($"[Taskbar] 关闭下载管理卡片:{Loader.Name},且移出任务列表")
RunInThread(Sub() Loader.Abort()) RunInThread(Sub() Loader.Interrupt())
End Sub End Sub
'如果已经失败,再刷新一次,修改成失败的控件 '如果已经失败,再刷新一次,修改成失败的控件
If Loader.State = LoadState.Failed Then If Loader.State = LoadState.Failed Then
@@ -383,7 +383,7 @@
<Compile Include="Pages\PageSetup\PageSetupLeft.xaml.vb"> <Compile Include="Pages\PageSetup\PageSetupLeft.xaml.vb">
<DependentUpon>PageSetupLeft.xaml</DependentUpon> <DependentUpon>PageSetupLeft.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageSetup\ModSetup.vb" /> <Compile Include="Pages\PageSetup\Settings.vb" />
<Compile Include="Pages\PageSetup\PageSetupLaunch.xaml.vb"> <Compile Include="Pages\PageSetup\PageSetupLaunch.xaml.vb">
<DependentUpon>PageSetupLaunch.xaml</DependentUpon> <DependentUpon>PageSetupLaunch.xaml</DependentUpon>
</Compile> </Compile>
@@ -396,6 +396,7 @@
<Compile Include="Pages\PageSetup\PageSetupUI.xaml.vb"> <Compile Include="Pages\PageSetup\PageSetupUI.xaml.vb">
<DependentUpon>PageSetupUI.xaml</DependentUpon> <DependentUpon>PageSetupUI.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageSetup\SettingService.vb" />
<Compile Include="Pages\PageSpeedLeft.xaml.vb"> <Compile Include="Pages\PageSpeedLeft.xaml.vb">
<DependentUpon>PageSpeedLeft.xaml</DependentUpon> <DependentUpon>PageSpeedLeft.xaml</DependentUpon>
</Compile> </Compile>
Binary file not shown.
File diff suppressed because it is too large Load Diff