diff --git a/Plain Craft Launcher 2/Application.xaml b/Plain Craft Launcher 2/Application.xaml index a9b8db3..adbf7c0 100644 --- a/Plain Craft Launcher 2/Application.xaml +++ b/Plain Craft Launcher 2/Application.xaml @@ -19,6 +19,7 @@ + #343d4a @@ -287,21 +288,21 @@ - + - + - + - + diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index 4233f8f..beec27a 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -1,5 +1,4 @@ -Imports System.Net -Imports System.Reflection +Imports System.Reflection Imports System.Windows.Threading Public Class Application @@ -26,7 +25,15 @@ Public Class Application If e.Args(0) = "--update" Then '自动更新 UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4)) - Environment.Exit(Result.Cancel) + Environment.Exit(ProcessReturnValues.TaskDone) + ElseIf e.Args(0) = "--gpu" Then + '调整显卡设置 + Try + SetGPUPreference(e.Args(1).Trim("""")) + Environment.Exit(ProcessReturnValues.TaskDone) + Catch ex As Exception + Environment.Exit(ProcessReturnValues.Fail) + End Try ElseIf e.Args(0).StartsWithF("--memory") Then '内存优化 Dim Ram = My.Computer.Info.AvailablePhysicalMemory @@ -45,10 +52,10 @@ Public Class Application '制作更新包 ElseIf e.Args(0) = "--edit1" Then ExeEdit(e.Args(1), True) - Environment.Exit(Result.Cancel) + Environment.Exit(ProcessReturnValues.TaskDone) ElseIf e.Args(0) = "--edit2" Then ExeEdit(e.Args(1), False) - Environment.Exit(Result.Cancel) + Environment.Exit(ProcessReturnValues.TaskDone) #End If End If End If @@ -87,7 +94,7 @@ WaitRetry: ShowWindowToTop(WindowHwnd) '播放提示音并退出 Beep() - Environment.[Exit](Result.Cancel) + Environment.[Exit](ProcessReturnValues.Cancel) End If #End If '设置 ToolTipService 默认值 @@ -143,7 +150,7 @@ WaitRetry: Catch End Try MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误") - FormMain.EndProgramForce(Result.Exception) + FormMain.EndProgramForce(ProcessReturnValues.Exception) End Try End Sub @@ -160,7 +167,7 @@ WaitRetry: If IsProgramEnded Then Exit Sub If IsCritErrored Then '在汇报错误后继续引发错误，知道这次压不住了 - FormMain.EndProgramForce(Result.Exception) + FormMain.EndProgramForce(ProcessReturnValues.Exception) Exit Sub End If IsCritErrored = True @@ -171,7 +178,7 @@ WaitRetry: ExceptionString.Contains("未能加载文件或程序集") Then OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer") MsgBox("你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.6.2！", MsgBoxStyle.Information, "运行环境错误") - FormMain.EndProgramForce(Result.Cancel) + FormMain.EndProgramForce(ProcessReturnValues.Cancel) Else FeedbackInfo() Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫") diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb index 858224d..1b1a5b5 100644 --- a/Plain Craft Launcher 2/Controls/MyCard.vb +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -3,7 +3,7 @@ '控件 Inherits Grid Private ReadOnly MainGrid As Grid - Private ReadOnly MainChrome As SystemDropShadowChrome + Public ReadOnly Property MainChrome As SystemDropShadowChrome Private ReadOnly MainBorder As Border Public Property BorderChild As UIElement Get @@ -41,6 +41,15 @@ Return MainTextBlock.Inlines End Get End Property + Public Property CornerRadius As CornerRadius + Get + Return MainChrome.CornerRadius + End Get + Set(value As CornerRadius) + MainChrome.CornerRadius = value + MainBorder.CornerRadius = value + End Set + End Property Public Property Title As String Get Return GetValue(TitleProperty) @@ -103,13 +112,13 @@ '排序 Select Case Type Case 3 - Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay)) + Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay)) Case 4, 10 - Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit)) + Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit)) Case 6 - Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version) + Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version) Case 8, 9 - Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate) + Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate) End Select '控件转换 Select Case Type @@ -185,10 +194,10 @@ If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150)) If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150)) AniList.AddRange({ - AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180), - AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180), - AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180) - }) + AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180), + AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180), + AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180) + }) AniStart(AniList, "MyCard Mouse " & Uuid) End Sub Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave @@ -197,10 +206,10 @@ If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250)) If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250)) AniList.AddRange({ - AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300), - AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300), - AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300) - }) + AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300), + AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300), + AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300) + }) AniStart(AniList, "MyCard Mouse " & Uuid) End Sub @@ -335,18 +344,19 @@ Partial Public Module ModAnimation If Control.IsHitTestVisible Then Control.IsHitTestVisible = False AniStart({ - AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent), - AaOpacity(Control, -1, 200,, New AniEaseOutFluent), - AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent), - AaCode(Sub() - If RemoveFromChildren Then - If Control.Parent Is Nothing Then Exit Sub - CType(Control.Parent, Object).Children.Remove(Control) - Else - Control.Visibility = Visibility.Collapsed - End If - If CallBack IsNot Nothing Then CallBack(Control) - End Sub,, True) + AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent), + AaOpacity(Control, -1, 200,, New AniEaseOutFluent), + AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent), + AaCode( + Sub() + If RemoveFromChildren Then + If Control.Parent Is Nothing Then Exit Sub + CType(Control.Parent, Object).Children.Remove(Control) + Else + Control.Visibility = Visibility.Collapsed + End If + If CallBack IsNot Nothing Then CallBack(Control) + End Sub,, True) }, "MyCard Dispose " & Control.Uuid) Else If RemoveFromChildren Then diff --git a/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb index d6da198..c26cb79 100644 --- a/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb @@ -113,9 +113,9 @@ Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), - AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) - }, "MyExtraButton Scale " & Uuid) + AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) End If IsLeftMouseHeld = True Focus() @@ -124,9 +124,9 @@ If Not CanRightClick Then Exit Sub If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), - AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) - }, "MyExtraButton Scale " & Uuid) + AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) End If IsRightMouseHeld = True Focus() @@ -134,8 +134,8 @@ Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp If Not IsRightMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) - }, "MyExtraButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraButton Scale " & Uuid) End If IsLeftMouseHeld = False RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave @@ -144,8 +144,8 @@ If Not CanRightClick Then Exit Sub If Not IsLeftMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) - }, "MyExtraButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraButton Scale " & Uuid) End If IsRightMouseHeld = False RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave @@ -154,8 +154,8 @@ IsLeftMouseHeld = False IsRightMouseHeld = False AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) - }, "MyExtraButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave End Sub @@ -163,11 +163,14 @@ '务必放在 IsMouseDown 更新之后 Private Const AnimationColorIn As Integer = 120 Private Const AnimationColorOut As Integer = 150 - Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded + Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged Try If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 - If IsMouseOver Then + If Not IsEnabled Then + '禁用 + AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraButton Color " & Uuid) + ElseIf IsMouseOver Then '指向 AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid) Else @@ -178,7 +181,9 @@ Else AniStop("MyExtraButton Color " & Uuid) - If IsMouseOver Then + If Not IsEnabled Then + PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4") + ElseIf IsMouseOver Then PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4") Else PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3") diff --git a/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml b/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml index 82eb216..795a7bd 100644 --- a/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml +++ b/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml @@ -4,7 +4,7 @@ xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton" - RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="52"> + RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" Height="52" Margin="20"> @@ -20,14 +20,14 @@ - - + + + Margin="12,0,0,0.8" /> \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb index 2af39d2..67ea22f 100644 --- a/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb @@ -82,7 +82,7 @@ Public Class MyExtraTextButton '触发点击事件 Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp If IsLeftMouseHeld Then - Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString)) + Log("[Control] 按下附加图标按钮：" & Text) RaiseEvent Click(sender, e) e.Handled = True Button_LeftMouseUp() @@ -94,33 +94,33 @@ Public Class MyExtraTextButton Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown If Not IsLeftMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), - AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) - }, "MyExtraTextButton Scale " & Uuid) + AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) + }, "MyExtraTextButton Scale " & Uuid) End If IsLeftMouseHeld = True Focus() End Sub Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) - }, "MyExtraTextButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraTextButton Scale " & Uuid) IsLeftMouseHeld = False RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave End Sub Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp If Not IsLeftMouseHeld Then AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) - }, "MyExtraTextButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraTextButton Scale " & Uuid) End If RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave End Sub Private Sub Button_MouseLeave() Handles PanClick.MouseLeave IsLeftMouseHeld = False AniStart({ - AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) - }, "MyExtraTextButton Scale " & Uuid) + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) + }, "MyExtraTextButton Scale " & Uuid) RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave End Sub @@ -128,11 +128,14 @@ Public Class MyExtraTextButton '务必放在 IsMouseDown 更新之后 Private Const AnimationColorIn As Integer = 120 Private Const AnimationColorOut As Integer = 150 - Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded + Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged Try If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 - If IsMouseOver Then + If Not IsEnabled Then + '禁用 + AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraTextButton Color " & Uuid) + ElseIf IsMouseOver Then '指向 AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraTextButton Color " & Uuid) Else @@ -143,7 +146,9 @@ Public Class MyExtraTextButton Else AniStop("MyExtraTextButton Color " & Uuid) - If IsMouseOver Then + If Not IsEnabled Then + PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4") + ElseIf IsMouseOver Then PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4") Else PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3") @@ -151,7 +156,7 @@ Public Class MyExtraTextButton End If Catch ex As Exception - Log(ex, "刷新图标按钮颜色出错") + Log(ex, "刷新附加图标按钮颜色出错") End Try End Sub diff --git a/Plain Craft Launcher 2/Controls/MyHint.xaml.vb b/Plain Craft Launcher 2/Controls/MyHint.xaml.vb index 89fc93a..9473374 100644 --- a/Plain Craft Launcher 2/Controls/MyHint.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyHint.xaml.vb @@ -40,12 +40,17 @@ Public Class MyHint End Property Public Property Text As String Get - Return LabText.Text + Return GetValue(TextProperty) End Get Set(value As String) - LabText.Text = value + SetValue(TextProperty, value) End Set End Property + Public Shared ReadOnly TextProperty As DependencyProperty = + DependencyProperty.Register("Text", GetType(String), GetType(MyHint), New PropertyMetadata("", + Sub(d As MyHint, e As DependencyPropertyChangedEventArgs) + d.LabText.Text = e.NewValue + End Sub)) Public Property CanClose As Boolean Get @@ -56,7 +61,7 @@ Public Class MyHint End Set End Property - Public RelativeSetup As String = "" + Public Property RelativeSetup As String = "" Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb index db017ee..87ab62c 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -174,7 +174,7 @@ Public Class MyListItem Return GetValue(TitleProperty) End Get Set(value As String) - SetValue(TitleProperty, value) + SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, "")) End Set End Property Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem)) diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb index 56ae475..ca7bcac 100644 --- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb @@ -72,7 +72,7 @@ End Sub Public Sub Btn1_Click() Handles Btn1.Click - If MyConverter.IsExited OrElse Not TextArea.ValidateResult = "" Then Exit Sub + If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub MyConverter.IsExited = True MyConverter.Result = TextArea.Text Close() @@ -85,7 +85,7 @@ End Sub Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextArea.ValidateChanged - Btn1.IsEnabled = TextArea.ValidateResult = "" + Btn1.IsEnabled = TextArea.IsValidated End Sub Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown diff --git a/Plain Craft Launcher 2/Controls/MyPageRight.vb b/Plain Craft Launcher 2/Controls/MyPageRight.vb index bb04053..4c427b5 100644 --- a/Plain Craft Launcher 2/Controls/MyPageRight.vb +++ b/Plain Craft Launcher 2/Controls/MyPageRight.vb @@ -355,14 +355,14 @@ For Each Control As FrameworkElement In GetAllAnimControls(Element) If TypeOf Control Is MyExtraTextButton Then CType(Control, MyExtraTextButton).Show = True - Continue For + Else + Control.Opacity = 0 + Control.RenderTransform = New TranslateTransform(0, -16) + AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak))) + AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent)) + AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack)) + Delay += 40 End If - Control.Opacity = 0 - Control.RenderTransform = New TranslateTransform(0, -16) - AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak))) - AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent)) - AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack)) - Delay += 40 Next Next '滚动条动画 @@ -385,12 +385,12 @@ For Each Control As FrameworkElement In GetAllAnimControls(Element) If TypeOf Control Is MyExtraTextButton Then CType(Control, MyExtraTextButton).Show = False - Continue For + Else + Control.IsHitTestVisible = False + AniList.Add(AaOpacity(Control, -1, 90, Delay)) + AniList.Add(AaTranslateY(Control, -6, 90, Delay)) + Delay += 20 End If - Control.IsHitTestVisible = False - AniList.Add(AaOpacity(Control, -1, 90, Delay)) - AniList.Add(AaTranslateY(Control, -6, 90, Delay)) - Delay += 20 Next Next '滚动条动画 @@ -410,22 +410,28 @@ AniStart(AniList, "PageRight PageChange " & PageUuid) End Sub - '遍历获取所有需要生成动画的控件 - Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement) + ''' + ''' 禁用页面切换动画的控件列表。 + ''' + Public DisabledPageAnimControls As New List(Of FrameworkElement) + ''' + ''' 遍历获取所有需要生成动画的控件。 + ''' + Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As IEnumerable(Of FrameworkElement) Dim AllControls As New List(Of FrameworkElement) - GetAllAnimControls(Element, AllControls, IgnoreInvisibility) - Return AllControls + _GetAllAnimControls(Element, AllControls, IgnoreInvisibility) + Return AllControls.Except(DisabledPageAnimControls) End Function - Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean) + Private Sub _GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean) If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then AllControls.Add(Element) ElseIf TypeOf Element Is ContentControl Then Dim Content = CType(Element, ContentControl).Content - If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then GetAllAnimControls(Content, AllControls, IgnoreInvisibility) + If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then _GetAllAnimControls(Content, AllControls, IgnoreInvisibility) ElseIf TypeOf Element Is Panel Then For Each Element2 In CType(Element, Panel).Children - If TypeOf Element2 Is FrameworkElement Then GetAllAnimControls(Element2, AllControls, IgnoreInvisibility) + If TypeOf Element2 Is FrameworkElement Then _GetAllAnimControls(Element2, AllControls, IgnoreInvisibility) Next End If End Sub diff --git a/Plain Craft Launcher 2/Controls/MySearchBox.xaml b/Plain Craft Launcher 2/Controls/MySearchBox.xaml index 63b0e67..efdf8dd 100644 --- a/Plain Craft Launcher 2/Controls/MySearchBox.xaml +++ b/Plain Craft Launcher 2/Controls/MySearchBox.xaml @@ -8,7 +8,7 @@ d:DesignHeight="450" d:DesignWidth="800" Height="40"> - + diff --git a/Plain Craft Launcher 2/Controls/MyTextBox.vb b/Plain Craft Launcher 2/Controls/MyTextBox.vb index 4f78ee4..ae3f0ae 100644 --- a/Plain Craft Launcher 2/Controls/MyTextBox.vb +++ b/Plain Craft Launcher 2/Controls/MyTextBox.vb @@ -3,8 +3,18 @@ '自定义属性 - Public Property HasAnimation As Boolean = True + Public Property HasBackground As Boolean = True Public Property ShowValidateResult As Boolean = True + Public Property CornerRadius As CornerRadius + Get + Return GetValue(CornerRadiusProperty) + End Get + Set(value As CornerRadius) + SetValue(CornerRadiusProperty, value) + End Set + End Property + Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = + DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyTextBox), New PropertyMetadata(New CornerRadius(3))) '额外控件初始化 @@ -62,7 +72,24 @@ SetValue(ValidateResultProperty, value) End Set End Property - Public Shared ReadOnly ValidateResultProperty As DependencyProperty = DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("")) + Public Shared ReadOnly ValidateResultProperty As DependencyProperty = + DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("", + Sub(d As MyTextBox, e As DependencyPropertyChangedEventArgs) + d.SetValue(IsValidatedPropertyKey, String.IsNullOrEmpty(e.NewValue)) + End Sub)) + + ''' + ''' 是否通过了输入验证。 + ''' + Public ReadOnly Property IsValidated As Boolean + Get + Return GetValue(IsValidatedProperty) + End Get + End Property + Private Shared ReadOnly IsValidatedPropertyKey As DependencyPropertyKey = + DependencyProperty.RegisterReadOnly("IsValidated", GetType(Boolean), GetType(MyTextBox), New PropertyMetadata(True)) + Public Shared ReadOnly IsValidatedProperty As DependencyProperty = IsValidatedPropertyKey.DependencyProperty + ''' ''' 输入验证的规则。 ''' @@ -81,50 +108,49 @@ ''' Public Sub Validate() Handles Me.Loaded '执行输入验证 - ValidateResult = "" - For Each ValidateRule As Validate In ValidateRules - ValidateResult = ValidateRule.Validate(Text) - If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For - Next - Dim IsSuccessful As Boolean = ValidateResult = "" + ValidateResult = ModValidate.Validate(Text, ValidateRules) '根据结果改变样式 - If ShownValidateResult <> If(IsSuccessful, ValidateState.Success, ValidateState.FailedAndShowDetail) Then + If ShownValidateResult <> If(IsValidated, ValidateState.Success, ValidateState.FailedAndShowDetail) Then If IsLoaded AndAlso labWrong IsNot Nothing Then - ChangeValidateResult(IsSuccessful, True) + ChangeValidateResult(IsValidated, True) Else - RunInNewThread(Sub() - Thread.Sleep(30) - RunInUi(Sub() ChangeValidateResult(IsSuccessful, False)) - End Sub, "DelayedValidate Change") + RunInNewThread( + Sub() + Thread.Sleep(30) + RunInUi(Sub() ChangeValidateResult(IsValidated, False)) + End Sub, "DelayedValidate Change") End If End If '更新错误信息 - If ShowValidateResult AndAlso Not ValidateResult = "" Then + If ShowValidateResult AndAlso Not IsValidated Then If IsLoaded AndAlso labWrong IsNot Nothing Then labWrong.Text = ValidateResult Else - RunInNewThread(Sub() - Dim IsFinished As Boolean = False - Do Until IsFinished - Thread.Sleep(20) - RunInUiWait(Sub() - If labWrong IsNot Nothing Then - labWrong.Text = ValidateResult - IsFinished = True - End If - If Not IsLoaded Then IsFinished = True - End Sub) - Loop - End Sub, "DelayedValidate Text") + RunInNewThread( + Sub() + Dim IsFinished As Boolean = False + Do Until IsFinished + Thread.Sleep(20) + RunInUiWait( + Sub() + If labWrong IsNot Nothing Then + labWrong.Text = ValidateResult + IsFinished = True + End If + If Not IsLoaded Then IsFinished = True + End Sub) + Loop + End Sub, "DelayedValidate Text") End If End If End Sub + ''' ''' 强制显示结果为正常，类似尚未输入过文本的状态。不影响实际的检查结果。 ''' Public Sub ForceShowAsSuccess() IsTextChanged = False - ChangeValidateResult(ValidateResult = "", True) + ChangeValidateResult(IsValidated, True) End Sub Private ShownValidateResult As ValidateState = ValidateState.NotInited Private Sub ChangeValidateResult(IsSuccessful As Boolean, IsLoaded As Boolean) @@ -133,18 +159,18 @@ '变为正确 ShownValidateResult = If(IsSuccessful, ValidateState.Success, ValidateState.FailedButTextNotChanged) AniStart({ - AaOpacity(labWrong, -labWrong.Opacity, 150), - AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent), - AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True) - }, "MyTextBox Validate " & Uuid) + AaOpacity(labWrong, -labWrong.Opacity, 150), + AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent), + AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True) + }, "MyTextBox Validate " & Uuid) ElseIf ShowValidateResult Then '变为错误 ShownValidateResult = ValidateState.FailedAndShowDetail labWrong.Visibility = Visibility.Visible AniStart({ - AaOpacity(labWrong, 1 - labWrong.Opacity, 170), - AaHeight(labWrong, 21 - labWrong.Height, 300,, New AniEaseOutBack(AniEasePower.Weak)) - }, "MyTextBox Validate " & Uuid) + AaOpacity(labWrong, 1 - labWrong.Opacity, 150), + AaHeight(labWrong, 21 - labWrong.Height, 150,, New AniEaseOutFluent) + }, "MyTextBox Validate " & Uuid) Else '变为错误，但不显示文本 ShownValidateResult = ValidateState.FailedAndHideDetail @@ -170,16 +196,19 @@ ''' 是否已经由用户输入过文本，若尚未输入过，则不显示输入检查的失败。 ''' Private IsTextChanged As Boolean = False - Private _HintText As String = "" Public Property HintText As String Get - Return _HintText + Return GetValue(HintTextProperty) End Get Set(value As String) - _HintText = value - If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "") + SetValue(HintTextProperty, value) End Set End Property + Public Shared ReadOnly HintTextProperty As DependencyProperty = + DependencyProperty.Register("HintText", GetType(String), GetType(MyTextBox), New PropertyMetadata("", + Sub(t As MyTextBox, e As DependencyPropertyChangedEventArgs) + If t.labHint IsNot Nothing Then t.labHint.Text = If(t.Text = "", t.HintText, "") + End Sub)) Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged Try '改变提示文本 @@ -188,7 +217,7 @@ IsTextChanged = IsLoaded '进行输入验证 Validate() - If Not ValidateResult = "" Then Exit Sub + If Not IsValidated Then Exit Sub '改变文本 RaiseEvent ValidatedTextChanged(sender, e) Catch ex As Exception @@ -200,15 +229,13 @@ Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus Try - '手动关闭动画 - If Not HasAnimation Then Exit Sub '不对 ComboBox 从属进行动画 If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub '判断当前颜色 Dim ForeColorName As String, BackColorName As String Dim AnimationTime As Integer If IsEnabled Then - If ValidateResult = "" OrElse Not IsTextChanged Then + If IsValidated OrElse Not IsTextChanged Then If IsFocused Then ForeColorName = "ColorBrush3" BackColorName = "ColorBrush7" @@ -232,6 +259,7 @@ BackColorName = "ColorBrushGray6" AnimationTime = 200 End If + If Not HasBackground Then BackColorName = "ColorBrushTransparent" '触发颜色动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 '有动画 diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index c6e2c80..5ace959 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -58,6 +58,15 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 352 Then 'Snapshot 2.9.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：Minecraft 会优先使用独立显卡运行")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：简化下载新版本第二步的 UI")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：使用新的版本隔离策略")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：添加了在全局启动设置与版本独立设置之间互相跳转的按钮")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：使用快照版导出带 PCL 的整合包可能失败")) + FeatureCount += 12 + BugCount += 20 + End If If LastVersion < 351 Then 'Snapshot 2.9.1 If LastVersion = 350 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化：对导出整合包功能进行了 7 项优化，详见完整更新日志")) @@ -119,7 +128,7 @@ Public Class FormMain #End If '整理更新日志文本 Dim ContentList As New List(Of String) - Dim SortedFeatures = Sort(FeatureList, Function(Left, Right) Left.Key > Right.Key) + Dim SortedFeatures = FeatureList.OrderByDescending(Function(f) f.Key).ToList If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦！可以去提醒他一下……") For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项 ContentList.Add(SortedFeatures(i).Value) @@ -158,6 +167,19 @@ Public Class FormMain '触发降级 DowngradeSub(LastVersion) End If + '版本隔离设置迁移 + If Setup.IsUnset("LaunchArgumentIndieV2") Then + If Not Setup.IsUnset("LaunchArgumentIndie") Then + Log("[Start] 从老 PCL 迁移版本隔离") + Setup.Set("LaunchArgumentIndieV2", Setup.Get("LaunchArgumentIndie")) + ElseIf Not Setup.IsUnset("WindowHeight") Then + Log("[Start] 从老 PCL 升级，但此前未调整版本隔离，使用老的版本隔离默认值") + Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndie")) + Else + Log("[Start] 全新的 PCL，使用新的版本隔离默认值") + Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndieV2")) + End If + End If '刷新主题 ThemeCheckAll(False) Setup.Load("UiLauncherTheme") @@ -377,6 +399,11 @@ Public Class FormMain Setup.Set("CacheMsV2Name", Setup.Get("CacheMsName")) Log("[Start] 已从老版本迁移微软登录结果") End If + 'Mod 命名设置迁移 + If Not Setup.IsUnset("ToolDownloadTranslate") AndAlso Setup.IsUnset("ToolDownloadTranslateV2") Then + Setup.Set("ToolDownloadTranslateV2", Setup.Get("ToolDownloadTranslate") + 1) + Log("[Start] 已从老版本迁移 Mod 命名设置") + End If '输出更新日志 If LastVersionCode <= 0 Then Exit Sub If LowerVersionCode >= VersionCode Then Exit Sub @@ -449,14 +476,14 @@ Public Class FormMain End Sub) End Sub Private Shared IsLogShown As Boolean = False - Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success) + Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success) On Error Resume Next IsProgramEnded = True AniControlEnabled += 1 PageLinkIoi.IoiStop(False) PageLinkHiper.HiperStop(False) If IsUpdateWaitingRestart Then UpdateRestart(False) - If ReturnCode = Result.Exception Then + If ReturnCode = ProcessReturnValues.Exception Then If Not IsLogShown Then FeedbackInfo() Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告，以便于作者解决此问题！") @@ -467,7 +494,7 @@ Public Class FormMain End If Log("[System] 程序已退出，返回值：" & GetStringFromEnum(CType(ReturnCode, [Enum]))) LogFlush() - If ReturnCode = Result.Success Then + If ReturnCode = ProcessReturnValues.Success Then Process.GetCurrentProcess.Kill() Else Environment.Exit(ReturnCode) diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 1e98911..8baed4a 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -1,4 +1,4 @@ -Imports System.Globalization +Imports System.Globalization Imports System.IO.Compression Imports System.Runtime.CompilerServices Imports System.Security.Cryptography @@ -12,13 +12,13 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.9.1" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.9.1." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.9.2" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.9.2." & VersionBranchCode '标准格式的四段式版本号 Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换 #If BETA Then Public Const VersionCode As Integer = 352 'Release #Else - Public Const VersionCode As Integer = 351 'Snapshot + Public Const VersionCode As Integer = 353 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -420,7 +420,7 @@ Public Module ModBase ''' ''' 执行返回值。 ''' - Public Enum Result + Public Enum ProcessReturnValues ''' ''' 执行成功，或进程被中断。 ''' @@ -432,19 +432,23 @@ Public Module ModBase ''' ''' 执行失败。 ''' - Fail + Fail = 1 ''' ''' 执行时出现未经处理的异常。 ''' - Exception + Exception = 2 ''' ''' 执行超时。 ''' - Timeout + Timeout = 3 ''' ''' 取消执行。可能是由于不满足执行的前置条件。 ''' - Cancel + Cancel = 4 + ''' + ''' 任务成功完成。 + ''' + TaskDone = 5 End Enum ''' @@ -573,62 +577,59 @@ Public Module ModBase #Region "文件" - '注册表 + '============================= + ' 注册表 + '============================= + ''' - ''' 重命名一个注册表子键。不可用于包含子键的子键。 - ''' - Public Sub RenameReg(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String) - If parentKey.GetSubKeyNames().Contains(newSubKeyName) Then parentKey.DeleteSubKeyTree(newSubKeyName, False) - Dim SourceKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(subKeyName) - If IsNothing(SourceKey) Then Exit Sub '没有目标项 - Dim NewKey As Microsoft.Win32.RegistryKey = parentKey.CreateSubKey(newSubKeyName) - If SourceKey.GetSubKeyNames().Length > 0 Then Throw New NotSupportedException("不支持对包含子键的子键进行重命名：" & SourceKey.GetSubKeyNames()(0) & "。") - For Each valueName As String In SourceKey.GetValueNames() - Dim objValue As Object = SourceKey.GetValue(valueName) - Dim valKind As Microsoft.Win32.RegistryValueKind = SourceKey.GetValueKind(valueName) - NewKey.SetValue(valueName, objValue, valKind) - Next - parentKey.DeleteSubKeyTree(subKeyName, False) - End Sub - ''' - ''' 读取程序所属注册表。 + ''' 读取注册表键。如果失败则返回默认值。 ''' Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String Try - Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey - parentKey = My.Computer.Registry.CurrentUser - softKey = parentKey.OpenSubKey("Software\" & RegFolder, True) - If softKey Is Nothing Then - ReadReg = DefaultValue '不存在则返回默认值 - Else - Dim readValue As New Text.StringBuilder - readValue.AppendLine(softKey.GetValue(Key)) - Dim value = readValue.ToString.Replace(vbCrLf, "") '去除莫名的回车 - Return If(value = "", DefaultValue, value) '错误则返回默认值 - End If + Dim SubKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False) + Return If(SubKey?.GetValue(Key), DefaultValue) Catch ex As Exception Log(ex, "读取注册表出错：" & Key, LogLevel.Hint) Return DefaultValue End Try End Function ''' - ''' 写入程序所属注册表。 + ''' 写入注册表键。 ''' - Public Sub WriteReg(Key As String, Value As String, Optional ShowException As Boolean = False) + Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False) Try - Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey - parentKey = My.Computer.Registry.CurrentUser - softKey = parentKey.OpenSubKey("Software\" & RegFolder, True) - If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\" & RegFolder) '如果不存在就创建 - softKey.SetValue(Key, Value) + Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True) + If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建 + SubKey.SetValue(Key, Value) Catch ex As Exception - Log(ex, "写入注册表出错：" & Key, If(ShowException, LogLevel.Hint, LogLevel.Developer)) - If ShowException Then Throw '如果显示错误就丢一个 + Log(ex, "写入注册表出错：" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer)) + If ThrowException Then Throw + End Try + End Sub + ''' + ''' 是否存在某个注册表键。 + ''' + Public Function HasReg(Key As String) As Boolean + Return ReadReg(Key, Nothing) IsNot Nothing + End Function + ''' + ''' 删除注册表键。 + ''' + Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False) + Try + Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True) + SubKey?.DeleteValue(Key) + Catch ex As Exception + Log(ex, "删除注册表出错：" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer)) + If ThrowException Then Throw End Try End Sub - 'Ini 文件 - Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String)) + '============================= + ' ini + '============================= + + Private ReadOnly IniCache As New SafeDictionary(Of String, SafeDictionary(Of String, String)) ''' ''' 清除某 ini 文件的运行时缓存。 ''' @@ -642,7 +643,7 @@ Public Module ModBase ''' 在文件不存在或读取失败时返回 Nothing。 ''' ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 - Private Function IniGetContent(FileName As String) As Dictionary(Of String, String) + Private Function IniGetContent(FileName As String) As SafeDictionary(Of String, String) Try '还原文件路径 If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" @@ -650,7 +651,7 @@ Public Module ModBase If IniCache.ContainsKey(FileName) Then Return IniCache(FileName) '读取文件 If Not File.Exists(FileName) Then Return Nothing - Dim Ini As New Dictionary(Of String, String) + Dim Ini As New SafeDictionary(Of String, String) For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries) Dim Index As Integer = Line.IndexOfF(":") If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键，见 #3616 @@ -674,7 +675,21 @@ Public Module ModBase Return Content(Key) End Function ''' + ''' 判断 ini 文件中是否包含某个键。这可能会使用到缓存。 + ''' + Public Function HasIniKey(FileName As String, Key As String) As Boolean + Dim Content = IniGetContent(FileName) + Return Content IsNot Nothing AndAlso Content.ContainsKey(Key) + End Function + ''' + ''' 从 ini 文件中移除某个键。这会更新缓存。 + ''' + Public Sub DeleteIniKey(FileName As String, Key As String) + WriteIni(FileName, Key, Nothing) + End Sub + ''' ''' 写入 ini 文件，这会更新缓存。 + ''' 若 Value 为 Nothing，则删除该键。 ''' ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 ''' 键。 @@ -683,28 +698,38 @@ Public Module ModBase Public Sub WriteIni(FileName As String, Key As String, Value As String) Try '预处理 - Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "") - Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号 - '获取目前文件 - Dim Content As Dictionary(Of String, String) = IniGetContent(FileName) - If Content Is Nothing Then Content = New Dictionary(Of String, String) - If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理 - '更新缓存 - Content(Key) = Value - '写入文件 - Dim FileContent As New StringBuilder - For Each Pair In Content - FileContent.Append(Pair.Key) - FileContent.Append(":") - FileContent.Append(Pair.Value) - FileContent.Append(vbCrLf) - Next - If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" - WriteFile(FileName, FileContent.ToString) + If Key.Contains(":") Then Throw New Exception($"尝试写入 ini 文件 {FileName} 的键名中包含了冒号：{Key}") + Key = Key.Replace(vbCr, "").Replace(vbLf, "") + Value = Value?.Replace(vbCr, "").Replace(vbLf, "") + '防止争用 + SyncLock WriteIniLock + '获取目前文件 + Dim Content As SafeDictionary(Of String, String) = IniGetContent(FileName) + If Content Is Nothing Then Content = New SafeDictionary(Of String, String) + '更新值 + If Value Is Nothing Then + If Not Content.ContainsKey(Key) Then Return '无需处理 + Content.Remove(Key) + Else + If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Return '无需处理 + Content(Key) = Value + End If + '写入文件 + Dim FileContent As New StringBuilder + For Each Pair In Content + FileContent.Append(Pair.Key) + FileContent.Append(":") + FileContent.Append(Pair.Value) + FileContent.Append(vbCrLf) + Next + If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" + WriteFile(FileName, FileContent.ToString) + End SyncLock Catch ex As Exception Log(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogLevel.Hint) End Try End Sub + Private WriteIniLock As New Object '路径处理 ''' @@ -833,21 +858,21 @@ Public Module ModBase ''' 文件内容。 ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) - '还原文件路径 + '处理相对路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件 - If File.Exists(FilePath) Then - '如果文件存在，刷新目前文件 - Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath)))) + If Append Then + '追加目前文件 + Using writer As New StreamWriter(FilePath, True, If(Encoding, GetEncoding(ReadFileBytes(FilePath)))) writer.Write(Text) writer.Flush() writer.Close() End Using Else - '如果文件不存在，则新建并写入 - File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) + '直接写入字节 + File.WriteAllBytes(FilePath, If(Encoding Is Nothing, New UTF8Encoding(False).GetBytes(Text), Encoding.GetBytes(Text))) End If End Sub ''' @@ -858,7 +883,7 @@ Public Module ModBase ''' 文件内容。 ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) - '还原文件路径 + '处理相对路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) @@ -1227,8 +1252,14 @@ Re: Dim Info As New FileInfo(LocalPath) If Not Info.Exists Then Return "文件不存在：" & LocalPath Dim FileSize As Long = Info.Length - If ActualSize >= 0 AndAlso ActualSize <> FileSize Then Return "文件大小应为 " & ActualSize & " B，实际为 " & FileSize & " B" - If MinSize >= 0 AndAlso MinSize > FileSize Then Return "文件大小应大于 " & MinSize & " B，实际为 " & FileSize & " B" + If ActualSize >= 0 AndAlso ActualSize <> FileSize Then + Return $"文件大小应为 {ActualSize} B，实际为 {FileSize} B" & + If(FileSize < 2000, "，内容为：" & ReadFile(LocalPath), "") + End If + If MinSize >= 0 AndAlso MinSize > FileSize Then + Return $"文件大小应大于 {MinSize} B，实际为 {FileSize} B" & + If(FileSize < 2000, "，内容为：" & ReadFile(LocalPath), "") + End If If Not String.IsNullOrEmpty(Hash) Then If Hash.Length < 35 Then 'MD5 If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & "，实际为 " & GetFileMD5(LocalPath) @@ -1777,7 +1808,7 @@ RetryDir: ''' ''' 搜索字符串中的所有正则匹配项。 ''' - Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String) + Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As List(Of String) Try RegexSearch = New List(Of String) Dim RegexSearchRes = New Regex(regex, options).Matches(str) @@ -1793,7 +1824,7 @@ RetryDir: ''' ''' 获取字符串中的第一个正则匹配项，若无匹配则返回 Nothing。 ''' - Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String + Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As String Try Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value Return If(Result = "", Nothing, Result) @@ -1805,7 +1836,7 @@ RetryDir: ''' ''' 检查字符串是否匹配某正则模式。 ''' - Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As Boolean + Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As Boolean Try Return RegularExpressions.Regex.IsMatch(str, regex, options) Catch ex As Exception @@ -1816,14 +1847,14 @@ RetryDir: ''' ''' 进行正则替换，会抛出错误。 ''' - Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String - Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options) + Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As String, Optional options As RegexOptions = RegexOptions.None) As String + Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options) End Function ''' ''' 对每个正则匹配分别进行替换，会抛出错误。 ''' - Public Function RegexReplaceEach(Input As String, Replacement As MatchEvaluator, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String - Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options) + Public Function RegexReplaceEach(AllContents As String, SearchRegex As String, ReplaceTo As MatchEvaluator, Optional options As RegexOptions = RegexOptions.None) As String + Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options) End Function #End Region @@ -1922,7 +1953,7 @@ RetryDir: Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True))) Next '按照相似度进行排序 - Entries = Sort(Entries, + Entries = Entries.Sort( Function(Left, Right) As Boolean If Left.AbsoluteRight Xor Right.AbsoluteRight Then Return Left.AbsoluteRight @@ -1981,6 +2012,122 @@ RetryDir: End Function End Class + ''' + ''' 线程安全的，可以直接使用 For Each 的字典。 + ''' 在使用 For Each 循环时，字典的结果可能并非最新，但不会抛出异常。 + ''' + Public Class SafeDictionary(Of TKey, TValue) + Implements IDictionary(Of TKey, TValue) + Implements IEnumerable(Of KeyValuePair(Of TKey, TValue)) + + Private ReadOnly SyncRoot As New Object + Private ReadOnly _Dictionary As New Dictionary(Of TKey, TValue) + + '构造函数 + Public Sub New() + End Sub + Public Sub New(data As IEnumerable(Of KeyValuePair(Of TKey, TValue))) + For Each DataItem In data + _Dictionary.Add(DataItem.Key, DataItem.Value) + Next + End Sub + + '线程安全的方法实现 + Public Sub Add(key As TKey, value As TValue) Implements IDictionary(Of TKey, TValue).Add + SyncLock SyncRoot + _Dictionary.Add(key, value) + End SyncLock + End Sub + Public Function ContainsKey(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).ContainsKey + SyncLock SyncRoot + Return _Dictionary.ContainsKey(key) + End SyncLock + End Function + Public ReadOnly Property Keys As ICollection(Of TKey) Implements IDictionary(Of TKey, TValue).Keys + Get + SyncLock SyncRoot + Return New List(Of TKey)(_Dictionary.Keys) + End SyncLock + End Get + End Property + Public Function Remove(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).Remove + SyncLock SyncRoot + Return _Dictionary.Remove(key) + End SyncLock + End Function + Public Function TryGetValue(key As TKey, ByRef value As TValue) As Boolean Implements IDictionary(Of TKey, TValue).TryGetValue + SyncLock SyncRoot + Return _Dictionary.TryGetValue(key, value) + End SyncLock + End Function + Public ReadOnly Property Values As ICollection(Of TValue) Implements IDictionary(Of TKey, TValue).Values + Get + SyncLock SyncRoot + Return New List(Of TValue)(_Dictionary.Values) + End SyncLock + End Get + End Property + Default Public Property Item(key As TKey) As TValue Implements IDictionary(Of TKey, TValue).Item + Get + SyncLock SyncRoot + Return _Dictionary(key) + End SyncLock + End Get + Set(value As TValue) + SyncLock SyncRoot + _Dictionary(key) = value + End SyncLock + End Set + End Property + Public Sub Add(item As KeyValuePair(Of TKey, TValue)) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Add + SyncLock SyncRoot + _Dictionary.Add(item.Key, item.Value) + End SyncLock + End Sub + Public Sub Clear() Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Clear + SyncLock SyncRoot + _Dictionary.Clear() + End SyncLock + End Sub + Public Function Contains(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Contains + SyncLock SyncRoot + Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Contains(item) + End SyncLock + End Function + Public Sub CopyTo(array() As KeyValuePair(Of TKey, TValue), arrayIndex As Integer) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).CopyTo + SyncLock SyncRoot + DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).CopyTo(array, arrayIndex) + End SyncLock + End Sub + Public ReadOnly Property Count As Integer Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Count + Get + SyncLock SyncRoot + Return _Dictionary.Count + End SyncLock + End Get + End Property + Public ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).IsReadOnly + Get + Return False + End Get + End Property + Public Function Remove(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Remove + SyncLock SyncRoot + Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Remove(item) + End SyncLock + End Function + + '枚举器 + Public Function GetEnumerator() As IEnumerator(Of KeyValuePair(Of TKey, TValue)) Implements IEnumerable(Of KeyValuePair(Of TKey, TValue)).GetEnumerator + SyncLock SyncRoot + Return New List(Of KeyValuePair(Of TKey, TValue))(_Dictionary).GetEnumerator() + End SyncLock + End Function + Private Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator + Return GetEnumerator() + End Function + End Class + ''' ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。 ''' @@ -2064,7 +2211,7 @@ RetryDir: ''' ''' 数组去重。 ''' - Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As CompareThreadStart(Of T)) As List(Of T) + Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As ComparisonBoolean(Of T)) As List(Of T) Dim ResultArray As New List(Of T) For i = 0 To Arr.Count - 1 For ii = i + 1 To Arr.Count - 1 @@ -2198,7 +2345,7 @@ NextElement: ''' 文件名。可以为“notepad”等缩写。 ''' 运行参数。 ''' 等待该程序结束的最长时间（毫秒）。超时会返回 Result.Timeout。 - Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As Result + Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As ProcessReturnValues Try Using Program As New Process Program.StartInfo.Arguments = Arguments @@ -2208,12 +2355,12 @@ NextElement: If Program.WaitForExit(Timeout) Then Return Program.ExitCode Else - Return Result.Timeout + Return ProcessReturnValues.Timeout End If End Using Catch ex As Exception Log(ex, "执行命令失败：" & FileName, LogLevel.Msgbox) - Return Result.Fail + Return ProcessReturnValues.Fail End Try End Function ''' @@ -2316,9 +2463,9 @@ NextElement: ''' ''' 按照既定的函数进行选择排序。 + ''' 传入两个对象，若第一个对象应该排在前面，则返回 True。 ''' - ''' 传入两个对象，若第一个对象应该排在前面，则返回 True。 - Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T) + Public Function Sort(Of T)(List As IList(Of T), SortRule As ComparisonBoolean(Of T)) As List(Of T) Dim NewList As New List(Of T) While List.Any Dim Highest = List(0) @@ -2330,7 +2477,7 @@ NextElement: End While Return NewList End Function - Public Delegate Function CompareThreadStart(Of T)(Left As T, Right As T) As Boolean + Public Delegate Function ComparisonBoolean(Of T)(Left As T, Right As T) As Boolean ''' ''' 返回列表的浅表副本。 @@ -2637,6 +2784,17 @@ Retry: Return Control.DesiredSize.Width > Control.ActualWidth End Function + ''' + ''' 获取文本在被渲染后的宽度。 + ''' + Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double + If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑") + Dim formattedText = New FormattedText( + text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal), + fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip) + Return formattedText.Width + End Function + #End Region #Region "Debug" @@ -2755,7 +2913,7 @@ Retry: If IsProgramEnded OrElse Level = LogLevel.Normal Then Exit Sub '去除前缀 - Text = RegexReplace(Text, "", "\[[^\]]+?\] ") + Text = Text.RegexReplace("\[[^\]]+?\] ", "") '输出提示 Select Case Level @@ -2789,9 +2947,9 @@ Retry: If GetTimeTick() - Time < 1500 Then '弹窗无法保留 Log("[System] PCL 已崩溃：" & vbCrLf & Text) - FormMain.EndProgramForce(Result.Exception) + FormMain.EndProgramForce(ProcessReturnValues.Exception) Else - FormMain.EndProgramForce(Result.Fail) + FormMain.EndProgramForce(ProcessReturnValues.Fail) End If End Select @@ -2858,9 +3016,9 @@ Retry: If GetTimeTick() - Time < 1500 Then '弹窗无法保留 Log("[System] PCL 已崩溃：" & vbCrLf & ExFull) - FormMain.EndProgramForce(Result.Exception) + FormMain.EndProgramForce(ProcessReturnValues.Exception) Else - FormMain.EndProgramForce(Result.Fail) + FormMain.EndProgramForce(ProcessReturnValues.Fail) End If End Select diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index 030bf5f..ba0e019 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -1,6 +1,4 @@ -Imports System.Net - -Public Module ModNet +Public Module ModNet Public Const NetDownloadEnd As String = ".PCLDownloading" ''' @@ -146,14 +144,15 @@ Retry: Dim RequestEx As Exception = Nothing Dim FailCount As Integer = 0 For i = 1 To 4 - Dim th As New Thread(Sub() - Try - RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept) - Catch ex As Exception - FailCount += 1 - RequestEx = ex - End Try - End Sub) + Dim th As New Thread( + Sub() + Try + RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept) + Catch ex As Exception + FailCount += 1 + RequestEx = ex + End Try + End Sub) th.Start() Threads.Add(th) Thread.Sleep(i * 250) @@ -221,7 +220,7 @@ RequestFinished: ''' ''' 网页的 Url。 Public Function NetGetCodeByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String - Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid() + Dim Temp As String = RequestTaskTempFolder() & "download.txt" Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)}) Try NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）") @@ -236,7 +235,7 @@ RequestFinished: ''' ''' 网页的 Url 列表。 Public Function NetGetCodeByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String - Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid() + Dim Temp As String = RequestTaskTempFolder() & "download.txt" Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)}) Try NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）") @@ -734,7 +733,7 @@ RequestFinished: ''' ''' 所有下载源。 ''' - Public Sources As NetSource() + Public Sources As SafeList(Of NetSource) ''' ''' 用于在第一个线程出错时切换下载源。 ''' @@ -742,7 +741,7 @@ RequestFinished: ''' ''' 所有已经被标记为失败的，但未完整尝试过的，不允许断点续传的下载源。 ''' - Public SourcesOnce As New List(Of NetSource) + Public SourcesOnce As New SafeList(Of NetSource) ''' ''' 获取从某个源开始，第一个可用的源。 ''' @@ -943,7 +942,7 @@ RequestFinished: Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing}) Count += 1 Next - Me.Sources = Sources.ToArray + Me.Sources = Sources Me.LocalPath = LocalPath Me.Check = Check Me.UseBrowserUserAgent = UseBrowserUserAgent @@ -1003,7 +1002,7 @@ Capture: Next '是否禁用多线程，以及规定碎片大小 Dim TargetUrl As String = GetSource().Url - If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("mcimirror") OrElse TargetUrl.Contains("github.com") OrElse + If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing '寻找最大碎片 'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程 @@ -1151,7 +1150,7 @@ NotSupportRange: Info.Temp = Nothing SmailFileCache = New Queue(Of Byte) Else - Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp" + Info.Temp = $"{PathTemp}Download\{Uuid}_{Info.Uuid}_{RandomInteger(0, 999999)}.tmp" ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read) End If '开始下载 @@ -1567,9 +1566,8 @@ FinishExCatch: TotalProgress += 1 End If Next - If TotalProgress > 0 Then NewProgress /= TotalProgress + If TotalProgress > 0 AndAlso Not Double.IsNaN(TotalProgress) Then NewProgress /= TotalProgress '刷新进度 - If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况 _Progress = NewProgress End Sub diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb index 0394060..9affdab 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -1,4 +1,20 @@ '提供不同的输入验证方法，名称以 Validate 开头 +Public Module ModValidate + + ''' + ''' 进行输入验证，并返回错误原因。 + ''' 如果没有错误则返回空字符串。 + ''' + Public Function Validate(Text As String, ValidateRules As IEnumerable(Of Validate)) As String + Dim Result As String = "" + For Each ValidateRule As Validate In ValidateRules + Result = ValidateRule.Validate(Text) + If Result <> "" Then Return Result + Next + Return Result + End Function + +End Module ''' ''' 输入验证规则基类。要查看所有的输入验证规则，可在输入 Validate 后查看自动补全。 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index 7edb2c9..59ad53e 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -666,6 +666,9 @@ NoSubtitle: If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False 'MC 版本一致 If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False + '最近更新时间差距在一周以内 + If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso + Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 If TranslatedName = Project.TranslatedName OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse @@ -920,7 +923,7 @@ NoSubtitle: End If '驼峰英文请求关键字处理 - Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)") + Dim SpacedKeywords = Task.Input.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ") Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "") Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower @@ -1067,7 +1070,7 @@ Retry: #Region "提取非重复项，存储于 RealResults" '将 Modrinth 排在 CurseForge 的前面，避免加载结束顺序不同导致排名不同 - '这样做的话，去重后将优先保留 CurseForge 内容（考虑到 CurseForge 热度更高） + '这样做的话，去重后将优先保留 CurseForge 内容 RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList 'RawResults 去重 RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)) @@ -1100,7 +1103,7 @@ Retry: If String.IsNullOrEmpty(Task.Input.SearchText) Then '如果没有搜索文本，按下载量将结果排序 For Each Result As CompProject In RealResults - Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10)) + Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 5)) Next Else '如果有搜索文本，按关联度将结果排序 @@ -1108,7 +1111,7 @@ Retry: Dim Entry As New List(Of SearchEntry(Of CompProject)) For Each Result As CompProject In RealResults Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + - Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9) + Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 5)) / 9) Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) @@ -1120,7 +1123,7 @@ Retry: End If '根据排序分得出结果并添加 Storage.Results.AddRange( - Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList) + Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key)) #End Region @@ -1288,7 +1291,7 @@ Retry: Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList If GameVersions.Count > 1 Then - GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList + GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} ElseIf GameVersions.Count = 1 Then GameVersions = GameVersions.ToList @@ -1329,7 +1332,7 @@ Retry: GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList If GameVersions.Count > 1 Then - GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList + GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} ElseIf GameVersions.Count = 1 Then '无需处理 @@ -1468,11 +1471,14 @@ Retry: Dim ResultJsonArray As JArray If FromCurseForge Then 'CurseForge - If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 - ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") - Else '否则使用全部文件 - ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data") - End If + 'HMCL 一次性请求了 10000 个文件，虽然不知道会不会出问题但先这样吧……（#5522） + ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=10000", IsJson:=True)("data") + '之前只请求一部分文件的方法备份如下： + 'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 + ' ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") + 'Else '否则使用全部文件 + ' ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data") + 'End If Else 'Modrinth ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index 3ba0ce3..b7bbc6d 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -627,7 +627,7 @@ ".html", UseBrowserUserAgent:=True) Catch ex As Exception If GetExceptionSummary(ex).Contains("(404)") Then - Throw New Exception("没有可用版本") + Throw New Exception("不可用") Else Throw End If @@ -685,7 +685,7 @@ Catch ex As Exception Throw New Exception("Forge 官方源版本列表解析失败（" & Result & "）", ex) End Try - If Not Versions.Any() Then Throw New Exception("没有可用版本") + If Not Versions.Any() Then Throw New Exception("不可用") Loader.Output = Versions End Sub @@ -740,7 +740,7 @@ Catch ex As Exception Throw New Exception("Forge BMCLAPI 版本列表解析失败（" & Json.ToString & "）", ex) End Try - If Not Versions.Any() Then Throw New Exception("没有可用版本") + If Not Versions.Any() Then Throw New Exception("不可用") Loader.Output = Versions End Sub @@ -865,7 +865,7 @@ Dim Versions = VersionNames. Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载 Select(Function(name) New DlNeoForgeListEntry(name)).ToList - If Not Versions.Any() Then Throw New Exception("没有可用版本") + If Not Versions.Any() Then Throw New Exception("不可用") Versions = Versions.OrderByDescending(Function(a) a.Version).ToList Return Versions End Function @@ -1276,7 +1276,7 @@ For ii = 0 To LoaderList.Count - 1 LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败 If LoaderList(ii).Key.Error IsNot Nothing Then - If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then + If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then ErrorInfo = LoaderList(ii).Key.Error End If End If diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index 3d54dfc..39d7a9b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -131,7 +131,7 @@ Version = New Version(1, Version.Major, Version.Build, Version.Revision) End If Is64Bit = Output.Contains("64-bit") - If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString) + If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString) '基于 #3649，在 64 位系统上禁用 32 位 Java If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java") '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败，干脆禁用更多版本的 JRE @@ -342,7 +342,7 @@ RetryGet: Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right) End If Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "") - If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then + If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then '直接跳过弹窗 Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug) AllowedJavaList = New List(Of JavaEntry) From {UserJava} @@ -382,7 +382,7 @@ ExitUserJavaCheck: UserPass: '对适合的 Java 进行排序 - AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter) + AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter) Log($"[Java] 排序后的 Java 优先顺序：") For Each Java In AllowedJavaList Log($"[Java] - {Java}") @@ -586,7 +586,7 @@ NoUserJava: For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794 NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) Next - NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter) + NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter) '修改设置项 Dim AllList As New JArray @@ -685,7 +685,7 @@ Wait: If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 If IsFullSearch OrElse - FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then + OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then JavaSearchFolder(FolderInfo, Results, Source) End If Next diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 01b1bab..2c0f3f6 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -893,7 +893,8 @@ Retry: $"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2) Catch ex As Exception - If ex.Message.Contains("must sign in again") OrElse (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269 + If ex.Message.ContainsF("must sign in again", True) OrElse ex.Message.ContainsF("password expired", True) OrElse + (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269 Return {"Relogin", ""} Else Throw @@ -1150,6 +1151,11 @@ Retry: '1.5.2-：最高 Java 12 MaxVer = New Version(1, 12, 999, 999) End If + If McVersionCurrent.JsonVersion?("java_version") IsNot Nothing Then + Dim RecommendedJava As Integer = McVersionCurrent.JsonVersion("java_version").ToObject(Of Integer) + McLaunchLog("Mojang 推荐使用 Java " & RecommendedJava) + If RecommendedJava >= 22 Then MinVer = New Version(1, RecommendedJava, 0, 0) '潜在的向后兼容 + End If 'OptiFine 检测 If McVersionCurrent.Version.HasOptiFine Then @@ -1223,7 +1229,10 @@ Retry: If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java McLaunchLog("无合适的 Java，需要确认是否自动下载") Dim JavaCode As String - If MinVer >= New Version(1, 21, 0, 0) Then + If MinVer >= New Version(1, 22, 0, 0) Then '潜在的向后兼容 + JavaCode = MinVer.Minor + If Not JavaDownloadConfirm("Java " & JavaCode) Then Throw New Exception("$$") + ElseIf MinVer >= New Version(1, 21, 0, 0) Then JavaCode = 21 If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$") ElseIf MinVer >= New Version(1, 9, 0, 0) Then @@ -1408,7 +1417,7 @@ Retry: If McLoginLoader.Output.Type = "Auth" Then Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy, "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录 - Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) + Setup.Get("VersionServerAuthServer", McVersionCurrent)) Try Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8) DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server & @@ -1420,9 +1429,11 @@ Retry: End If '添加 Java Wrapper 作为主 Jar - If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") - DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") - DataList.Add("-jar """ & ExtractJavaWrapper() & """") + If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then + If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") + DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") + DataList.Add("-jar """ & ExtractJavaWrapper() & """") + End If '添加 MainClass If Version.JsonObject("mainClass") Is Nothing Then @@ -1487,9 +1498,11 @@ NextVersion: End If '添加 Java Wrapper 作为主 Jar - If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") - DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") - DataList.Add("-jar """ & ExtractJavaWrapper() & """") + If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then + If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") + DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") + DataList.Add("-jar """ & ExtractJavaWrapper() & """") + End If '将 "-XXX" 与后面 "XXX" 合并到一起 '如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重 @@ -1780,6 +1793,29 @@ NextVersion: Private Sub McLaunchPrerun() + '要求 Java 使用高性能显卡 + If Setup.Get("LaunchAdvanceGraphicCard") Then + Try + SetGPUPreference(McLaunchJavaSelected.PathJavaw) + SetGPUPreference(PathWithName) + Catch ex As Exception + If IsAdmin() Then + Log(ex, "直接调整显卡设置失败") + Else + Log(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试") + Try + If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJavaw}""") = ProcessReturnValues.TaskDone Then + McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功") + Else + Throw New Exception("调整过程中出现异常") + End If + Catch exx As Exception + Log(exx, "调整显卡设置失败，Minecraft 可能会使用默认显卡运行", LogLevel.Hint) + End Try + End If + End Try + End If + '更新 launcher_profiles.json Try '确保可用 @@ -2050,14 +2086,15 @@ IgnoreCustomSkin: '输出 bat Try Dim CmdString As String = + $"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" & "@echo off" & vbCrLf & - "title 启动 - " & McVersionCurrent.Name & vbCrLf & + $"title 启动 - {McVersionCurrent.Name}" & vbCrLf & "echo 游戏正在启动，请稍候。" & vbCrLf & - "set APPDATA=""" & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf & - "cd /D """ & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf & + $"set APPDATA=""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf & + $"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf & CustomCommandGlobal & vbCrLf & CustomCommandVersion & vbCrLf & - """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & + $"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf & "echo 游戏已退出。" & vbCrLf & "pause" WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"), @@ -2132,18 +2169,14 @@ IgnoreCustomSkin: Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw) '设置环境变量 - If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then - StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder) - Else - StartInfo.EnvironmentVariables.Add("appdata", ShortenPath(PathMcFolder)) - End If Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";")) Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder)) StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";") + StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder) '设置其他参数 - StartInfo.StandardErrorEncoding = Encoding.UTF8 - StartInfo.StandardOutputEncoding = Encoding.UTF8 + StartInfo.StandardErrorEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing) + StartInfo.StandardOutputEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing) StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie) StartInfo.UseShellExecute = False StartInfo.RedirectStandardOutput = True diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index 2b0e976..01e861c 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -214,45 +214,45 @@ Public Module ModMinecraft ''' 在不加载版本的情况下获取版本隔离目录。 ''' Public Function GetPathIndie(Modable As Boolean) As String - Dim IndieType As Integer = Setup.Get("LaunchArgumentIndie") - Select Case Setup.Get("VersionArgumentIndie", Version:=Me) - Case -1 - '尚未判断 + '决定版本隔离类型 + If Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then + Dim ShouldBeIndie = + Function() As Boolean + '从老的版本独立设置中迁移：-1 未决定，0 使用全局设置，1 手动开启，2 手动关闭 + If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then + Log($"[Minecraft] 版本隔离初始化（{Name}）：从老的版本独立设置中迁移") + Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1 + End If + '若版本文件夹下包含 mods 或 saves 文件夹，则自动开启版本隔离 Dim ModFolder As New DirectoryInfo(Path & "mods\") Dim SaveFolder As New DirectoryInfo(Path & "saves\") - If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse - (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then - '自动开启 - Setup.Set("VersionArgumentIndie", 1, Version:=Me) - Log("[Setup] 已自动开启单版本隔离：" & Name) - IndieType = 4 - Else - '使用全局设置 - Setup.Set("VersionArgumentIndie", 0, Version:=Me) - Log("[Setup] 版本隔离使用全局设置：" & Name) + If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then + Log($"[Minecraft] 版本隔离初始化（{Name}）：版本文件夹下存在 mods 或 saves 文件夹，自动开启") + Return True End If - Case 0 - '使用全局设置 - Case 1 - '开启 - IndieType = 4 - Case 2 - '关闭 - IndieType = 0 - End Select - Select Case IndieType - Case 0 '关闭 - Case 1 '仅隔离可安装 Mod 的版本 - If Modable Then Return Path - Case 2 '仅隔离非正式版 - If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path - Case 3 '隔离非正式版与可安装 Mod 的版本 - If Modable Then Return Path - If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path - Case 4 '隔离所有版本 - Return Path - End Select - Return PathMcFolder + '根据全局的默认设置决定是否隔离 + Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Setup.Get("LaunchArgumentIndieV2")}）判断") + Select Case Setup.Get("LaunchArgumentIndieV2") + Case 0 '关闭 + Return False + Case 1 '仅隔离可安装 Mod 的版本 + Return Modable + Case 2 '仅隔离非正式版 + Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot + Case 3 '隔离非正式版与可安装 Mod 的版本 + Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot + Case Else '隔离所有版本 + Return True + End Select + End Function + Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me) + End If + '根据隔离类型决定路径 + If Setup.Get("VersionArgumentIndieV2", Version:=Me) Then + Return Path + Else + Return PathMcFolder + End If End Function ''' @@ -396,27 +396,13 @@ Public Module ModMinecraft GoTo VersionSearchFinish End If '从 jar 文件的 version.json 中获取版本号 - If File.Exists(Path & Name & ".jar") Then - Try - Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) - Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json") - If VersionJson IsNot Nothing Then - Using VersionJsonStream As New StreamReader(VersionJson.Open) - Dim VersionJsonObj As JObject = GetJson(VersionJsonStream.ReadToEnd) - If VersionJsonObj("id") IsNot Nothing Then - Dim VersionId As String = VersionJsonObj("id").ToString - If VersionId.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash，虽然我没发现 - _Version.McName = VersionId - Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号：" & VersionId) - GoTo VersionSearchFinish - End If - End If - End Using - End If - End Using - Catch ex As Exception - Log(ex, "从版本 jar 中的 version.json 获取版本号失败") - End Try + If JsonVersion?("name") IsNot Nothing Then + Dim JsonVerName As String = JsonVersion("name").ToString + If JsonVerName.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash，虽然我没发现 + _Version.McName = JsonVerName + Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号：" & JsonVerName) + GoTo VersionSearchFinish + End If End If '非准确的版本判断警告 Log("[Minecraft] 无法完全确认 MC 版本号的版本：" & Name) @@ -536,9 +522,8 @@ VersionSearchFinish: For Each Subjson As JObject In _JsonObject("patches") SubjsonList.Add(Subjson) Next - SubjsonList = Sort(SubjsonList, Function(Left As JObject, Right As JObject) As Boolean - Return Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString) - End Function) + SubjsonList = SubjsonList.Sort( + Function(Left, Right) Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString)) For Each Subjson As JObject In SubjsonList Dim Id As String = Subjson("id") If Id IsNot Nothing Then @@ -628,6 +613,35 @@ Recheck: ''' Public Property HasJumpLoader As Boolean = False + ''' + ''' 版本 jar 中的 version.json 文件对象。 + ''' 若没有则返回 Nothing。 + ''' + Public ReadOnly Property JsonVersion As JObject + Get + If Not JsonVersionInited Then + JsonVersionInited = True + If File.Exists(Path & Name & ".jar") Then + Try + Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) + Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json") + If VersionJson IsNot Nothing Then + Using VersionJsonStream As New StreamReader(VersionJson.Open) + _JsonVersion = GetJson(VersionJsonStream.ReadToEnd) + End Using + End If + End Using + Catch ex As Exception + Log(ex, "从版本 jar 中读取 version.json 失败") + End Try + End If + End If + Return _JsonVersion + End Get + End Property + Private JsonVersionInited As Boolean = False + Private _JsonVersion As JObject = Nothing + ''' ''' 该版本的依赖版本。若无依赖版本则为空字符串。 ''' @@ -1116,7 +1130,7 @@ ExitDataLoad: Throw New Exception("无法读取版本文件夹，可能是由于没有权限（" & Path & "versions）", ex) End Try End If - '没有可用版本 + '不可用 If Not FolderList.Any() Then WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存 GoTo OnLoaded @@ -1427,7 +1441,7 @@ OnLoaded: Next If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot) '按版本号排序 - Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain) + Dim NewList As List(Of McVersion) = OldList.OrderByDescending(Function(v) v.Version.McCodeMain).ToList '回设 If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot) ResultVersionList(McVersionCardType.OriginalLike) = NewList @@ -1435,7 +1449,7 @@ OnLoaded: '不常用版本：按发布时间新旧排序，如果不可用则按名称排序 If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then - ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), + ResultVersionList(McVersionCardType.Rubbish) = ResultVersionList(McVersionCardType.Rubbish).Sort( Function(Left As McVersion, Right As McVersion) Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) @@ -1457,7 +1471,7 @@ OnLoaded: 'API 版本：优先按版本排序，此后【先放 Fabric，再放 Neo/Forge（按版本号从高到低排序），最后放 LiteLoader（按名称排序）】 If ResultVersionList.ContainsKey(McVersionCardType.API) Then - ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), + ResultVersionList(McVersionCardType.API) = ResultVersionList(McVersionCardType.API).Sort( Function(Left As McVersion, Right As McVersion) Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) If Basic <> 0 Then @@ -2116,7 +2130,7 @@ OnLoaded: ''' 检查设置，是否应当忽略文件检查？ ''' Public Function ShouldIgnoreFileCheck(Version As McVersion) - Return Setup.Get("LaunchAdvanceAssets") OrElse Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2) + Return Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2) End Function #End Region diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 44ab4fa..f20e352 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -902,7 +902,7 @@ Finished: Log($"[Mod] 共有 {ModList.Count} 个 Mod，其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息，{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息") '排序 - ModList = Sort(ModList, + ModList = ModList.Sort( Function(Left As McMod, Right As McMod) As Boolean If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then Return Left.State = McMod.McModState.Unavailable @@ -932,18 +932,10 @@ Finished: Dim Mods As List(Of McMod) = Loader.Input.Key Dim Cache As JObject = Loader.Input.Value '获取作为检查目标的加载器和版本 + '此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version Dim ModLoaders = GetTargetModLoaders() Dim McVersion = TargetMcVersion.McName - '暂不向下扩展检查的 MC 小版本 - '例如：Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 - 'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then - ' McVersions.Add($"1.{TargetMcVersion.McCodeMain}") - ' For i = 1 To TargetMcVersion.McCodeSub - ' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}") - ' Next - 'End If - 'McVersions = McVersions.Distinct().ToList() '开始网络获取 Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}") Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False @@ -1062,7 +1054,7 @@ Finished: Entry.Comp = Project Next '查找或许版本更新的文件列表 - If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新 + If ModLoaders.Count = 1 Then Dim NewestVersion As String = Nothing Dim NewestFileIds As New List(Of Integer) For Each IndexEntry In ProjectJson("latestFilesIndexes") diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index 624a685..1d8dc13 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -203,7 +203,8 @@ Retry: End If Task.Progress = 0.95 '开启版本隔离 - WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True) End Sub) With { .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End If @@ -397,7 +398,8 @@ Retry: End If Task.Progress = 0.95 '开启版本隔离 - WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True) End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '获取下载文件列表 Dim FileList As New List(Of NetFile) @@ -513,7 +515,8 @@ Retry: End If Task.Progress = 0.95 '开启版本隔离 - WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True) End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '构造加载器 If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！") @@ -598,6 +601,7 @@ Retry: Task.Progress = 0.95 '开启版本隔离 WriteIni(SetupFile, "VersionArgumentIndie", 1) + WriteIni(SetupFile, "VersionArgumentIndieV2", True) '读取 MMC 设置文件（#2655） Try Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg" @@ -738,7 +742,8 @@ Retry: End If Task.Progress = 0.95 '开启版本隔离 - WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1) + WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True) End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '构造加载器 If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！") diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb index d3bcaf4..34e7ab2 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb @@ -172,7 +172,7 @@ ''' ''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示：若关闭碰撞检测，则无法展开 Tooltip。 ''' - Public CanInteraction As Boolean = True + Public Property CanInteraction As Boolean = True Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp If Not CanInteraction Then Exit Sub '判断当前颜色 diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index 996d465..6f7b5e3 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -146,12 +146,11 @@ " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex) End Try '下载文件 - Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName - Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml") - Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1) + Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName + Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp) Try - NetDownloadByClient(RelativeUrl, LocalTemp1) - NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml")) + NetDownloadByClient(RelativeUrl, LocalTemp) + NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml")) Catch ex As Exception Throw New Exception("下载指定的文件失败！" & vbCrLf & "注意，联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf & @@ -159,7 +158,7 @@ " - https://www.baidu.com/test.json（填写这个路径）" & vbCrLf & " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex) End Try - RelativeUrl = LocalTemp1 + RelativeUrl = LocalTemp End If RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\") diff --git a/Plain Craft Launcher 2/Modules/ModMain.vb b/Plain Craft Launcher 2/Modules/ModMain.vb index ecf5ca4..51cde8e 100644 --- a/Plain Craft Launcher 2/Modules/ModMain.vb +++ b/Plain Craft Launcher 2/Modules/ModMain.vb @@ -677,8 +677,8 @@ NextFile: ''' Public Function HelpArgumentReplace(Xaml As String) As String Dim Result = Xaml.Replace("{path}", EscapeXML(Path)) - Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomHint()), "\{hint\}") - Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomCave()), "\{cave\}") + Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint())) + Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave())) Return Result End Function @@ -811,6 +811,34 @@ NextFile: Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean + ''' + ''' 将特定程序设置为使用高性能显卡启动。 + ''' 如果失败，则抛出异常。 + ''' + Public Sub SetGPUPreference(Executeable As String) + Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences" + Const REG_VALUE As String = "GpuPreference=2;" + '查看现有设置 + Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False) + If ReadOnlyKey IsNot Nothing Then + Dim CurrentValue = ReadOnlyKey.GetValue(Executeable) + If REG_VALUE = CurrentValue?.ToString() Then + Log($"[System] 无需调整显卡设置：{Executeable}") + Return + End If + Else + '创建父级键 + Log($"[System] 需要创建显卡设置的父级键") + My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY) + End If + End Using + '写入新设置 + Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True) + WriteKey.SetValue(Executeable, REG_VALUE) + Log($"[System] 已调整显卡设置：{Executeable}") + End Using + End Sub + #End Region #Region "任务缓存" @@ -851,10 +879,9 @@ NextFile: ''' 是否要求路径不包含空格。 Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String TryClearTaskTemp() - If RequireNonSpace Then - RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\Install\{GetUuid()}-{RandomInteger(0, 1000000)}\" - Else - RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\" + RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\" + If RequireNonSpace AndAlso RequestTaskTempFolder.Contains(" ") Then + RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\" End If Directory.CreateDirectory(RequestTaskTempFolder) End Function diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index 6a7e34d..6416146 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -255,7 +255,7 @@ #End Region ''' - ''' 当前正在播放的 NAudio.Wave.WaveOut。 + ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。 ''' Public MusicNAudio = Nothing ''' @@ -267,11 +267,11 @@ ''' 在 MusicUuid 不变的前提下，持续播放某地址的音乐，且在播放结束后随机播放下一曲。 ''' Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False) - Dim CurrentWave As NAudio.Wave.WaveOut = Nothing + Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing Dim Reader As NAudio.Wave.WaveStream = Nothing Try '开始播放 - CurrentWave = New NAudio.Wave.WaveOut() + CurrentWave = New NAudio.Wave.WaveOutEvent() MusicNAudio = CurrentWave Reader = New NAudio.Wave.AudioFileReader(MusicCurrent) CurrentWave.Init(Reader) @@ -296,6 +296,10 @@ If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress) Catch ex As Exception Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", LogLevel.Developer) + If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then + Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Critical) + Thread.Sleep(1000000000) + End If If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Critical) Thread.Sleep(1000000000) diff --git a/Plain Craft Launcher 2/Modules/ModSecret.vb b/Plain Craft Launcher 2/Modules/ModSecret.vb index 3e36f17..92b09ab 100644 --- a/Plain Craft Launcher 2/Modules/ModSecret.vb +++ b/Plain Craft Launcher 2/Modules/ModSecret.vb @@ -34,7 +34,7 @@ Friend Module ModSecret "2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf & "3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。", MsgBoxStyle.Critical, "运行环境错误") - Environment.[Exit](Result.Cancel) + Environment.[Exit](ProcessReturnValues.Cancel) End Try If Not CheckPermission(Path & "PCL") Then MsgBox("PCL 没有对当前文件夹的写入权限，请尝试：" & vbCrLf & @@ -42,7 +42,7 @@ Friend Module ModSecret "2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf & "3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。", MsgBoxStyle.Critical, "运行环境错误") - Environment.[Exit](Result.Cancel) + Environment.[Exit](ProcessReturnValues.Cancel) End If '开源版本提示 MyMsgBox($"该版本中无法使用以下特性： diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index a2893a7..5eeba66 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -1,4 +1,4 @@ -Imports System.Reflection +Imports System.Reflection Imports System.Resources Imports System.Runtime.InteropServices @@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 方法是按如下所示使用“*” - - + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb index 2875dbd..4707dc6 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -440,7 +440,7 @@ pause" End SyncLock '添加 Java Wrapper 作为主 Jar Dim Arguments As String - If UseJavaWrapper Then + If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer" Else Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer" @@ -545,76 +545,76 @@ pause" Dim VersionFolder As String = McFolder & "versions\" & Id & "\" Dim IsNewVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse Val(DownloadInfo.Inherit.Split(".")(1)) >= 14 Dim Target As String = If(IsNewVersion, - PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(), + RequestTaskTempFolder(), McFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")) Dim Loaders As New List(Of LoaderBase) '获取下载地址 Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 OptiFine 主文件下载地址", - Sub(Task As LoaderTask(Of String, List(Of NetFile))) - '启动依赖版本的下载 - If ClientDownloadLoader Is Nothing Then - If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹") - ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit) - End If - Task.Progress = 0.1 - Dim Sources As New List(Of String) - 'BMCLAPI 源 - Dim BmclapiInherit As String = DownloadInfo.Inherit - If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 - If DownloadInfo.IsPreview Then - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) - Else - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) - End If - '官方源 - Dim PageData As String - Try - PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) - Task.Progress = 0.8 - Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) - Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last) - Catch ex As Exception - Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") - End Try - '构造文件请求 - Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} - End Sub) With {.ProgressWeight = 8}) + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If ClientDownloadLoader Is Nothing Then + If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹") + ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit) + End If + Task.Progress = 0.1 + Dim Sources As New List(Of String) + 'BMCLAPI 源 + Dim BmclapiInherit As String = DownloadInfo.Inherit + If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 + If DownloadInfo.IsPreview Then + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Else + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + End If + '官方源 + Dim PageData As String + Try + PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) + Task.Progress = 0.8 + Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) + Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last) + Catch ex As Exception + Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") + End Try + '构造文件请求 + Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} + End Sub) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载", - Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) - '等待原版文件下载完成 - If ClientDownloadLoader Is Nothing Then Exit Sub - Dim TargetLoaders As List(Of LoaderBase) = - ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). - Where(Function(l) l.State <> LoadState.Finished).ToList - If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成") - Do While TargetLoaders.Any AndAlso Not Task.IsAborted - TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList - Thread.Sleep(50) - Loop - If Task.IsAborted Then Exit Sub - '拷贝原版文件 - If Not IsCustomFolder Then Exit Sub - SyncLock VanillaSyncLock - Dim ClientName As String = GetFolderNameFromPath(ClientFolder) - Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) - If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then - CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json") - End If - If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then - CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar") - End If - End SyncLock - End Sub) With {.ProgressWeight = 0.1, .Show = False}) + Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) + '等待原版文件下载完成 + If ClientDownloadLoader Is Nothing Then Exit Sub + Dim TargetLoaders As List(Of LoaderBase) = + ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). + Where(Function(l) l.State <> LoadState.Finished).ToList + If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成") + Do While TargetLoaders.Any AndAlso Not Task.IsAborted + TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList + Thread.Sleep(50) + Loop + If Task.IsAborted Then Exit Sub + '拷贝原版文件 + If Not IsCustomFolder Then Exit Sub + SyncLock VanillaSyncLock + Dim ClientName As String = GetFolderNameFromPath(ClientFolder) + Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) + If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then + CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json") + End If + If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then + CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar") + End If + End SyncLock + End Sub) With {.ProgressWeight = 0.1, .Show = False}) '安装（新旧方式均需要原版 Jar 和 Json） If IsNewVersion Then Log("[Download] 检测为新版 OptiFine：" & DownloadInfo.Inherit) Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 A）", Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) - Dim BaseMcFolderHome As String = PathTemp & "InstallOptiFine" & RandomInteger(0, 100000) - Dim BaseMcFolder As String = BaseMcFolderHome & "\.minecraft\" + Dim BaseMcFolderHome As String = RequestTaskTempFolder() + Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\" Try '准备安装环境 If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then @@ -759,7 +759,7 @@ Retry: .Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = If(Entry.IsPreview, "测试版", "正式版") & If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime) & - If(Entry.RequiredForgeVersion Is Nothing, "，不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", "，推荐 Forge 版本：" & Entry.RequiredForgeVersion)), + If(Entry.RequiredForgeVersion Is Nothing, "，不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", "，兼容 Forge " & Entry.RequiredForgeVersion)), .Logo = PathImage & "Blocks/GrassPath.png" } AddHandler NewItem.Click, OnClick @@ -1109,7 +1109,7 @@ Retry: End SyncLock '添加 Java Wrapper 作为主 Jar Dim Arguments As String - If UseJavaWrapper Then + If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}" Else Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" @@ -1264,7 +1264,7 @@ Retry: End If Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge") Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder - Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{LoaderVersion}_{RandomInteger(0, 100000)}" + Dim InstallerAddress As String = RequestTaskTempFolder() & "forge_installer.jar" Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\" Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}" Dim Loaders As New List(Of LoaderBase) @@ -1540,6 +1540,8 @@ Retry: #Region "Forge 下载菜单" Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) + '如果只有一个版本，则不特别列出 + If Entries.Count = 1 Then Return '获取推荐版本与最新版本 Dim FreshVersion As DlForgeVersionEntry = Nothing If Entries.Any Then @@ -1691,6 +1693,8 @@ Retry: #Region "NeoForge 下载菜单" Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlNeoForgeListEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) + '如果只有一个版本，则不特别列出 + If Entries.Count = 1 Then Return '获取最新稳定版和测试版 Dim FreshStableVersion As DlNeoForgeListEntry = Nothing Dim FreshBetaVersion As DlNeoForgeListEntry = Nothing @@ -2085,10 +2089,9 @@ Retry: If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" '判断 OptiFine 是否作为 Mod 进行下载 - Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0) - Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine - (Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric... - (Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15（#4134） + 'Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0) + Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso + (Request.FabricVersion IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing) '选择了 OptiFine 与任意 Mod 加载器 Dim ModsFolder As String = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" If OptiFineAsMod Then diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb index 5c041d1..b3de19c 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb @@ -61,8 +61,7 @@ Next '排序 For i = 0 To Dict.Keys.Count - 1 - Dict(Dict.Keys(i)) = Sort(Dict.Values(i), - Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date)) + Dict(Dict.Keys(i)) = Dict.Values(i).OrderByDescending(Function(v) v("releaseTime").Value(Of Date)).ToList Next '清空当前 PanMain.Children.Clear() diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb index 7a9b417..c8557a8 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb @@ -363,12 +363,14 @@ Else Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - "). Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：") - Select Case Setup.Get("ToolDownloadTranslate") + Select Case Setup.Get("ToolDownloadTranslateV2") Case 0 - FileName = $"[{ChineseName}] {File.FileName}" + FileName = $"【{ChineseName}】{File.FileName}" Case 1 - FileName = $"{ChineseName}-{File.FileName}" + FileName = $"[{ChineseName}] {File.FileName}" Case 2 + FileName = $"{ChineseName}-{File.FileName}" + Case 3 FileName = $"{File.FileName}-{ChineseName}" Case Else FileName = File.FileName diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb index 354fe86..38ba113 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb @@ -10,12 +10,10 @@ Private Sub Load_OnFinish() '结果数据化 Try - '排序 - Dim Versions = Sort(DlForgeListLoader.Output.Value, AddressOf VersionSortBoolean) '清空当前 PanMain.Children.Clear() '转化为 UI - For Each Version As String In Versions + For Each Version As String In DlForgeListLoader.Output.Value.Sort(AddressOf VersionSortBoolean) '增加卡片 Dim NewCard As New MyCard With {.Title = Version.Replace("_p", " P"), .Margin = New Thickness(0, 0, 0, 15), .SwapType = 5} Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Version} diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml index 6c7a800..124a1d7 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml @@ -5,66 +5,31 @@ mc:Ignorable="d" x:Class="PageDownloadInstall" PanScroll="{Binding ElementName=PanBack}"> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + - + @@ -77,12 +42,12 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -95,12 +60,12 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -113,12 +78,12 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -131,14 +96,14 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -151,12 +116,12 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -169,12 +134,12 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - + - + @@ -187,12 +152,16 @@ + Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> - - - + + + + + @@ -205,3 +174,26 @@ + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb index f6170d2..bc33e45 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb @@ -1,7 +1,8 @@ Public Class PageDownloadInstall Private Sub LoaderInit() Handles Me.Initialized - PageLoaderInit(LoadMinecraft, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf LoadMinecraft_OnFinish) + DisabledPageAnimControls.Add(BtnStart) + PageLoaderInit(LoadMinecraft, PanLoad, PanAllBack, Nothing, DlClientListLoader, AddressOf LoadMinecraft_OnFinish) End Sub Private IsLoad As Boolean = False @@ -40,6 +41,8 @@ If IsInSelectPage Then Exit Sub IsInSelectPage = True + PanInner.Margin = New Thickness(25, 10, 25, 40) + AutoSelectedFabricApi = False AutoSelectedOptiFabric = False IsSelectNameEdited = False @@ -49,7 +52,8 @@ PanBack.IsHitTestVisible = False PanBack.ScrollToHome() - CardMinecraft.IsSwaped = True + DisabledPageAnimControls.Remove(BtnStart) + BtnStart.Show = True CardOptiFine.IsSwaped = True CardLiteLoader.IsSwaped = True CardForge.IsSwaped = True @@ -83,8 +87,8 @@ DlOptiFabricLoader.Start() AniStart({ - AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10), - AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10), + AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 90, 10), + AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 100, 10), AaCode( Sub() PanBack.ScrollToHome() @@ -98,8 +102,8 @@ OptiFabric_Loaded() SelectReload() End Sub, After:=True), - AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150), - AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)), + AaOpacity(PanSelect, 1 - PanSelect.Opacity, 90, 100), + AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)), AaCode( Sub() PanMinecraft.Visibility = Visibility.Collapsed @@ -117,10 +121,14 @@ End Sub,, True) }, "FrmDownloadInstall SelectPageSwitch", True) End Sub - Public Sub ExitSelectPage() + Public Sub ExitSelectPage() Handles BtnBack.Click If Not IsInSelectPage Then Exit Sub IsInSelectPage = False + PanInner.Margin = New Thickness(25, 10, 25, 25) + + DisabledPageAnimControls.Add(BtnStart) + BtnStart.Show = False SelectClear() '清除已选择项 PanMinecraft.Visibility = Visibility.Visible PanSelect.IsHitTestVisible = False @@ -132,26 +140,21 @@ AaOpacity(PanSelect, -PanSelect.Opacity, 90, 10), AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 100, 10), AaCode(Sub() PanBack.ScrollToHome(), After:=True), - AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 150, 100), - AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 400, 100, Ease:=New AniEaseOutBack(AniEasePower.Weak)), - AaCode(Sub() - PanSelect.Visibility = Visibility.Collapsed - PanBack.IsHitTestVisible = True - End Sub,, True) + AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 90, 100), + AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)), + AaCode( + Sub() + PanSelect.Visibility = Visibility.Collapsed + PanBack.IsHitTestVisible = True + End Sub,, True) }, "FrmDownloadInstall SelectPageSwitch") End Sub - - '页面切换触发 Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs) SelectedMinecraftId = sender.Title SelectedMinecraftJsonUrl = sender.Tag("url").ToString SelectedMinecraftIcon = sender.Logo EnterSelectPage() End Sub - Private Sub CardMinecraft_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardMinecraft.PreviewSwap - ExitSelectPage() - e.Handled = True - End Sub #End Region @@ -311,12 +314,7 @@ IsReloading = True '主预览 SelectNameUpdate() - ItemSelect.Title = TextSelectName.Text - ItemSelect.Info = GetSelectInfo() - ItemSelect.Logo = GetSelectLogo() - 'Minecraft - LabMinecraft.Text = SelectedMinecraftId - ImgMinecraft.Source = New MyBitmap(SelectedMinecraftIcon) + ImgLogo.Source = GetSelectLogo() 'OptiFine Dim OptiFineError As String = LoadOptiFineGetError() CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed) @@ -325,7 +323,7 @@ If SelectedOptiFine Is Nothing Then BtnOptiFineClear.Visibility = Visibility.Collapsed ImgOptiFine.Visibility = Visibility.Collapsed - LabOptiFine.Text = If(OptiFineError, "点击选择") + LabOptiFine.Text = If(OptiFineError, "可以添加") LabOptiFine.Foreground = ColorGray4 Else BtnOptiFineClear.Visibility = Visibility.Visible @@ -345,7 +343,7 @@ If SelectedLiteLoader Is Nothing Then BtnLiteLoaderClear.Visibility = Visibility.Collapsed ImgLiteLoader.Visibility = Visibility.Collapsed - LabLiteLoader.Text = If(LiteLoaderError, "点击选择") + LabLiteLoader.Text = If(LiteLoaderError, "可以添加") LabLiteLoader.Foreground = ColorGray4 Else BtnLiteLoaderClear.Visibility = Visibility.Visible @@ -362,7 +360,7 @@ If SelectedForge Is Nothing Then BtnForgeClear.Visibility = Visibility.Collapsed ImgForge.Visibility = Visibility.Collapsed - LabForge.Text = If(ForgeError, "点击选择") + LabForge.Text = If(ForgeError, "可以添加") LabForge.Foreground = ColorGray4 Else BtnForgeClear.Visibility = Visibility.Visible @@ -382,7 +380,7 @@ If SelectedNeoForge Is Nothing Then BtnNeoForgeClear.Visibility = Visibility.Collapsed ImgNeoForge.Visibility = Visibility.Collapsed - LabNeoForge.Text = If(NeoForgeError, "点击选择") + LabNeoForge.Text = If(NeoForgeError, "可以添加") LabNeoForge.Foreground = ColorGray4 Else BtnNeoForgeClear.Visibility = Visibility.Visible @@ -403,7 +401,7 @@ If SelectedFabric Is Nothing Then BtnFabricClear.Visibility = Visibility.Collapsed ImgFabric.Visibility = Visibility.Collapsed - LabFabric.Text = If(FabricError, "点击选择") + LabFabric.Text = If(FabricError, "可以添加") LabFabric.Foreground = ColorGray4 Else BtnFabricClear.Visibility = Visibility.Visible @@ -424,7 +422,7 @@ If SelectedFabricApi Is Nothing Then BtnFabricApiClear.Visibility = Visibility.Collapsed ImgFabricApi.Visibility = Visibility.Collapsed - LabFabricApi.Text = If(FabricApiError, "点击选择") + LabFabricApi.Text = If(FabricApiError, "可以添加") LabFabricApi.Foreground = ColorGray4 Else BtnFabricApiClear.Visibility = Visibility.Visible @@ -445,7 +443,7 @@ If SelectedOptiFabric Is Nothing Then BtnOptiFabricClear.Visibility = Visibility.Collapsed ImgOptiFabric.Visibility = Visibility.Collapsed - LabOptiFabric.Text = If(OptiFabricError, "点击选择") + LabOptiFabric.Text = If(OptiFabricError, "可以添加") LabOptiFabric.Foreground = ColorGray4 Else BtnOptiFabricClear.Visibility = Visibility.Visible @@ -497,7 +495,26 @@ SelectedOptiFabric = Nothing End Sub - '显示信息获取 + ''' + ''' 获取版本图标。 + ''' + Private Function GetSelectLogo() As String + If SelectedFabric IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Fabric.png" + ElseIf SelectedForge IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Anvil.png" + ElseIf SelectedNeoForge IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/NeoForge.png" + ElseIf SelectedLiteLoader IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Egg.png" + ElseIf SelectedOptiFine IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/GrassPath.png" + Else + Return SelectedMinecraftIcon + End If + End Function + + '版本名处理 ''' ''' 获取默认版本名。 ''' @@ -520,49 +537,6 @@ End If Return Name End Function - ''' - ''' 获取版本描述信息。 - ''' - Private Function GetSelectInfo() As String - Dim Info As String = "" - If SelectedFabric IsNot Nothing Then - Info += ", Fabric " & SelectedFabric.Replace("+build", "") - End If - If SelectedForge IsNot Nothing Then - Info += ", Forge " & SelectedForge.VersionName - End If - If SelectedNeoForge IsNot Nothing Then - Info += ", NeoForge " & SelectedNeoForge.VersionName - End If - If SelectedLiteLoader IsNot Nothing Then - Info += ", LiteLoader" - End If - If SelectedOptiFine IsNot Nothing Then - Info += ", OptiFine " & SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "") - End If - If Info = "" Then Info = ", 无附加安装" - Return Info.TrimStart(", ".ToCharArray()) - End Function - ''' - ''' 获取版本图标。 - ''' - Private Function GetSelectLogo() As String - If SelectedFabric IsNot Nothing Then - Return "pack://application:,,,/images/Blocks/Fabric.png" - ElseIf SelectedForge IsNot Nothing Then - Return "pack://application:,,,/images/Blocks/Anvil.png" - ElseIf SelectedNeoForge IsNot Nothing Then - Return "pack://application:,,,/images/Blocks/NeoForge.png" - ElseIf SelectedLiteLoader IsNot Nothing Then - Return "pack://application:,,,/images/Blocks/Egg.png" - ElseIf SelectedOptiFine IsNot Nothing Then - Return "pack://application:,,,/images/Blocks/GrassPath.png" - Else - Return SelectedMinecraftIcon - End If - End Function - - '版本名处理 Private IsSelectNameEdited As Boolean = False Private IsSelectNameChanging As Boolean = False Private Sub SelectNameUpdate() @@ -577,7 +551,7 @@ SelectReload() End Sub Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged - BtnSelectStart.IsEnabled = TextSelectName.ValidateResult = "" + BtnStart.IsEnabled = TextSelectName.IsValidated End Sub #End Region @@ -637,10 +611,8 @@ Dict(Type).Add(Version) Next '排序 - For i = 0 To Dict.Keys.Count - 1 - Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean - Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date) - End Function) + For Each Pair In Dict.ToList + Dict(Pair.Key) = Pair.Value.OrderByDescending(Function(j) j("releaseTime").Value(Of Date)).ToList Next '清空当前 PanMinecraft.Children.Clear() @@ -697,46 +669,41 @@ ''' Private Function LoadOptiFineGetError() As String If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容" - If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFine.State, Object).Error.Message '检查 Forge 1.13 - 1.14.3：全部不兼容 If SelectedForge IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 Forge 不兼容" End If - '检查最低 Forge 版本 - Dim MinimalForgeVersion As String = "9999.9999" - Dim NotSuitForForge As Boolean = False + '检查 Forge 版本 + Dim HasAny As Boolean = False + Dim HasRequiredVersion As Boolean = False For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本 - If SelectedForge Is Nothing Then Return Nothing '该版本可用 - If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then - Return Nothing '该版本可用 - Else - NotSuitForForge = True - If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then - '设置用于显示的最低允许的 Forge 版本 - MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion), - OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion) - End If - End If + HasAny = True + If SelectedForge Is Nothing Then Return Nothing '未选择 Forge + If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用 + If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then HasRequiredVersion = True Next - If MinimalForgeVersion = "9999.9999" Then - Return If(NotSuitForForge, "与 Forge 不兼容", "没有可用版本") + If Not HasAny Then + Return "不可用" + ElseIf HasRequiredVersion Then + Return "仅兼容特定版本的 Forge" Else - Return "需要 Forge " & If(MinimalForgeVersion.Contains("."), "", "#") & MinimalForgeVersion & " 或更高版本" + Return "与 Forge 不兼容" End If End Function - '检查某个 OptiFine 是否与某个 Forge 兼容（最低 Forge 版本是否达到需求） + '检查某个 OptiFine 是否与某个 Forge 兼容 Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry) If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本 If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183 If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX - Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0 + Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) = 0 Else 'XXXX - Return Forge.Version.Revision >= OptiFine.RequiredForgeVersion + Return Forge.Version.Revision = OptiFine.RequiredForgeVersion End If End Function @@ -760,7 +727,7 @@ Next If Not Versions.Any() Then Exit Sub '排序 - Versions = Sort(Versions, + Versions = Versions.Sort( Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean If Not Left.IsPreview AndAlso Right.IsPreview Then Return True If Left.IsPreview AndAlso Not Right.IsPreview Then Return False @@ -804,13 +771,13 @@ ''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadLiteLoaderGetError() As String - If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "没有可用版本" - If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "不可用" + If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadLiteLoader.State, Object).Error.Message For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value If Version.Inherit = SelectedMinecraftId Then Return Nothing Next - Return "没有可用版本" + Return "不可用" End Function '限制展开 @@ -861,15 +828,15 @@ ''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadForgeGetError() As String - If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本" - If Not LoadForge.State.IsLoader Then Return "正在获取版本列表……" + If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用" + If Not LoadForge.State.IsLoader Then Return "加载中……" Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State - If SelectedMinecraftId <> Loader.Input Then Return "正在获取版本列表……" - If Loader.State = LoadState.Loading Then Return "正在获取版本列表……" + If SelectedMinecraftId <> Loader.Input Then Return "加载中……" + If Loader.State = LoadState.Loading Then Return "加载中……" If Loader.State = LoadState.Failed Then Dim ErrorMessage As String = Loader.Error.Message - If ErrorMessage.Contains("没有可用版本") Then - Return "没有可用版本" + If ErrorMessage.Contains("不可用") Then + Return "不可用" Else Return "获取版本列表失败：" & ErrorMessage End If @@ -911,12 +878,12 @@ Dim Versions = Loader.Output.ToList '复制数组，以免 Output 在实例化后变空 If Not Loader.Output.Any() Then Exit Sub PanForge.Children.Clear() - Versions = Sort(Versions, Function(a, b) a.Version > b.Version).Where( + Versions = Versions.Where( Function(v) If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本 If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False Return True - End Function).ToList() + End Function).OrderByDescending(Function(v) v.Version).ToList() ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False) For Each Version In Versions PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) @@ -950,16 +917,16 @@ ''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadNeoForgeGetError() As String - If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本" + If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用" If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容" If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" - If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadNeoForge.State, Object).Error.Message If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then Return Nothing Else - Return "没有可用版本" + Return "不可用" End If End Function @@ -1011,7 +978,7 @@ ''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadFabricGetError() As String - If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadFabric.State, Object).Error.Message For Each Version As JObject In DlFabricListLoader.Output.Value("game") If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then @@ -1020,7 +987,7 @@ Return Nothing End If Next - Return "没有可用版本" + Return "不可用" End Function '限制展开 @@ -1111,18 +1078,18 @@ ''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadFabricApiGetError() As String - If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadFabricApi.State, Object).Error.Message If DlFabricApiLoader.Output Is Nothing Then If SelectedFabric Is Nothing Then Return "需要安装 Fabric" - Return "正在获取版本列表……" + Return "加载中……" End If For Each Version In DlFabricApiLoader.Output If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For If SelectedFabric Is Nothing Then Return "需要安装 Fabric" Return Nothing Next - Return "没有可用版本" + Return "不可用" End Function '限制展开 @@ -1150,7 +1117,7 @@ End If Next If Not Versions.Any() Then Exit Sub - Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate) + Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList '可视化 PanFabricApi.Children.Clear() For Each Version In Versions @@ -1204,13 +1171,13 @@ ''' Private Function LoadOptiFabricGetError() As String If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric，请手动下载 OptiFabric Origins" - If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFabric.State, Object).Error.Message If DlOptiFabricLoader.Output Is Nothing Then If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" - Return "正在获取版本列表……" + Return "加载中……" End If For Each Version In DlOptiFabricLoader.Output If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135# @@ -1219,7 +1186,7 @@ If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" Return Nothing '通过检查 Next - Return "没有可用版本" + Return "不可用" End Function '限制展开 @@ -1241,7 +1208,7 @@ Next If Not Versions.Any() Then Exit Sub '排序 - Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate) + Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList '可视化 PanOptiFabric.Children.Clear() For Each Version In Versions @@ -1278,22 +1245,23 @@ #Region "安装" Private Sub TextSelectName_KeyDown(sender As Object, e As KeyEventArgs) Handles TextSelectName.KeyDown - If e.Key = Key.Enter AndAlso BtnSelectStart.IsEnabled Then BtnSelectStart_Click() + If e.Key = Key.Enter AndAlso BtnStart.IsEnabled Then BtnStart_Click() End Sub - Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click + Private Sub BtnStart_Click() Handles BtnStart.Click '确认版本隔离 If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso - (Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then - If MyMsgBox("你尚未开启版本隔离，这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf & - "因此在切换 MC 版本时，MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & - "PCL 推荐你在开始下载前，在 设置 → 版本隔离 中开启版本隔离选项！", "版本隔离提示", "取消下载", "继续") = 1 Then + (Setup.Get("LaunchArgumentIndieV2") = 0 OrElse Setup.Get("LaunchArgumentIndieV2") = 2) Then + If MyMsgBox("你尚未开启版本隔离，这会导致多个版本共用同一个 Mod 文件夹。" & vbCrLf & + "因此游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & + "推荐在开始下载前，在 设置 → 启动选项 → 版本隔离 中开启版本隔离！", "版本隔离提示", "取消下载", "继续") = 1 Then Exit Sub End If End If '提交安装申请 + Dim VersionName As String = TextSelectName.Text Dim Request As New McInstallRequest With { - .TargetVersionName = TextSelectName.Text, - .TargetVersionFolder = $"{PathMcFolder}versions\{TextSelectName.Text}\", + .TargetVersionName = VersionName, + .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .MinecraftJson = SelectedMinecraftJsonUrl, .MinecraftName = SelectedMinecraftId, .OptiFineEntry = SelectedOptiFine, diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml index bb644b1..86c9ef2 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml @@ -6,8 +6,8 @@ - + @@ -15,7 +15,7 @@ + Logo="M1000 241c-2-5-4-11-6-17-0-6-4-12-8-17-7-9-18-15-31-15-6 0-13 1-19 5l-15 15-17 17-21 21L749 381c-14 14-38 14-52 0l-54-54c-14-14-14-38 0-52l132-132 14-14 20-20 16-16c3-5 5-11 5-19 0-12-5-24-16-32-5-4-11-6-18-7-5-2-10-4-16-5-36-12-76-19-117-19-7 0-14 0-22 0-188 11-337 168-337 360 0 16 0 32 3 48L56 663c-73 74-73 193 0 267l33 33c73 73 193 73 267 0l240-241c21 4 42 5 64 5 190 0 346-146 360-333 0-8 0-17 0-27 0-44-6-86-21-125zM658 639c-28 0-54-4-79-11-4 7-10 14-16 21l-258 258c-43 43-115 43-158 0l-29-29c-43-44-43-115 0-158l212-212 46-46c5-5 12-11 19-15-8-26-12-54-12-83v-1c0-152 123-275 276-275 18 0 37 1 55 5L597 207c-52 52-52 137 0 189l29 29c52 52 137 52 189 0L930 312c2 16 4 33 4 50 0 152-123 276-276 276z" /> @@ -68,7 +68,7 @@ - + @@ -78,7 +78,7 @@ + LogoScale="0.98" Logo="M511 995a128 128 0 0 1-57-13L70 791a126 126 0 0 1-70-113V311a126 126 0 0 1 15-60V248c1-2 3-5 5-8a127 127 0 0 1 49-42L454 13a128 128 0 0 1 112 0l383 190a126 126 0 0 1 72 113v360a126 126 0 0 1-70 115L568 984c-17 7-37 11-57 11z m42-470v370l360-178c14-7 23-21 23-38v-335L554 524zM85 330v347a42 42 0 0 0 23 38l360 178V523L85 330zM135 260l375 189 137-65L286 188 135 260z m245-118l363 197 150-71-365-180a42 42 0 0 0-37 0l-111 53z"> diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml index 79b34ab..1a08b51 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml @@ -13,7 +13,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb index e0d56d8..e74b323 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -56,9 +56,9 @@ Dim InstallLoader = ModpackInstall(PackInstallPath) Log("[Launch] 自动安装整合包已开始：" & PackInstallPath) InstallLoader.WaitForExit() - If InstallLoader.State = LoadState.Finished AndAlso File.Exists(PackInstallPath) Then - Log("[Launch] 自动安装整合包成功，删除安装包：" & PackInstallPath) - File.Delete(PackInstallPath) + If InstallLoader.State = LoadState.Finished Then + Log("[Launch] 自动安装整合包成功，清理安装包：" & PackInstallPath) + If File.Exists(PackInstallPath) Then File.Delete(PackInstallPath) End If Catch ex As CancelledException Log(ex, "自动安装整合包被用户取消：" & PackInstallPath) diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb index a7f9830..49c627e 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb @@ -92,7 +92,7 @@ ElseIf ex.Message.StartsWith("$") Then Hint(ex.Message.TrimStart("$"), HintType.Critical) 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) Else Log(ex, "正版登录尝试失败", LogLevel.Msgbox) End If diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb b/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb index 7f95d6f..e0639ae 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb @@ -17,7 +17,7 @@ Private IsLoad As Boolean = False Private Sub OnLoaded() Handles Me.Loaded - FormMain.EndProgramForce(Result.Aborted) + FormMain.EndProgramForce(ProcessReturnValues.Aborted) If IsLoad Then Exit Sub IsLoad = True '启动监视线程 diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml index 4b7051c..f4fe1ca 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml @@ -1,398 +1,463 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml index 874928f..0c62e42 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml @@ -14,7 +14,7 @@ + LogoScale="0.97" Logo="M511 995a128 128 0 0 1-57-13L70 791a126 126 0 0 1-70-113V311a126 126 0 0 1 15-60V248c1-2 3-5 5-8a127 127 0 0 1 49-42L454 13a128 128 0 0 1 112 0l383 190a126 126 0 0 1 72 113v360a126 126 0 0 1-70 115L568 984c-17 7-37 11-57 11z m42-470v370l360-178c14-7 23-21 23-38v-335L554 524zM85 330v347a42 42 0 0 0 23 38l360 178V523L85 330zM135 260l375 189 137-65L286 188 135 260z m245-118l363 197 150-71-365-180a42 42 0 0 0-37 0l-111 53z" /> = 3) Then Exit Sub @@ -244,6 +244,7 @@ If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub '满足以上全部条件则视为根目录整合包 Setup.Set("VersionArgumentIndie", 2, Version:=Version) + Setup.Set("VersionArgumentIndieV2", False, Version:=Version) Log("[Setup] 已自动关闭单版本隔离：" & Version.Name, LogLevel.Debug) Next Catch ex As Exception diff --git a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb index b23290e..9a809d8 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb @@ -21,7 +21,9 @@ {"HintClearRubbish", New SetupEntry(0, Source:=SetupSource.Registry)}, {"HintUpdateMod", New SetupEntry(False, Source:=SetupSource.Registry)}, {"HintCustomCommand", New SetupEntry(False, Source:=SetupSource.Registry)}, - {"TestSetupReader", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"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)}, {"SystemCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"SystemLaunchCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, @@ -91,18 +93,19 @@ {"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:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")}, + {"LaunchAdvanceJvm", New SetupEntry("-Dfile.encoding=UTF-8 -Dstdout.encoding=UTF-8 -Dstderr.encoding=UTF-8 -XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -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)}, - {"LaunchAdvanceAssets", New SetupEntry(False)}, - {"LaunchAdvanceJava", New SetupEntry(False)}, + {"LaunchAdvanceDisableJLW", New SetupEntry(False)}, + {"LaunchAdvanceGraphicCard", New SetupEntry(True, Source:=SetupSource.Registry)}, {"LaunchRamType", New SetupEntry(0)}, {"LaunchRamCustom", New SetupEntry(15)}, {"LinkEula", New SetupEntry(False, Source:=SetupSource.Registry)}, @@ -116,6 +119,7 @@ {"ToolDownloadSpeed", New SetupEntry(42, Source:=SetupSource.Registry)}, {"ToolDownloadVersion", New SetupEntry(0, 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(1, Source:=SetupSource.Registry)}, @@ -174,12 +178,14 @@ {"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)}, + {"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)}, {"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)}, {"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)}, {"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)}, + {"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Version)}, {"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Version)}, @@ -204,7 +210,10 @@ Public Value Public Source As SetupSource - '加载状态：0/未读取 1/已读取未处理 2/已处理 + ''' + ''' 加载状态：0/未读取 1/已读取未处理 2/已处理 + ''' 我也不知道当年写这坨的时候为啥没用 Enum…… + ''' Public State As Byte = 0 Public Type As Type @@ -257,11 +266,8 @@ Case SetupSource.Registry WriteReg(Key, Value) Case SetupSource.Version - If Version Is Nothing Then - Throw New Exception("更改版本设置 " & Key & " 时未提供目标版本") - Else - WriteIni(Version.Path & "PCL\Setup.ini", Key, Value) - End If + If Version Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本") + WriteIni(Version.Path & "PCL\Setup.ini", Key, Value) End Select '应用 '例如 VersionServerLogin 要求在设置之后再引发事件 @@ -319,6 +325,15 @@ Public Sub Reset(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing) Dim E As SetupEntry = SetupDict(Key) [Set](Key, E.DefaultValue, E, ForceReload, Version) + Select Case SetupDict(Key).Source + Case SetupSource.Normal + DeleteIniKey("Setup", Key) + Case SetupSource.Registry + DeleteReg(Key) + Case Else 'SetupSource.Version + If Version Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本") + DeleteIniKey(Version.Path & "PCL\Setup.ini", Key) + End Select End Sub ''' ''' 获取某个设置项的默认值。 @@ -326,17 +341,34 @@ Public Function GetDefault(Key As String) As String Return SetupDict(Key).DefaultValue End Function + ''' + ''' 某个设置项是否从未被设置过。 + ''' + Public Function IsUnset(Key As String, Optional Version As McVersion = 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.Version + If Version Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本") + Return Not HasIniKey(Version.Path & "PCL\Setup.ini", Key) + End Select + End Function + ''' + ''' 读取设置。 + ''' Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion) Try If Not E.State = 0 Then Exit Sub - Dim SourceValue As String '先用 String 储存，避免类型转换 + 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 Else 'SetupSource.Version + Case SetupSource.Version If Version Is Nothing Then Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本") Else @@ -425,8 +457,20 @@ NetTaskThreadLimit = Value + 1 End Sub Public Sub ToolDownloadCert(Value As Boolean) - Net.ServicePointManager.ServerCertificateValidationCallback = - If(Value, Nothing, New Net.Security.RemoteCertificateValidationCallback(Function() True)) + 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 diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml index 8b692a4..ba28390 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -6,8 +6,8 @@ mc:Ignorable="d" x:Class="PageSetupLaunch" PanScroll="{Binding ElementName=PanBack}"> - - + + @@ -31,10 +31,19 @@ - - - - + + + + + + + + + + + + @@ -45,14 +54,6 @@ - - - - - - - - @@ -90,7 +91,7 @@ + ToolTip="Forge 1.12.2 等个别版本存在 Bug，会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5"> @@ -98,7 +99,7 @@ + ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹，在进行自动选择时 PCL 会尽量优先选择它"> @@ -131,12 +132,12 @@ + ToolTip="根据安装的 Mod 量与电脑剩余内存，动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" /> + ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30" + ToolTip="内存优化能将当前物理内存占用降低约 1/3，不仅限于 MC！ 如果使用机械硬盘，这还可能会导致一小段时间的严重卡顿。 使用 --memory 参数启动 PCL 可以静默执行内存优化。" /> @@ -224,6 +225,7 @@ + @@ -232,29 +234,34 @@ - - + + + + 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" /> - - - - - - - - - + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb index c36c123..d11018b 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb @@ -7,6 +7,11 @@ '重复加载部分 PanBack.ScrollToHome() RefreshRam(False) + If McVersionCurrent Is Nothing Then + BtnSwitch.Visibility = Visibility.Collapsed + Else + BtnSwitch.Visibility = Visibility.Visible + End If '非重复加载部分 If IsLoad Then Exit Sub @@ -32,7 +37,7 @@ '启动参数 TextArgumentTitle.Text = Setup.Get("LaunchArgumentTitle") TextArgumentInfo.Text = Setup.Get("LaunchArgumentInfo") - ComboArgumentIndie.SelectedIndex = Setup.Get("LaunchArgumentIndie") + ComboArgumentIndieV2.SelectedIndex = Setup.Get("LaunchArgumentIndieV2") ComboArgumentVisibie.SelectedIndex = Setup.Get("LaunchArgumentVisible") ComboArgumentPriority.SelectedIndex = Setup.Get("LaunchArgumentPriority") ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType") @@ -50,8 +55,8 @@ TextAdvanceGame.Text = Setup.Get("LaunchAdvanceGame") TextAdvanceRun.Text = Setup.Get("LaunchAdvanceRun") CheckAdvanceRunWait.Checked = Setup.Get("LaunchAdvanceRunWait") - CheckAdvanceAssets.Checked = Setup.Get("LaunchAdvanceAssets") - CheckAdvanceJava.Checked = Setup.Get("LaunchAdvanceJava") + CheckAdvanceDisableJLW.Checked = Setup.Get("LaunchAdvanceDisableJLW") + CheckAdvanceGraphicCard.Checked = Setup.Get("LaunchAdvanceGraphicCard") Catch ex As NullReferenceException Log(ex, "启动设置项存在异常，已被自动重置", LogLevel.Msgbox) @@ -66,7 +71,7 @@ Try Setup.Reset("LaunchArgumentTitle") Setup.Reset("LaunchArgumentInfo") - Setup.Reset("LaunchArgumentIndie") + Setup.Reset("LaunchArgumentIndieV2") Setup.Reset("LaunchArgumentVisible") Setup.Reset("LaunchArgumentWindowType") Setup.Reset("LaunchArgumentWindowWidth") @@ -79,11 +84,10 @@ Setup.Reset("LaunchSkinID") Setup.Reset("LaunchAdvanceJvm") Setup.Reset("LaunchAdvanceGame") - Setup.Reset("LaunchAdvanceJava") - Setup.Reset("LaunchAdvanceAssets") Setup.Reset("LaunchAdvanceRun") Setup.Reset("LaunchAdvanceRunWait") - + Setup.Reset("LaunchAdvanceDisableJLW") + Setup.Reset("LaunchAdvanceGraphicCard") Setup.Reset("LaunchArgumentJavaAll") Setup.Reset("LaunchArgumentJavaSelect") JavaSearchLoader.Start(IsForceRestart:=True) @@ -107,10 +111,10 @@ 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 ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) End Sub - Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change, CheckArgumentRam.Change + 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 @@ -193,7 +197,7 @@ Public Sub RefreshRam(ShowAnim As Boolean) If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Exit Sub '获取内存情况 - Dim RamGame As Double = GetRam(McVersionCurrent, False) + Dim RamGame As Double = Math.Round(GetRam(McVersionCurrent, False), 5) Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5) @@ -207,7 +211,7 @@ ElseIf RamTotal <= 16 Then SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25 Else - SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41) + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33 End If '设置文本 LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" & @@ -396,8 +400,7 @@ PreFin: End If '若使用 32 位 Java，则限制为 1G If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive) - '封顶 32G - Return Math.Min(32, RamGive) + Return RamGive End Function #End Region @@ -414,7 +417,7 @@ PreFin: Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect") Try - For Each Java In Sort(JavaList.Clone(), Function(l, r) l.VersionCode < r.VersionCode) + For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.VersionCode) Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} ToolTipService.SetHorizontalOffset(ListItem, 400) ComboArgumentJava.Items.Add(ListItem) @@ -550,19 +553,10 @@ PreFin: End If End Sub - '版本隔离警告 - Private IsReverting As Boolean = False - Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged + '版本隔离提示 + Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndieV2.SelectionChanged If AniControlEnabled <> 0 Then Exit Sub - If IsReverting Then Exit Sub - If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf & - "如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf & - "如果你不会迁移存档，不建议修改这项设置！", - "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then - IsReverting = True - ComboArgumentIndie.SelectedItem = e.RemovedItems(0) - IsReverting = False - End If + MyMsgBox("默认策略只会对今后新安装的版本生效。" & vbCrLf & "已有版本的隔离策略需要在它的版本设置中调整。") End Sub #End Region @@ -584,4 +578,11 @@ PreFin: #End Region + '切换到版本独立设置 + Private Sub BtnSwitch_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSwitch.Click + McVersionCurrent.Load() + PageVersionLeft.Version = McVersionCurrent + FrmMain.PageChange(FormMain.PageType.VersionSetup, FormMain.PageSubType.VersionSetup) + End Sub + End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml index 795f41e..22a9a63 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml @@ -4,7 +4,7 @@ xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="PageSetupLeft" d:DesignWidth="152" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> - @@ -12,15 +12,16 @@ - + - + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml index 65022e5..c8ea952 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml @@ -36,9 +36,9 @@ ToolTip="设置下载的速度上限，以避免在下载时导致其他需要联网的程序卡死" /> - + ToolTip="开启验证可以提高安全性，但可能会导致正版登录失败（见 #3018）。 若登录因为 “未能为 SSL/TLS 安全通道建立信任关系” 失败，请考虑关闭此选项。" /> @@ -62,13 +62,14 @@ --> - - - - - - + + + + + + + - - -