From e1268cefdb07852408b908c795a42c61684403f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E9=BE=99=E8=85=BE=E7=8C=AB=E8=B7=83?= <1043137532@qq.com> Date: Sat, 25 May 2024 17:42:12 +0800 Subject: [PATCH] 2.7.4 --- Plain Craft Launcher 2/Application.xaml.vb | 1 + Plain Craft Launcher 2/Controls/MyCard.vb | 30 ++- .../Controls/MyListItem.xaml.vb | 4 +- Plain Craft Launcher 2/FormMain.xaml.vb | 111 +++++----- .../Modules/Base/ModBase.vb | 68 +++++- .../Modules/Base/ModLoader.vb | 2 +- Plain Craft Launcher 2/Modules/Base/ModNet.vb | 18 +- .../Modules/Base/ModValidate.vb | 2 +- .../Modules/Minecraft/ModComp.vb | 20 +- .../Modules/Minecraft/ModCrash.vb | 153 ++++++++------ .../Modules/Minecraft/ModJava.vb | 50 +++-- .../Modules/Minecraft/ModLaunch.vb | 200 ++++++++++-------- .../Modules/Minecraft/ModMinecraft.vb | 141 ++++++------ .../Modules/Minecraft/ModMod.vb | 26 +-- .../Modules/Minecraft/ModWatcher.vb | 1 + .../Modules/Minecraft/MyLocalModItem.xaml.vb | 2 + Plain Craft Launcher 2/Modules/ModEvent.vb | 7 +- Plain Craft Launcher 2/Modules/ModMusic.vb | 28 +-- .../My Project/AssemblyInfo.vb | 4 +- .../Pages/PageDownload/ModDownloadLib.vb | 88 ++++---- .../PageDownloadCompDetail.xaml.vb | 4 +- .../PageDownload/PageDownloadInstall.xaml | 41 ++-- .../PageDownload/PageDownloadInstall.xaml.vb | 144 ++++++++----- .../Pages/PageLaunch/FormLoginOAuth.xaml.vb | 2 +- .../Pages/PageLaunch/PageLaunchLeft.xaml.vb | 2 +- .../Pages/PageLaunch/PageLaunchRight.xaml.vb | 26 ++- .../Pages/PageLaunch/PageLoginAuth.xaml.vb | 4 +- .../Pages/PageLaunch/PageLoginLegacy.xaml.vb | 2 +- .../Pages/PageLaunch/PageLoginMs.xaml.vb | 70 +++--- .../Pages/PageLaunch/PageLoginNide.xaml.vb | 4 +- .../Pages/PageSelectLeft.xaml.vb | 4 +- .../Pages/PageSetup/PageSetupLaunch.xaml | 2 +- .../Pages/PageSetup/PageSetupSystem.xaml | 2 +- .../Pages/PageSpeedLeft.xaml.vb | 31 +-- 34 files changed, 768 insertions(+), 526 deletions(-) diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index b9b88a1..32909e7 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -213,6 +213,7 @@ Public Class Application Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) MsJson.Remove(sender.Tag) Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) + If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0 FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent) Case McLoginType.Legacy '离线 diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb index 3f6d66a..11b7669 100644 --- a/Plain Craft Launcher 2/Controls/MyCard.vb +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -13,8 +13,26 @@ MainBorder.Child = value End Set End Property - Public MainTextBlock As TextBlock - Public MainSwap As Shapes.Path + Private _MainTextBlock As TextBlock + Public Property MainTextBlock As TextBlock + Get + Init() '当父级触发 Loaded 时，本卡片可能尚未触发 Loaded（该事件从父级向子级调用），因此这会是 null。手动触发以确保控件已加载。 + Return _MainTextBlock + End Get + Set(value As TextBlock) + _MainTextBlock = value + End Set + End Property + Private _MainSwap As Shapes.Path + Public Property MainSwap As Shapes.Path + Get + Init() + Return _MainSwap + End Get + Set(value As Shapes.Path) + _MainSwap = value + End Set + End Property '属性 Public Uuid As Integer = GetUuid() @@ -24,7 +42,7 @@ End Get Set(value As String) SetValue(TitleProperty, value) - If MainTextBlock IsNot Nothing Then MainTextBlock.Text = value + If _MainTextBlock IsNot Nothing Then MainTextBlock.Text = value End Set End Property Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata("")) @@ -40,10 +58,11 @@ Children.Add(MainGrid) End Sub Private IsLoad As Boolean = False - Private Sub MyCard_Loaded() Handles Me.Loaded + Private Sub Init() Handles Me.Loaded If IsLoad Then Exit Sub + IsLoad = True '初次加载限定 - If Not Title = "" AndAlso IsNothing(MainTextBlock) Then + If Title <> "" AndAlso MainTextBlock Is Nothing Then MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False} MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1") MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay}) @@ -55,7 +74,6 @@ MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1") MainGrid.Children.Add(MainSwap) End If - IsLoad = True '改变默认的折叠 If IsSwaped AndAlso SwapControl IsNot Nothing Then MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0)) diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb index 68866e6..60706f9 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -656,9 +656,9 @@ SetResourceReference(ForegroundProperty, "ColorBrush1") End If ColumnPaddingRight.Width = New GridLength(MinPaddingRight) - If EventType = "打开帮助" Then + If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266 Try - Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) + Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) Catch ex As Exception Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) End Try diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 1278084..2910887 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -108,13 +108,19 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 325 Then 'Snapshot 2.7.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug")) + FeatureCount += 17 + BugCount += 19 + End If If LastVersion < 324 Then 'Snapshot 2.7.3 FeatureCount += 4 BugCount += 3 End If If LastVersion < 322 Then 'Snapshot 2.7.2 FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug")) FeatureCount += 18 @@ -376,44 +382,46 @@ Public Class FormMain AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100), AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), - AaCode(Sub() - PanBack.RenderTransform = Nothing - IsWindowLoadFinished = True - Log($"[System] DPI：{DPI}，系统版本：{OsVersion}，PCL 位置：{PathWithName}") - End Sub, , True) + AaCode( + Sub() + PanBack.RenderTransform = Nothing + IsWindowLoadFinished = True + Log($"[System] DPI：{DPI}，系统版本：{OsVersion}，PCL 位置：{PathWithName}") + End Sub, , True) }, "Form Show") 'Timer 启动 AniStart() TimerMainStart() '加载池 - RunInNewThread(Sub() - 'EULA 提示 - If Not Setup.Get("SystemEula") Then - Select Case MyMsgBox("在使用 PCL 前，请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", + RunInNewThread( + Sub() + 'EULA 提示 + If Not Setup.Get("SystemEula") Then + Select Case MyMsgBox("在使用 PCL 前，请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) - Case 1 - Setup.Set("SystemEula", True) - Case 2 - EndProgram(False) - End Select - End If - '启动加载器池 - Try - JavaListInit() '延后到同意协议后再执行，避免在初次启动时进行进程操作 - Thread.Sleep(200) - DlClientListMojangLoader.Start(1) - RunCountSub() - ServerLoader.Start(1) - Catch ex As Exception - Log(ex, "初始化加载池运行失败", LogLevel.Feedback) - End Try - '清理自动更新文件 - Try - If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe") - Catch ex As Exception - Log(ex, "清理自动更新文件失败") - End Try - End Sub, "Start Loader", ThreadPriority.Lowest) + Case 1 + Setup.Set("SystemEula", True) + Case 2 + EndProgram(False) + End Select + End If + '启动加载器池 + Try + JavaListInit() '延后到同意协议后再执行，避免在初次启动时进行进程操作 + Thread.Sleep(200) + DlClientListMojangLoader.Start(1) + RunCountSub() + ServerLoader.Start(1) + Catch ex As Exception + Log(ex, "初始化加载池运行失败", LogLevel.Feedback) + End Try + '清理自动更新文件 + Try + If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe") + Catch ex As Exception + Log(ex, "清理自动更新文件失败") + End Try + End Sub, "Start Loader", ThreadPriority.Lowest) Log("[Start] 第三阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") End Sub @@ -521,12 +529,13 @@ Public Class FormMain If SendWarning AndAlso HasDownloadingTask() Then If MyMsgBox("还有下载任务尚未完成，是否确定退出？", "提示", "确定", "取消") = 1 Then '强行结束下载任务 - RunInNewThread(Sub() - Log("[System] 正在强行停止任务") - For Each Task As LoaderBase In LoaderTaskbar.ToArray - Task.Abort() - Next - End Sub, "强行停止下载任务") + RunInNewThread( + Sub() + Log("[System] 正在强行停止任务") + For Each Task As LoaderBase In LoaderTaskbar.ToArray + Task.Abort() + Next + End Sub, "强行停止下载任务") Else Exit Sub End If @@ -542,17 +551,19 @@ Public Class FormMain PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})} AniStart({ AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)), - AaDouble(Sub(i) - TransformScale.ScaleX += i - TransformScale.ScaleY += i - End Sub, 0.88 - TransformScale.ScaleX, 180), + AaDouble( + Sub(i) + TransformScale.ScaleX += i + TransformScale.ScaleY += i + End Sub, 0.88 - TransformScale.ScaleX, 180), AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)), - AaCode(Sub() - IsHitTestVisible = False - Top = -10000 - ShowInTaskbar = False - End Sub, 210), + AaCode( + Sub() + IsHitTestVisible = False + Top = -10000 + ShowInTaskbar = False + End Sub, 210), AaCode(AddressOf EndProgramForce, 230) }, "Form Close") Else @@ -800,14 +811,14 @@ Public Class FormMain If FilePathList.Count > 1 Then '必须要求全部为 jar 文件 For Each File In FilePathList - If Not {"jar", "litemod", "disabled", "old"}.Contains(File.Split(".").Last.ToLower) Then + If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then Hint("一次请只拖入一个文件！", HintType.Critical) Exit Sub End If Next End If '自定义主页 - Dim Extension As String = FilePath.Split(".").Last.ToLower + Dim Extension As String = FilePath.After(".").ToLower If Extension = "xaml" Then Log("[System] 文件后缀为 XAML，作为自定义主页加载") If File.Exists(Path & "PCL\Custom.xaml") Then diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 5166a20..e07e1eb 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -11,12 +11,12 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.7.3" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.7.3." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.7.4" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.7.4." & VersionBranchCode '标准格式的四段式版本号 #If BETA Then Public Const VersionCode As Integer = 323 'Release #Else - Public Const VersionCode As Integer = 324 'Snapshot + Public Const VersionCode As Integer = 325 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -1451,7 +1451,8 @@ Re: Try Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local}) Catch ex As Exception - Throw New Exception("格式化 json 对象失败：" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data)) + Dim Length As Integer = If(Data, "").Length + Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data)) End Try End Function @@ -1544,6 +1545,51 @@ Re: Return Input.All(Function(c) AscW(c) < 128) End Function + ''' + ''' 获取在子字符串之前的部分。 + ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。 + ''' + Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase)) + If Pos >= 0 Then + Return Str.Substring(0, Pos) + Else + Return Str + End If + End Function + ''' + ''' 获取在子字符串之后的部分。 + ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。 + ''' + Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase)) + If Pos >= 0 Then + Return Str.Substring(Pos + Text.Length) + Else + Return Str + End If + End Function + ''' + ''' 获取处于两个子字符串之间的部分。 + ''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。 + ''' + Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String + Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase)) + If StartPos >= 0 Then + StartPos += Before.Length + Else + StartPos = 0 + End If + Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase)) + If EndPos >= 0 Then + Return Str.Substring(StartPos, EndPos - StartPos) + ElseIf StartPos > 0 Then + Return Str.Substring(StartPos) + Else + Return Str + End If + End Function + ''' ''' 高速的 StartsWith。 ''' @@ -1573,12 +1619,26 @@ Re: Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) End Function ''' + ''' 高速的 IndexOf。 + ''' + + Public Function IndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer + Return Str.IndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) + End Function + ''' ''' 高速的 LastIndexOf。 ''' Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) End Function + ''' + ''' 高速的 LastIndexOf。 + ''' + + Public Function LastIndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer + Return Str.LastIndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) + End Function ''' ''' 输入 And 字符不会报错的 Val。 diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb index 9c1c573..18ed602 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb @@ -266,7 +266,7 @@ Public Output As OutputType = Nothing '获取输入 - Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType + Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用 If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断 If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index 470597a..de97191 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -781,7 +781,7 @@ RequestFinished: ''' ''' 为不需要分割的小文件进行临时存储。 ''' - Private SmailFileCache As List(Of Byte) + Private SmailFileCache As Queue(Of Byte) ''' ''' 文件的已下载大小。 @@ -1101,7 +1101,7 @@ NotSupportRange: '创建缓存文件 If IsNoSplit Then Info.Temp = Nothing - SmailFileCache = New List(Of Byte) + SmailFileCache = New Queue(Of Byte) Else Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp" ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read) @@ -1152,9 +1152,15 @@ NotSupportRange: Info.DownloadDone += RealDataCount If IsNoSplit Then If HttpData.Count = RealDataCount Then - SmailFileCache.AddRange(HttpData) + 'SmailFileCache.AddRange(HttpData) + For Each B In HttpData + SmailFileCache.Enqueue(B) + Next Else - SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount)) + 'SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount)) + For i = 0 To RealDataCount - 1 + SmailFileCache.Enqueue(HttpData(i)) + Next End If Else ResultStream.Write(HttpData, 0, RealDataCount) @@ -1456,7 +1462,9 @@ Retry: Public Overrides Property Progress As Double Get If State >= LoadState.Finished Then Return 1 - If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了 + SyncLock FilesLock + If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了 + End SyncLock Return _Progress End Get Set(value As Double) diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb index a89dcc3..154e950 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -149,7 +149,7 @@ Public Class ValidateExcept End Sub Public Overrides Function Validate(Str As String) As String For Each Ch As String In Excepts - If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then + If Str.IndexOfF(Ch, True) >= 0 Then If IsNothing(ErrorMessage) Then ErrorMessage = "" Return ErrorMessage.Replace("%", Ch) End If diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index d7b0f10..39dbf53 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -265,7 +265,7 @@ Next CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")). - Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0). + Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList 'Type @@ -342,7 +342,7 @@ '搜索结果的键为 versions，获取特定工程的键为 game_versions GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")). - Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). + Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList 'Type Select Case Data("project_type").ToString @@ -576,9 +576,9 @@ '有中文翻译 '尝试将文本分为三段：Title (EnglishName) - Suffix '检查时注意 Carpet：它没有中文译名，但有 Suffix - Title = TranslatedName.Split(" (").First.Split(" - ").First + Title = TranslatedName.Before(" (").Before(" - ") Dim Suffix As String = "" - If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last + If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ") Dim EnglishName As String = TranslatedName If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) @@ -751,7 +751,7 @@ NoSubtitle: Case CompType.ResourcePack 'FUTURE: Res End Select - Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First) + Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/")) If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText) @@ -772,7 +772,7 @@ NoSubtitle: 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]] Dim Facets As New List(Of String) Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]") - If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]") + If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]") If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") Address += "&facets=[" & String.Join(",", Facets) & "]" @@ -880,7 +880,7 @@ NoSubtitle: If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " " - SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First. + SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - "). Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " " Next Log("[Comp] 中文搜索原始关键词：" & SearchResult, LogLevel.Developer) @@ -1133,7 +1133,7 @@ Retry: '描述性信息 ''' - ''' 文件描述名（并非文件名，是自定义的字段）。 + ''' 文件描述名（并非文件名，是自定义的字段）。对很多 Mod，这会给出 Mod 版本号。 ''' Public DisplayName As String ''' @@ -1305,7 +1305,7 @@ Retry: 'GameVersions Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). - Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList + Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList If GameVersions.Count > 1 Then GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} @@ -1403,7 +1403,7 @@ Retry: '辅助函数 Public Overrides Function ToString() As String - Return $"{Id}: {DisplayName}" + Return $"{Id}: {FileName}" End Function End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 9ab3bb2..ef52547 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -312,16 +312,30 @@ Extracted: End Function ''' - ''' 输出字符串的前后某些行，并统一行尾为 vbLf (\r)、删除空行。 + ''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。 ''' Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String - If Raw.Length <= HeadLines + TailLines Then Return Join(Raw, vbLf) + If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf) + Dim Lines As New List(Of String) + Dim RealHeadLines As Integer = 0, ViewedLines As Integer + For ViewedLines = 0 To Raw.Length - 1 + If Lines.Contains(Raw(ViewedLines)) Then Continue For + RealHeadLines += 1 + Lines.Add(Raw(ViewedLines)) + If RealHeadLines >= HeadLines Then Exit For + Next + Dim RealTailLines = 0 + For i = Raw.Length - 1 To ViewedLines Step -1 + If Lines.Contains(Raw(i)) Then Continue For + RealTailLines += 1 + Lines.Insert(RealHeadLines, Raw(i)) + If RealTailLines >= TailLines Then Exit For + Next Dim Result As New StringBuilder - For i = 0 To Raw.Count - 1 - If i < HeadLines OrElse Raw.Count - i < TailLines Then - If Raw(i) = "" Then Continue For - Result.Append(Raw(i) & vbLf) - End If + For Each Line In Lines + If Line = "" Then Continue For + Result.Append(Line) + Result.Append(vbLf) Next Return Result.ToString End Function @@ -353,6 +367,7 @@ Extracted: 光影或资源包导致OpenGL1282错误 文件或内容校验失败 确定Mod导致游戏崩溃 + 怀疑Mod导致游戏崩溃 Mod配置文件导致游戏崩溃 ModMixin失败 Mod加载器报错 @@ -398,23 +413,21 @@ Extracted: '崩溃日志 If LogCrash IsNot Nothing Then Log("[Crash] 开始进行崩溃日志堆栈分析") - Dim StackLogs As String = LogCrash.Split("System Details").First - Keywords.AddRange(AnalyzeStackKeyword(StackLogs)) + Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details"))) End If 'Minecraft 日志 If LogMc IsNot Nothing Then - Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)") + Dim Fatals As List(Of String) = RegexSearch(LogMc, "/FATAL] .+?(?=[\n]+\[)") + If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper")) Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项") - If Fatals.Any Then - For Each Fatal In Fatals - Keywords.AddRange(AnalyzeStackKeyword(Fatal)) - Next - End If + For Each Fatal In Fatals + Keywords.AddRange(AnalyzeStackKeyword(Fatal)) + Next End If '虚拟机日志 If LogHs IsNot Nothing Then Log("[Crash] 开始进行虚拟机堆栈分析") - Dim StackLogs As String = LogHs.Split("Registers:").First.Split("T H R E A D").Last + Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:") Keywords.AddRange(AnalyzeStackKeyword(StackLogs)) End If 'Mod 名称分析 @@ -502,7 +515,7 @@ Done: If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压) If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失) If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) - If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) + If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足) If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装) If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) @@ -530,6 +543,7 @@ Done: 'Mod 重复安装 If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) + If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) 'Mod 缺少前置 If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then @@ -556,10 +570,10 @@ Done: If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃) + If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容) 'Mod 导致的崩溃 If LogCrash.Contains("-- MOD ") Then - Dim LogLeft = LogCrash.Split("-- MOD").Last - If LogLeft.Contains("Failure message: MISSING") Then + If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray)) Else AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray)) @@ -584,19 +598,9 @@ Done: If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) - End If - - End Sub - ''' - ''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。 - ''' - Private Sub AnalyzeCrit3() - - '游戏日志分析 - If LogMc IsNot Nothing Then 'Mixin 崩溃 If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse - LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then + LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)") @@ -614,6 +618,24 @@ Done: '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) End If + End If + + '崩溃报告分析 + If LogCrash IsNot Nothing Then + If LogCrash.Contains("Suspected Mod") Then + Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+") + If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects)) + End If + End If + + End Sub + ''' + ''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。 + ''' + Private Sub AnalyzeCrit3() + + '游戏日志分析 + If LogMc IsNot Nothing Then '极短的程序输出 If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then AppendReason(CrashReason.极短的程序输出, LogMc) @@ -634,9 +656,13 @@ Done: ''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。 ''' Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String) + ErrorStack = vbLf & If(ErrorStack, "") & vbLf '进行正则匹配 - Dim StackSearchResults As List(Of String) = RegexSearch(If(ErrorStack, "") & vbCrLf, "(?<=\n[^{]+)[a-zA-Z]+\w+\.[a-zA-Z]+[\w\.]+(?=\.[\w\.$]+\.)") + Dim StackSearchResults As New List(Of String) + StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)")) + StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx + StackSearchResults = StackSearchResults.Distinct.ToList '检查堆栈开头 Dim PossibleStacks As New List(Of String) @@ -649,7 +675,7 @@ Done: "MojangTricksIntelDriversForPerformance_javaw"} If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack Next - PossibleStacks.Add(Stack.Trim) '.Split("$").First) + PossibleStacks.Add(Stack.Trim) NextStack: Next PossibleStacks = PossibleStacks.Distinct.ToList @@ -666,13 +692,13 @@ NextStack: For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 Dim Word As String = Splited(i) If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For - If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", - "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", - "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", - "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", - "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", - "fastutil", "optifine", "internal", "platform", "override", - "listeners", "scheduler", "minecraft", "transformers", "universal", "multipart", "minecraftforge", "blockentity" + If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp", + "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task", + "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", + "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", + "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", + "fastutil", "optifine", "internal", "platform", "override", "fabricmc", + "injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill" }.Contains(Word.ToLower) Then Continue For PossibleWords.Add(Word.Trim) Next @@ -712,7 +738,7 @@ NextStack: Details = Details.Replace("Fabric Mods", "¨") Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式") End If - Details = Details.Split("¨").Last + Details = Details.After("¨") '[Forge] 获取所有包含 .jar 的行 '[Fabric] 获取所有包含 Mod 信息的行 @@ -795,13 +821,20 @@ NextStack: End If End Function ''' - ''' 尝试获取 Mod 名称，若失败则返回原关键字。 + ''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。 ''' - Private Function TryAnalyzeModName(Keywords As String) As List(Of String) - Dim RawList As New List(Of String) From {If(Keywords, "")} - If String.IsNullOrEmpty(Keywords) Then Return RawList + Private Function TryAnalyzeModName(Keyword As String) As List(Of String) + Dim RawList As New List(Of String) From {If(Keyword, "")} + If String.IsNullOrEmpty(Keyword) Then Return RawList Return If(AnalyzeModName(RawList), RawList) End Function + ''' + ''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。 + ''' + Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String) + If Not Keywords.Any Then Return Keywords + Return If(AnalyzeModName(Keywords), Keywords) + End Function '4：根据原因输出信息 Private OutputFiles As New List(Of String) @@ -814,7 +847,7 @@ NextStack: Dim ShowLog As Action = Sub() If File.Exists(DirectFile.Value.Key) Then - ShellOnly(DirectFile.Value.Key) + ShellOnly("notepad", DirectFile.Value.Key) Else Dim FilePath As String = PathTemp & "Crash.txt" WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) @@ -911,39 +944,39 @@ NextStack: End If Case CrashReason.堆栈分析发现关键字 If Additional.Count = 1 Then - Results.Add("你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL 找到了一个可疑的关键词：" & Additional.First & "。\n\n如果你知道它对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h") + Results.Add("你的游戏遇到了一些问题，PCL 为此找到了一个可疑的关键词：" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h") Else - Results.Add("你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL 找到了以下可疑的关键词：\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h") + Results.Add("你的游戏遇到了一些问题，PCL 为此找到了以下可疑的关键词：\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h") End If - Case CrashReason.堆栈分析发现Mod名称 + Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃 If Additional.Count = 1 Then - Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h") + Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错，但不能完全确定。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else - Results.Add("可能是以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h") + Results.Add("PCL 怀疑以下 Mod 导致了游戏出错，但不能完全确定：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.确定Mod导致游戏崩溃 If Additional.Count = 1 Then - Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") + Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else - Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h") + Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.ModMixin失败 If Additional.Count = 1 Then - Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着该 Mod 存在 Bug，或与当前环境不兼容。\n\e\h") + Results.Add("名为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else - Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug，或与当前环境不兼容。\n\e\h") + Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.Mod配置文件导致游戏崩溃 If Additional(1) Is Nothing Then - Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") + Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") Else - Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错：\n其配置文件 " & Additional(1) & " 存在异常，无法读取。") + Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错：\n其配置文件 " & Additional(1) & " 存在异常，无法读取。") End If Case CrashReason.Mod初始化失败 If Additional.Count = 1 Then - Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n\e\h") + Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else - Results.Add("以下 Mod 初始化失败，导致游戏无法继续加载：\n - " & Join(Additional, "\n - ") & "\n\e\h") + Results.Add("以下 Mod 初始化失败，导致游戏无法继续加载：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.特定方块导致崩溃 If Additional.Count = 1 Then @@ -1028,8 +1061,6 @@ NextStack: End Select Next - '整理多个原因 - IsHandAnalyze = False Return Join(Results, "\n\n此外，"). Replace("\n", vbCrLf). Replace("\h", ""). @@ -1039,7 +1070,7 @@ NextStack: If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "", vbCrLf & "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。" & If(If(PageSetupSystem.IsLauncherNewest(), True), "", - vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) + vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) End Function End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index e220fca..7767f6b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -1,5 +1,5 @@ Public Module ModJava - Public JavaListCacheVersion As Integer = 5 + Public JavaListCacheVersion As Integer = 6 ''' ''' 目前所有可用的 Java。 @@ -131,7 +131,9 @@ 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 Exception("分析详细信息失败，获取的版本为 " & Version.ToString) + If Version.Minor <= 4 OrElse Version.Minor >= 25 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 If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！") Catch ex As ApplicationException @@ -197,10 +199,15 @@ Setup.Set("LaunchArgumentJavaAll", "[]") End Try End Sub + + ''' + ''' 防止多个需要 Java 的部分同时要求下载 Java（#3797）。 + ''' + Public JavaLock As New Object ''' ''' 根据要求返回最适合的 Java，若找不到则返回 Nothing。 ''' 最小与最大版本在与输入相同时也会通过。 - ''' 必须在工作线程调用。 + ''' 必须在工作线程调用，且必须包括 SyncLock JavaLock。 ''' Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Optional RelatedVersion As McVersion = Nothing) As JavaEntry @@ -460,8 +467,8 @@ NoUserJava: If Not Left.IsJre AndAlso Right.IsJre Then Return False '4. Java 大版本 If Left.VersionCode <> Right.VersionCode Then - ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21... - Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28} + ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23... + Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18} Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode) End If '5. 最次级版本号更接近 51 @@ -601,22 +608,23 @@ NoUserJava: '启动检查线程 Dim CheckThreads As New List(Of Thread) For Each Entry In JavaEntries - Dim CheckThread As New Thread(Sub() - Try - Entry.Check() - If ModeDebug Then Log("[Java] - " & Entry.ToString) - SyncLock ListLock - JavaCheckList.Add(Entry) - End SyncLock - Catch ex As ThreadInterruptedException - Catch ex As Exception - If Entry.IsUserImport Then - Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", LogLevel.Hint) - Else - Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常") - End If - End Try - End Sub) + Dim CheckThread As New Thread( + Sub() + Try + Entry.Check() + If ModeDebug Then Log("[Java] - " & Entry.ToString) + SyncLock ListLock + JavaCheckList.Add(Entry) + End SyncLock + Catch ex As ThreadInterruptedException + Catch ex As Exception + If Entry.IsUserImport Then + Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", LogLevel.Hint) + Else + Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常") + End If + End Try + End Sub) CheckThreads.Add(CheckThread) CheckThread.Start() Next diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 5cc6182..48a8228 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -358,7 +358,7 @@ NextInner: Case McLoginType.Ms If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") Case McLoginType.Legacy - If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨") Case McLoginType.Nide If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") Case McLoginType.Auth @@ -368,7 +368,7 @@ NextInner: If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") - If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨") Return Nothing End Function ''' @@ -524,7 +524,10 @@ Relogin: Dim AccessToken As String = MsLoginStep5(Tokens) Data.Progress = 0.8 If Data.IsAborted Then Throw New ThreadInterruptedException - Dim Result = MsLoginStep6(AccessToken) + MsLoginStep6(AccessToken) + Data.Progress = 0.9 + If Data.IsAborted Then Throw New ThreadInterruptedException + Dim Result = MsLoginStep7(AccessToken) '输出登录结果 Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken) Setup.Set("CacheMsAccess", AccessToken) @@ -540,7 +543,7 @@ Relogin: SkipLogin: McLaunchLog("微软登录完成") Setup.Set("HintBuy", True) '关闭正版购买提示 - Data.Progress = 0.95 + Data.Progress = 0.98 If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示") End Sub Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult)) @@ -797,14 +800,14 @@ LoginFinish: '微软登录步骤 1：打开网页认证，获取 OAuth Code Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String McLaunchLog("开始微软登录步骤 1") - If OsVersion <= New Version(10, 0, 17763, 0) Then + If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849，WebBrowser 已经无法正常加载微软登录网页了 SystemBrowser: 'Windows 7 或老版 Windows 10 登录 OpenWebsite(FormLoginOAuth.LoginUrl1) Dim Result As String = MyMsgBoxInput("等待网页登录", - "在登录成功后，网页会变成一片空白，请将该空白页面的网址复制到下面的框中。" & vbCrLf & - "如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或加速器，然后再试。", + "登录完成后，网页会变得完全空白，把那个空白网页的网址复制到下面的框中就行了！" & vbCrLf & + "如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。", ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX") If Result Is Nothing Then @@ -813,7 +816,7 @@ SystemBrowser: Else Return RegexSeek(Result, "(?<=code\=)[^&]+") End If - Hint("网页登录已完成，你现在可以关闭浏览器上的那个网页了", HintType.Finish) + Hint("网页登录成功，你可以关闭浏览器啦！", HintType.Finish) Else 'Windows 10 登录 Dim ReturnCode As String = Nothing @@ -926,12 +929,18 @@ SystemBrowser: Try Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3) Catch ex As Net.WebException - If ex.Message.Contains("2148916233") Then - If MyMsgBox("该微软账号尚未购买 Minecraft Java 版，或尚未注册 Xbox 账户。" & vbCrLf & - "如果你确定该账号完成了上述步骤，请先在游戏官网登录一次，然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then - OpenWebsite("https://www.minecraft.net/") + '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js + If ex.Message.Contains("2148916227") Then + MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True) + Throw New Exception("$$") + ElseIf ex.Message.Contains("2148916233") Then + If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then + OpenWebsite("https://signup.live.com/signup") End If Throw New Exception("$$") + ElseIf ex.Message.Contains("2148916235") Then + MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请尝试使用加速器或 VPN。", "登录失败", "我知道了") + Throw New Exception("$$") ElseIf ex.Message.Contains("2148916238") Then If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf & "该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then @@ -979,30 +988,46 @@ SystemBrowser: Dim AccessToken As String = ResultJson("access_token").ToString Return AccessToken End Function - '微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} - Private Function MsLoginStep6(AccessToken As String) As String() + '微软登录步骤 6：验证微软账号是否持有 MC，这也会刷新 XGP + Private Sub MsLoginStep6(AccessToken As String) McLaunchLog("开始微软登录步骤 6") + Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) + Try + Dim ResultJson As JObject = GetJson(Result) + If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then + Select Case MyMsgBox("你尚未购买正版 Minecraft，或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消") + Case 1 + OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") + End Select + Throw New Exception("$$") + End If + Catch ex As Exception + Log(ex, "微软登录第 6 步异常：" & Result) + Throw + End Try + End Sub + '微软登录步骤 7：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} + Private Function MsLoginStep7(AccessToken As String) As String() + McLaunchLog("开始微软登录步骤 7") + Dim Result As String Try - NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Catch ex As Net.WebException Dim Message As String = GetExceptionSummary(ex) If Message.Contains("(429)") Then - Log(ex, "微软登录第 6 步汇报 429") + Log(ex, "微软登录第 7 步汇报 429") Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！") ElseIf Message.Contains("(404)") Then - Log(ex, "微软登录第 6 步汇报 404") - RunInNewThread(Sub() - Select Case MyMsgBox("你可能没有创建 Minecraft 玩家档案、Xbox Game Pass 已到期，或者还没有购买 Minecraft。" & vbCrLf & - "如果您确认您已购买 Minecraft 或您的 Xbox Game Pass 未过期，请创建档案，之后即可使用 PCL 登录。", "登录失败", "创建档案", "购买 Minecraft", "取消") - Case 1 - OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile") - Case 2 - OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") - End Select - End Sub, "Login Failed: Create Profile") + Log(ex, "微软登录第 7 步汇报 404") + RunInNewThread( + Sub() + Select Case MyMsgBox("请先创建 Minecraft 玩家档案，然后再重新登录。", "登录失败", "创建档案", "取消") + Case 1 + OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile") + End Select + End Sub, "Login Failed: Create Profile") Throw New Exception("$$") Else Throw @@ -1169,65 +1194,68 @@ SystemBrowser: MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) End If - '选择 Java - McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString) - McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) - If Task.IsAborted Then Exit Sub - If McLaunchJavaSelected IsNot Nothing Then - McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString) - Exit Sub - End If + SyncLock JavaLock - '无合适的 Java - If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java - McLaunchLog("无合适的 Java，需要确认是否自动下载") - Dim JavaCode As String - If 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 - JavaCode = 17 - If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$") - ElseIf MaxVer < New Version(1, 8, 0, 0) Then - JavaCode = 7 - If Not JavaDownloadConfirm("Java 7") Then Throw New Exception("$$") - ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then - JavaCode = "8u101" - If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") - ElseIf MinVer > New Version(1, 8, 0, 100) Then - JavaCode = "8u101" - If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$") - ElseIf MaxVer < New Version(1, 8, 0, 321) Then - JavaCode = 8 - If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$") - Else - JavaCode = 8 - If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$") - End If + '选择 Java + McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString) + McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) + If Task.IsAborted Then Exit Sub + If McLaunchJavaSelected IsNot Nothing Then + McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString) + Exit Sub + End If - '开始自动下载 - Dim JavaLoader = JavaFixLoaders(JavaCode) - Try - JavaLoader.Start(JavaCode, IsForceRestart:=True) - Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted - Task.Progress = JavaLoader.Progress - Thread.Sleep(10) - Loop - Finally - JavaLoader.Abort() '确保取消时中止 Java 下载 - End Try + '无合适的 Java + If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java + McLaunchLog("无合适的 Java，需要确认是否自动下载") + Dim JavaCode As String + If 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 + JavaCode = 17 + If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$") + ElseIf MaxVer < New Version(1, 8, 0, 0) Then + JavaCode = 7 + If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$") + ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then + JavaCode = "8u101" + If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") + ElseIf MinVer > New Version(1, 8, 0, 100) Then + JavaCode = "8u101" + If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$") + ElseIf MaxVer < New Version(1, 8, 0, 321) Then + JavaCode = 8 + If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$") + Else + JavaCode = 8 + If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$") + End If - '检查下载结果 - If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872# - McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) - If Task.IsAborted Then Exit Sub - If McLaunchJavaSelected IsNot Nothing Then - McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString) - Else - Hint("没有可用的 Java，已取消启动！", HintType.Critical) - Throw New Exception("$$") - End If + '开始自动下载 + Dim JavaLoader = JavaFixLoaders(JavaCode) + Try + JavaLoader.Start(JavaCode, IsForceRestart:=True) + Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted + Task.Progress = JavaLoader.Progress + Thread.Sleep(10) + Loop + Finally + JavaLoader.Abort() '确保取消时中止 Java 下载 + End Try + '检查下载结果 + If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872# + McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) + If Task.IsAborted Then Exit Sub + If McLaunchJavaSelected IsNot Nothing Then + McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString) + Else + Hint("没有可用的 Java，已取消启动！", HintType.Critical) + Throw New Exception("$$") + End If + + End SyncLock End Sub #End Region @@ -1342,7 +1370,7 @@ SystemBrowser: If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true" ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理 DataList.Insert(0, ArgumentJvm) '可变 JVM 参数 - DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m") + DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m") DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m") DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """") DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表 @@ -1610,7 +1638,8 @@ NextVersion: GameSize = New Size(875 - 2, 540 - 2) End Select GameSize.Height -= 29.5 * DPI / 96 '标题栏高度 - If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍 + If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso + Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍 GameSize.Width /= DPI / 96 GameSize.Height /= DPI / 96 End If @@ -1809,13 +1838,14 @@ NextVersion: '1.11 ~ 12：zh_cn 时正常，zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文 '1.13+ ：zh_cn 时正常，zh_CN 时自动切换为英文 Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none") - Dim RequiredLang As String = If(CurrentLang = "none", If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower) + Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844，整合包可能已经自带了 options.txt + If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower) If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本（包含 MC 1.1）的 McCodeMain 可能为 -1 '将最后两位改为大写，前面的部分保留 RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper End If If CurrentLang = RequiredLang Then - McLaunchLog($"当前语言为 {CurrentLang}，无需修改") + McLaunchLog($"需要的语言为 {RequiredLang}，当前语言为 {CurrentLang}，无需修改") Else WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改，避免删除后重新下载残留缓存 WriteIni(SetupFileAddress, "lang", RequiredLang) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index b84ee9f..458a42a 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -1,4 +1,6 @@ -Public Module ModMinecraft +Imports System.IO.Compression + +Public Module ModMinecraft #Region "文件夹" @@ -149,7 +151,7 @@ #Region "版本处理" - Public Const McVersionCacheVersion As Integer = 27 + Public Const McVersionCacheVersion As Integer = 29 Private _McVersionCurrent As McVersion Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同，使得 UI 显示可以正常初始化 @@ -391,6 +393,29 @@ _Version.McName = JsonObject("jar").ToString 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 + End If '非准确的版本判断警告 Log("[Minecraft] 无法完全确认 MC 版本号的版本：" & Name) '从文件夹名中获取 @@ -1034,7 +1059,7 @@ ExitDataLoad: Dim Path As String = Loader.Input Try '初始化 - McVersionList.Clear() + McVersionList = New Dictionary(Of McVersionCardType, List(Of McVersion)) '检测缓存是否需要更新 Dim FolderList As New List(Of String) @@ -1075,10 +1100,10 @@ Reload: '改变当前选择的版本 OnLoaded: - If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '不能判断 Count = 0，这在只有错误版本时导致了误判 + If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '尝试读取已储存的选择 Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version") - If Not SavedSelection = "" Then + If SavedSelection <> "" Then For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList For Each Version As McVersion In Card.Value If Version.Name = SavedSelection AndAlso Not Version.State = McVersionState.Error Then @@ -1190,7 +1215,7 @@ OnLoaded: End Try Next - ResultVersionList.Add(CardType, VersionList) + If VersionList.Any Then ResultVersionList.Add(CardType, VersionList) Next Return ResultVersionList Catch ex As Exception @@ -1200,10 +1225,14 @@ OnLoaded: End Function Private Function McVersionListLoadNoCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion)) Dim VersionList As New List(Of McVersion) - Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) + #Region "循环加载每个版本的信息" Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories For Each Folder As DirectoryInfo In Dirs + If Not Folder.EnumerateFiles.Any Then + Log("[Minecraft] 跳过空文件夹：" & Folder.FullName) + Continue For + End If If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then Log("[Minecraft] 跳过可能不是版本文件夹的项目：" & Folder.FullName) Continue For @@ -1223,6 +1252,9 @@ OnLoaded: Version.Load() Next #End Region + + Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) + #Region "将版本分类到各个卡片" Try @@ -1236,7 +1268,7 @@ OnLoaded: Next If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) - '预先筛选出愚人节的版本 + '预先筛选出愚人节和错误的版本 McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error) McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool) @@ -1347,9 +1379,7 @@ OnLoaded: Next If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot) '按版本号排序 - Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left As McVersion, Right As McVersion) - Return Left.Version.McCodeMain > Right.Version.McCodeMain - End Function) + Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain) '回设 If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot) ResultVersionList(McVersionCardType.OriginalLike) = NewList @@ -1357,43 +1387,45 @@ OnLoaded: '不常用版本：按发布时间新旧排序，如果不可用则按名称排序 If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then - ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), 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) - If LeftYear > 2000 AndAlso RightYear > 2000 Then - If LeftYear <> RightYear Then - Return LeftYear > RightYear - Else - Return Left.ReleaseTime > Right.ReleaseTime - End If - ElseIf LeftYear > 2000 AndAlso RightYear < 2000 Then - Return True - ElseIf LeftYear < 2000 AndAlso RightYear > 2000 Then - Return False - Else - Return Left.Name > Right.Name - End If - End Function) + ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), + 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) + If LeftYear > 2000 AndAlso RightYear > 2000 Then + If LeftYear <> RightYear Then + Return LeftYear > RightYear + Else + Return Left.ReleaseTime > Right.ReleaseTime + End If + ElseIf LeftYear > 2000 AndAlso RightYear < 2000 Then + Return True + ElseIf LeftYear < 2000 AndAlso RightYear > 2000 Then + Return False + Else + Return Left.Name > Right.Name + End If + End Function) End If 'API 版本：优先按版本排序，此后【先放 Fabric，再放 Forge（按版本号从高到低排序），最后放 LiteLoader（按名称排序）】 If ResultVersionList.ContainsKey(McVersionCardType.API) Then - ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), Function(Left As McVersion, Right As McVersion) - Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) - If Basic <> 0 Then - Return Basic > 0 - Else - If Left.Version.HasFabric Xor Right.Version.HasFabric Then - Return Left.Version.HasFabric - ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then - Return Left.Version.HasForge - ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then - Return Left.Version.SortCode > Right.Version.SortCode - Else - Return Left.Name > Right.Name - End If - End If - End Function) + ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), + Function(Left As McVersion, Right As McVersion) + Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) + If Basic <> 0 Then + Return Basic > 0 + Else + If Left.Version.HasFabric Xor Right.Version.HasFabric Then + Return Left.Version.HasFabric + ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then + Return Left.Version.HasForge + ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then + Return Left.Version.SortCode > Right.Version.SortCode + Else + Return Left.Name > Right.Name + End If + End If + End Function) End If #End Region @@ -1417,17 +1449,7 @@ OnLoaded: ''' 需要筛选出的版本类型。-2 代表隐藏的版本。 ''' 卡片的名称。 Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), ByRef Target As Dictionary(Of McVersionCardType, List(Of McVersion)), Formula As McVersionState(), CardType As McVersionCardType) - '将某种版本筛选出来 - Dim KeepList As New List(Of McVersion) - For Each Version As McVersion In VersionList - For Each Type As Integer In Formula - If Type = Version.State Then - KeepList.Add(Version) - GoTo NextVersion - End If - Next -NextVersion: - Next + Dim KeepList = VersionList.Where(Function(v) Formula.Contains(v.State)).ToList '加入版本列表，并从剩余中删除 If KeepList.Any Then Target.Add(CardType, KeepList) @@ -1443,13 +1465,8 @@ NextVersion: ''' 需要筛选出的版本类型。-2 代表隐藏的版本。 ''' 传入需要增加入的列表。 Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), Formula As McVersionState(), ByRef KeepList As List(Of McVersion)) - For Each Version As McVersion In VersionList - For Each Type As McVersionState In Formula - If Type <> Version.State Then Continue For - KeepList.Add(Version) : Exit For - Next -NextVersion: - Next + KeepList.AddRange(VersionList.Where(Function(v) Formula.Contains(v.State))) + '加入版本列表，并从剩余中删除 If KeepList.Any Then For Each Version As McVersion In KeepList VersionList.Remove(Version) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 040e9d5..348d3cb 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -887,11 +887,11 @@ Finished: ModList.Add(ModEntry) '读取 Comp 缓存 If ModEntry.State = McMod.McModState.Unavaliable Then Continue For - Dim Hash = ModEntry.ModrinthHash - If Cache.ContainsKey(Hash) Then - ModEntry.FromJson(Cache(Hash)) + Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName + If Cache.ContainsKey(CacheKey) Then + ModEntry.FromJson(Cache(CacheKey)) '如果缓存中的信息在 6 小时以内更新过，则无需重新获取 - If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For + If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For End If ModUpdateList.Add(ModEntry) Next @@ -925,7 +925,7 @@ Finished: End Sub '联网加载 Mod 详情 - Private Const LocalModCacheVersion As Integer = 3 + Private Const LocalModCacheVersion As Integer = 4 Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Dim Mods As List(Of McMod) = Loader.Input.Key @@ -937,7 +937,7 @@ Finished: If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric) If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader) If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt}) - Dim McVersions As New List(Of String) From {TargetMcVersion.McName} + 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 @@ -948,7 +948,7 @@ Finished: 'End If 'McVersions = McVersions.Distinct().ToList() '开始网络获取 - Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersions.Join("/")}") + Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}") Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0 Dim MainThread As Thread = Thread.CurrentThread '从 Modrinth 获取信息 @@ -991,8 +991,8 @@ Finished: Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息") '步骤 4：获取更新信息 Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", - $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"", - ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject) + $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", + ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject) For Each Entry In Mods If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod) @@ -1001,11 +1001,11 @@ Finished: If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For '设置更新日志与更新文件 If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并 - Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}") + Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}") UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源 Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件 ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换 - Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"} + Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"} Entry.UpdateFile = UpdateFile End If Next @@ -1073,7 +1073,7 @@ Finished: For Each IndexEntry In ProjectJson("latestFilesIndexes") If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 Dim IndexVersion As String = IndexEntry("gameVersion") - If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配 + If McVersion <> IndexVersion Then Continue For 'MC 版本匹配 '由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件 If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 If NewestVersion <> IndexVersion Then @@ -1136,7 +1136,7 @@ Finished: If Not Mods.Any() Then Exit Sub For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 Entry.CompLoaded = SucceedThreadCount = 2 - Cache(Entry.ModrinthHash) = Entry.ToJson() + Cache(Entry.ModrinthHash & McVersion) = Entry.ToJson() Next WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) End Sub diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index c4e5c55..9d16fd2 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -348,6 +348,7 @@ '崩溃分析 WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析") Hint("检测到 Minecraft 出现错误，错误分析已开始……") + FeedbackInfo() RunInNewThread(Sub() Try Thread.Sleep(2000) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb index 7b48d21..016f81a 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb @@ -195,6 +195,7 @@ RetryStart: Private Shared Swiping As Boolean = False Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值 Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown + If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除（#3824） '开始滑动 Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me) SwipeStart = Index @@ -204,6 +205,7 @@ RetryStart: FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏 End Sub Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp + If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除（#3824） '结束滑动 If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then Swiping = False diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index dddef07..aa09e79 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -73,8 +73,8 @@ Case "切换页面" FrmMain.PageChange(Val(Data(0)), Val(Data(1))) - Case "导入整合包" - RunInThread(Sub() ModpackInstall()) + Case "导入整合包", "安装整合包" + RunInUi(Sub() ModpackInstall()) Case "下载文件" Data(0) = Data(0).Replace("\", "/") @@ -101,8 +101,7 @@ '网页确认 If RelativeUrl.StartsWithF("http", True) Then If RunInUi() Then - Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息，这会导致程序在网络请求时卡死。" & vbCrLf & - "因此，请换用 MyListItem 以外的控件（例如 MyButton）作为联网帮助页面的入口！") + Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性！") End If '获取文件名 Dim RawFileName As String diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index 860a967..8377aef 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -1,6 +1,4 @@ -Imports System.Security.Cryptography - -Public Module ModMusic +Public Module ModMusic #Region "播放列表" @@ -199,13 +197,15 @@ Public Module ModMusic ''' Public Function MusicPause() As Boolean If MusicState = MusicStates.Play Then - RunInThread(Sub() - MusicNAudio.Pause() - MusicRefreshUI() - Log("[Music] 已暂停播放") - End Sub) + RunInThread( + Sub() + Log("[Music] 已暂停播放") + MusicNAudio?.Pause() + MusicRefreshUI() + End Sub) Return True Else + Log($"[Music] 无需暂停播放，当前状态为 {MusicState}") Return False End If End Function @@ -214,13 +214,15 @@ Public Module ModMusic ''' Public Function MusicResume() As Boolean If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then + Log($"[Music] 无需继续播放，当前状态为 {MusicState}") Return False Else - RunInThread(Sub() - MusicNAudio.Play() - MusicRefreshUI() - Log("[Music] 已恢复播放") - End Sub) + RunInThread( + Sub() + Log("[Music] 已恢复播放") + MusicNAudio?.Play() + MusicRefreshUI() + End Sub) Return True End If End Function diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index 699891c..885e140 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -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 7be4561..3b02dc6 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -384,24 +384,27 @@ Public Module ModDownloadLib End Sub Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean) '选择 Java - Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) - If Java Is Nothing Then - If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。") - '开始自动下载 - Dim JavaLoader = JavaFixLoaders(17) - Try - JavaLoader.Start(17, IsForceRestart:=True) - Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted - Thread.Sleep(10) - Loop - Finally - JavaLoader.Abort() '确保取消时中止 Java 下载 - End Try - '检查下载结果 + Dim Java As JavaEntry + SyncLock JavaLock Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) - If Task.IsAborted Then Exit Sub - If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。") - End If + If Java Is Nothing Then + If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。") + '开始自动下载 + Dim JavaLoader = JavaFixLoaders(17) + Try + JavaLoader.Start(17, IsForceRestart:=True) + Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted + Thread.Sleep(10) + Loop + Finally + JavaLoader.Abort() '确保取消时中止 Java 下载 + End Try + '检查下载结果 + Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) + If Task.IsAborted Then Exit Sub + If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。") + End If + End SyncLock '添加 Java Wrapper 作为主 Jar Dim Arguments As String If UseJavaWrapper Then @@ -1111,24 +1114,27 @@ Retry: Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean) '选择 Java - Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) - If Java Is Nothing Then - If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。") - '开始自动下载 - Dim JavaLoader = JavaFixLoaders(17) - Try - JavaLoader.Start(17, IsForceRestart:=True) - Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted - Thread.Sleep(10) - Loop - Finally - JavaLoader.Abort() '确保取消时中止 Java 下载 - End Try - '检查下载结果 + Dim Java As JavaEntry + SyncLock JavaLock Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) - If Task.IsAborted Then Exit Sub - If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。") - End If + If Java Is Nothing Then + If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。") + '开始自动下载 + Dim JavaLoader = JavaFixLoaders(17) + Try + JavaLoader.Start(17, IsForceRestart:=True) + Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted + Thread.Sleep(10) + Loop + Finally + JavaLoader.Abort() '确保取消时中止 Java 下载 + End Try + '检查下载结果 + Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) + If Task.IsAborted Then Exit Sub + If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。") + End If + End SyncLock '添加 Java Wrapper 作为主 Jar Dim Arguments As String If UseJavaWrapper Then @@ -1275,8 +1281,8 @@ Retry: McFolder = If(McFolder, PathMcFolder) If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then '类似 1.19.3-41.2.8 格式，优先使用 Version 中要求的版本而非 Inherit（例如 1.19.3 却使用了 1.19 的 Forge） - Inherit = Version.Split("-").First - Version = Version.Split("-").Last + Inherit = Version.Before("-") + Version = Version.After("-") End If Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim Id As String = Inherit & "-forge-" & Version @@ -1322,7 +1328,7 @@ Retry: Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) '安装（仅在新版安装时需要原版 Jar） - If Version.Split(".")(0) >= 20 Then + If Version.Before(".") >= 20 Then Log("[Download] 检测为新版 Forge：" & Version) Dim Libs As List(Of McLibToken) = Nothing Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", @@ -1344,7 +1350,7 @@ Retry: Task.Progress = 0.4 Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] - Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0) + Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@") Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")}) @@ -1788,7 +1794,7 @@ Retry: Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem '建立控件 Dim NewItem As New MyListItem With { - .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, + .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Before("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Logo = PathImage & "Blocks/Fabric.png" } @@ -1978,7 +1984,7 @@ Retry: If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) Dim OptiFineFolder As String = Nothing If Request.OptiFineVersion IsNot Nothing Then - If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.Split("_HD_U_").Last '#735 + If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.After("_HD_U_") '#735 Request.OptiFineEntry = New DlOptiFineListEntry With { .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .Inherit = Request.MinecraftName, @@ -2062,7 +2068,7 @@ Retry: End Sub) With {.ProgressWeight = 2, .Block = True}) '补全文件 If Not DontFixLibraries AndAlso - (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Split(".")(0) >= 20) OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then + (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Before(".") >= 20) OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(OutputFolder))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb index 56959a5..1fa91e3 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb @@ -275,7 +275,7 @@ If Project.TranslatedName = Project.RawName Then FileName = File.FileName Else - Dim ChineseName As String = Project.TranslatedName.Split(" (").First.Split(" - ").First. + Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - "). Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：") Select Case Setup.Get("ToolDownloadTranslate") Case 0 @@ -299,7 +299,7 @@ If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If Not Target.Contains("\") Then Exit Sub '构造步骤加载器 - Dim LoaderName As String = Desc & "下载：" & File.DisplayName & " " + Dim LoaderName As String = Desc & "下载：" & GetFileNameWithoutExtentionFromPath(Target) & " " If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target) Dim Loaders As New List(Of LoaderBase) Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True}) diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml index f7333fe..b6b6dc5 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml @@ -20,6 +20,7 @@ + @@ -60,26 +61,6 @@ - - - - - - - - - - - - - - - - - - - @@ -134,6 +115,26 @@ 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" /> + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb index edfd0af..d7ef0bc 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb @@ -305,20 +305,25 @@ LabOptiFine.Foreground = ColorGray1 End If 'LiteLoader - Dim LiteLoaderError As String = LoadLiteLoaderGetError() - CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed) - If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 - SetLiteLoaderInfoShow(CardLiteLoader.IsSwaped) - If SelectedLiteLoader Is Nothing Then - BtnLiteLoaderClear.Visibility = Visibility.Collapsed - ImgLiteLoader.Visibility = Visibility.Collapsed - LabLiteLoader.Text = If(LiteLoaderError, "点击选择") - LabLiteLoader.Foreground = ColorGray4 + If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then + CardLiteLoader.Visibility = Visibility.Collapsed Else - BtnLiteLoaderClear.Visibility = Visibility.Visible - ImgLiteLoader.Visibility = Visibility.Visible - LabLiteLoader.Text = SelectedLiteLoader.Inherit - LabLiteLoader.Foreground = ColorGray1 + CardLiteLoader.Visibility = Visibility.Visible + Dim LiteLoaderError As String = LoadLiteLoaderGetError() + CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 + SetLiteLoaderInfoShow(CardLiteLoader.IsSwaped) + If SelectedLiteLoader Is Nothing Then + BtnLiteLoaderClear.Visibility = Visibility.Collapsed + ImgLiteLoader.Visibility = Visibility.Collapsed + LabLiteLoader.Text = If(LiteLoaderError, "点击选择") + LabLiteLoader.Foreground = ColorGray4 + Else + BtnLiteLoaderClear.Visibility = Visibility.Visible + ImgLiteLoader.Visibility = Visibility.Visible + LabLiteLoader.Text = SelectedLiteLoader.Inherit + LabLiteLoader.Foreground = ColorGray1 + End If End If 'Forge Dim ForgeError As String = LoadForgeGetError() @@ -337,60 +342,85 @@ LabForge.Foreground = ColorGray1 End If 'Fabric - Dim FabricError As String = LoadFabricGetError() - CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) - If FabricError IsNot Nothing Then CardFabric.IsSwaped = True - SetFabricInfoShow(CardFabric.IsSwaped) - If SelectedFabric Is Nothing Then - BtnFabricClear.Visibility = Visibility.Collapsed - ImgFabric.Visibility = Visibility.Collapsed - LabFabric.Text = If(FabricError, "点击选择") - LabFabric.Foreground = ColorGray4 + If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then + CardFabric.Visibility = Visibility.Collapsed Else - BtnFabricClear.Visibility = Visibility.Visible - ImgFabric.Visibility = Visibility.Visible - LabFabric.Text = SelectedFabric.Replace("+build", "") - LabFabric.Foreground = ColorGray1 + CardFabric.Visibility = Visibility.Visible + Dim FabricError As String = LoadFabricGetError() + CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If FabricError IsNot Nothing Then CardFabric.IsSwaped = True + SetFabricInfoShow(CardFabric.IsSwaped) + If SelectedFabric Is Nothing Then + BtnFabricClear.Visibility = Visibility.Collapsed + ImgFabric.Visibility = Visibility.Collapsed + LabFabric.Text = If(FabricError, "点击选择") + LabFabric.Foreground = ColorGray4 + Else + BtnFabricClear.Visibility = Visibility.Visible + ImgFabric.Visibility = Visibility.Visible + LabFabric.Text = SelectedFabric.Replace("+build", "") + LabFabric.Foreground = ColorGray1 + End If End If 'FabricApi - Dim FabricApiError As String = LoadFabricApiGetError() - CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed) - If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True - SetFabricApiInfoShow(CardFabricApi.IsSwaped) - If SelectedFabricApi Is Nothing Then - BtnFabricApiClear.Visibility = Visibility.Collapsed - ImgFabricApi.Visibility = Visibility.Collapsed - LabFabricApi.Text = If(FabricApiError, "点击选择") - LabFabricApi.Foreground = ColorGray4 + If SelectedFabric Is Nothing Then + CardFabricApi.Visibility = Visibility.Collapsed Else - BtnFabricApiClear.Visibility = Visibility.Visible - ImgFabricApi.Visibility = Visibility.Visible - LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim - LabFabricApi.Foreground = ColorGray1 + CardFabricApi.Visibility = Visibility.Visible + Dim FabricApiError As String = LoadFabricApiGetError() + CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True + SetFabricApiInfoShow(CardFabricApi.IsSwaped) + If SelectedFabricApi Is Nothing Then + BtnFabricApiClear.Visibility = Visibility.Collapsed + ImgFabricApi.Visibility = Visibility.Collapsed + LabFabricApi.Text = If(FabricApiError, "点击选择") + LabFabricApi.Foreground = ColorGray4 + Else + BtnFabricApiClear.Visibility = Visibility.Visible + ImgFabricApi.Visibility = Visibility.Visible + LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim + LabFabricApi.Foreground = ColorGray1 + End If End If 'OptiFabric - Dim OptiFabricError As String = LoadOptiFabricGetError() - CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) - If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True - SetOptiFabricInfoShow(CardOptiFabric.IsSwaped) - If SelectedOptiFabric Is Nothing Then - BtnOptiFabricClear.Visibility = Visibility.Collapsed - ImgOptiFabric.Visibility = Visibility.Collapsed - LabOptiFabric.Text = If(OptiFabricError, "点击选择") - LabOptiFabric.Foreground = ColorGray4 + If SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then + CardOptiFabric.Visibility = Visibility.Collapsed Else - BtnOptiFabricClear.Visibility = Visibility.Visible - ImgOptiFabric.Visibility = Visibility.Visible - LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v") - LabOptiFabric.Foreground = ColorGray1 + CardOptiFabric.Visibility = Visibility.Visible + Dim OptiFabricError As String = LoadOptiFabricGetError() + CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True + SetOptiFabricInfoShow(CardOptiFabric.IsSwaped) + If SelectedOptiFabric Is Nothing Then + BtnOptiFabricClear.Visibility = Visibility.Collapsed + ImgOptiFabric.Visibility = Visibility.Collapsed + LabOptiFabric.Text = If(OptiFabricError, "点击选择") + LabOptiFabric.Foreground = ColorGray4 + Else + BtnOptiFabricClear.Visibility = Visibility.Visible + ImgOptiFabric.Visibility = Visibility.Visible + LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v") + LabOptiFabric.Foreground = ColorGray1 + End If End If '主警告 - HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed) + If SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing Then + HintFabricAPI.Visibility = Visibility.Visible + Else + HintFabricAPI.Visibility = Visibility.Collapsed + End If If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then HintOptiFabric.Visibility = Visibility.Visible Else HintOptiFabric.Visibility = Visibility.Collapsed End If + If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso + (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then + HintModOptiFine.Visibility = Visibility.Visible + Else + HintModOptiFine.Visibility = Visibility.Collapsed + End If '结束 IsReloading = False End Sub @@ -632,7 +662,7 @@ Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse (Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX - VersionSortInteger(Forge.Version.Split(".").Last, OptiFine.RequiredForgeVersion) >= 0) + Forge.Version.After(".") >= OptiFine.RequiredForgeVersion) End Function '限制展开 @@ -909,12 +939,12 @@ If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False '直接的判断（例如 1.18.1/22w03a） - For Each Part As String In DisplayName.Split("]")(0).TrimStart("[").Split("/") + For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/") If Part = MinecraftVersion Then Return True Next '将版本名分割语素（例如 1.16.4/5） - Dim Lefts = RegexSearch(DisplayName.Split("]")(0), "[a-z/]+|[0-9/]+") - Dim Rights = RegexSearch(MinecraftVersion.Split("]")(0), "[a-z/]+|[0-9/]+") + Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+") + Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+") '对每段进行判断 Dim i As Integer = 0 While True diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb index 86fd7a5..35cd847 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb @@ -93,7 +93,7 @@ Public Class FormLoginOAuth If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch) FrmMain.Focus() End Sub - Private Sub HintSwitch_Click(sender As Object, e As EventArgs) Handles HintSwitch.Click + Private Sub HintSwitch_Click() Handles HintSwitch.Click IsSwitch = True Close() End Sub diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb index 1cc46fe..c7da13c 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -400,7 +400,7 @@ Finish: ElseIf Setup.Get("LoginLegacyName") = "" Then Return New EqualableList(Of String) From {0, ""} Else - Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Split("¨")(0), "")} + Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")} End If Case 3 Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb index 64d755f..8da1fc5 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -97,6 +97,10 @@ Download: Log("[Page] 主页预设：每日整合包推荐") Url = "https://pclsub.sodamc.com/" GoTo Download + Case 5 + Log("[Page] 主页预设：Minecraft 皮肤推荐") + Url = "https://forgepixel.com/pcl_sub_file" + GoTo Download End Select End Select RunInUi(Sub() LoadContent(Content)) @@ -106,16 +110,17 @@ Download: '联网获取自定义主页文件 Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000} Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer)) + Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化 Try '获取版本校验地址 Dim VersionAddress As String - If Task.Input.Contains(".xaml") Then - VersionAddress = Task.Input.Replace(".xaml", ".xaml.ini") + If Address.Contains(".xaml") Then + VersionAddress = Address.Replace(".xaml", ".xaml.ini") Else - VersionAddress = Task.Input.Split("?").First + VersionAddress = Address.Before("?") If Not VersionAddress.EndsWith("/") Then VersionAddress += "/" VersionAddress += "version" - If Task.Input.Contains("?") Then VersionAddress += Task.Input.Split("?").Last + If Address.Contains("?") Then VersionAddress += Address.After("?") End If '校验版本 Dim Version As String = "" @@ -136,9 +141,9 @@ Download: End Try '实际下载 If NeedDownload Then - Dim FileContent As String = NetGetCodeByRequestRetry(Task.Input) - Log($"[Page] 已联网下载自定义主页，内容长度：{FileContent.Length}，来源：{Task.Input}") - Setup.Set("CacheSavedPageUrl", Task.Input) + Dim FileContent As String = NetGetCodeByRequestRetry(Address) + Log($"[Page] 已联网下载自定义主页，内容长度：{FileContent.Length}，来源：{Address}") + Setup.Set("CacheSavedPageUrl", Address) Setup.Set("CacheSavedPageVersion", Version) WriteFile(PathTemp & "Cache\Custom.xaml", FileContent) End If @@ -146,11 +151,11 @@ Download: Refresh() Catch ex As Exception If Setup.Get("CacheSavedPageVersion") = "" Then - Log(ex, $"联网下载自定义主页失败（{Task.Input}）", LogLevel.Msgbox) + Log(ex, $"联网下载自定义主页失败（{Address}）", LogLevel.Msgbox) Else - Log(ex, $"联网下载自定义主页失败（{Task.Input}）") + Log(ex, $"联网下载自定义主页失败（{Address}）") End If - Task.Input = "" + Address = "" End Try End Sub @@ -208,6 +213,7 @@ Download: GoTo Refresh '防止 SyncLock 死锁 End If End Try + Log($"[Page] 实例化：加载自定义主页 UI 完成") End SyncLock Return Refresh: diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb index 7445bd6..b5422ae 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb @@ -17,8 +17,8 @@ ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Split("¨")(0) - If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(0).Trim + ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨") + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim End If End If IsFirstLoad = False diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb index 7b3f408..0c47882 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb @@ -26,7 +26,7 @@ Public Class PageLoginLegacy ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0).Trim + ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim End If End If IsReloaded = True diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb index dc6b007..4bf92e2 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb @@ -67,39 +67,43 @@ ComboAccounts.IsEnabled = False BtnLogin.IsEnabled = False BtnLogin.Text = "0%" - RunInNewThread(Sub() - Try - McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) - Do While McLoginMsLoader.State = LoadState.Loading - RunInUi(Sub() BtnLogin.Text = Math.Round(McLoginMsLoader.Progress * 100) & "%") - Thread.Sleep(50) - Loop - If McLoginMsLoader.State = LoadState.Finished Then - RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True)) - ElseIf McLoginMsLoader.State = LoadState.Aborted Then - Throw New ThreadInterruptedException - ElseIf McLoginMsLoader.Error Is Nothing Then - Throw New Exception("未知错误！") - Else - Throw New Exception(McLoginMsLoader.Error.Message, McLoginMsLoader.Error) - End If - Catch ex As ThreadInterruptedException - Hint("已取消登录！") - Catch ex As Exception - If ex.Message = "$$" Then - ElseIf ex.Message.StartsWith("$") Then - Hint(ex.Message.TrimStart("$"), HintType.Critical) - Else - Log(ex, "微软登录尝试失败", LogLevel.Msgbox) - End If - Finally - RunInUi(Sub() - ComboAccounts.IsEnabled = True - BtnLogin.IsEnabled = True - BtnLogin.Text = "登录" - End Sub) - End Try - End Sub, "Ms Login") + RunInNewThread( + Sub() + Try + McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) + Do While McLoginMsLoader.State = LoadState.Loading + RunInUi(Sub() BtnLogin.Text = Math.Round(McLoginMsLoader.Progress * 100) & "%") + Thread.Sleep(50) + Loop + If McLoginMsLoader.State = LoadState.Finished Then + RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True)) + ElseIf McLoginMsLoader.State = LoadState.Aborted Then + Throw New ThreadInterruptedException + ElseIf McLoginMsLoader.Error Is Nothing Then + Throw New Exception("未知错误！") + Else + Throw New Exception(McLoginMsLoader.Error.Message, McLoginMsLoader.Error) + End If + Catch ex As ThreadInterruptedException + Hint("已取消登录！") + Catch ex As Exception + If ex.Message = "$$" Then + 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) + Else + Log(ex, "正版登录尝试失败", LogLevel.Msgbox) + End If + Finally + RunInUi( + Sub() + ComboAccounts.IsEnabled = True + BtnLogin.IsEnabled = True + BtnLogin.Text = "登录" + End Sub) + End Try + End Sub, "Ms Login") End Sub End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb index 70a971b..0e327d0 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb @@ -17,8 +17,8 @@ ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginNideEmail").ToString.Split("¨")(0) - If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(0).Trim + ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨") + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim End If End If IsFirstLoad = False diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb index ac127bf..1ef40df 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb @@ -295,7 +295,7 @@ For i = 0 To Folders.Count - 1 If Folders(i) = "" Then Exit For If Folders(i).ToString.EndsWith(Folder.Path) Then - Name = Folders(i).ToString.Split(">")(0) + Name = Folders(i).ToString.Before(">") Folders.RemoveAt(i) Exit For End If @@ -320,7 +320,7 @@ For i = 0 To Folders.Count - 1 If Folders(i) = "" Then Exit For If Folders(i).ToString.EndsWith(Folder.Path) Then - 'Name = Folders(i).ToString.Split(">")(0) + 'Name = Folders(i).ToString.Before(">") Folders.RemoveAt(i) Exit For End If diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml index f4ff7e8..a1957fe 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -81,7 +81,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml index f235841..325c1f6 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml @@ -58,7 +58,7 @@ ToolTip="下载 Mod 时，若该 Mod 支持 Forge 和 Fabric，则显示为支持任意 Mod 加载器。 例如，开启时 JEI 显示支持全版本，关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" /> + ToolTip="验证证书会提高安全性，但疑似有概率导致正版登录失败（#3018）。 如果在正版登录时因为 [根据验证过程，远程证书无效] 失败，可以尝试关闭此项。" /> diff --git a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb index db5f4f2..18c7270 100644 --- a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb @@ -1,4 +1,6 @@ -Public Class PageSpeedLeft +Imports System.Threading.Tasks + +Public Class PageSpeedLeft Private Const WatcherInterval As Integer = 300 '初始化 @@ -59,8 +61,8 @@ If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub Try SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - TaskRefresh(LoaderTaskbar(i)) + For Each Loader In LoaderTaskbar.ToList + TaskRefresh(Loader) Next End SyncLock Catch ex As Exception @@ -110,7 +112,7 @@ #Region "进度不同，更新卡片" Try If Card.Children.Count < LoaderList.Count * 2 Then - Log("刷新下载管理卡片失败：卡片中仅有 " & Card.Children.Count & " 个子项", LogLevel.Debug) + Log($"[Watcher] 刷新下载管理卡片 {Loader.Name} 失败：卡片中仅有 {Card.Children.Count} 个子项，要求至少有 {LoaderList.Count * 2} 个子项", LogLevel.Debug) Exit Try End If Dim Row As Integer = 0 @@ -137,7 +139,7 @@ Row += 1 Next Catch ex As Exception - Log(ex, "刷新下载管理卡片失败", LogLevel.Feedback) + Log(ex, $"刷新下载管理卡片 {Loader.Name} 失败", LogLevel.Feedback) End Try #End Region End Select @@ -191,13 +193,18 @@ '添加取消按钮 Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top} Card.Children.Add(Cancel) - AddHandler Cancel.Click, Sub(sender As MyIconButton, e As EventArgs) - AniDispose(sender, False) - AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) - RightCards.Remove(Loader.Name) - Log($"[Watcher] 关闭下载管理卡片：{Loader.Name}") - RunInThread(Sub() Loader.Abort()) - End Sub + AddHandler Cancel.Click, + Sub(sender As MyIconButton, e As EventArgs) + AniDispose(sender, False) + AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) + RightCards.Remove(Loader.Name) + SyncLock LoaderTaskbarLock + LoaderTaskbar.Remove(Loader) + Log($"[Taskbar] 由于下载管理卡片关闭，{Loader.Name} 已移出任务列表") + End SyncLock + Log($"[Watcher] 关闭下载管理卡片：{Loader.Name}") + RunInThread(Sub() Loader.Abort()) + End Sub '如果已经失败，再刷新一次，修改成失败的控件 If Loader.State = LoadState.Failed Then Card.Tag = Nothing '避免重复导致刷新无效