diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index cb326f9..b5bb048 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -47,9 +47,9 @@ Public Class Application Directory.CreateDirectory(Path & "PCL\Musics") Try Directory.CreateDirectory(PathTemp) - If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限") + If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限") Catch ex As Exception - MyMsgBox("手动设置的缓存文件夹不可用,PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用") + MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用") Setup.Set("SystemSystemCache", "") PathTemp = IO.Path.GetTempPath() & "PCL\" End Try @@ -59,7 +59,7 @@ Public Class Application #If Not DEBUG Then Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2 ") If WindowHwnd <> IntPtr.Zero Then - '将已有的 PCL2 窗口拖出来 + '将已有的 PCL 窗口拖出来 ShowWindowToTop(WindowHwnd) '播放提示音并退出 Beep() @@ -82,7 +82,7 @@ Public Class Application Log("[Start] 程序路径:" & PathWithName) '检测压缩包运行 If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then - MyMsgBox("PCL2 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL2 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True) + MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True) End If '设置初始化 Setup.Load("SystemDebugMode") @@ -104,7 +104,7 @@ Public Class Application #End If AniControlEnabled += 1 Catch ex As Exception - MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL2 初始化错误") + MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL 初始化错误") FormMain.EndProgramForce(Result.Exception) End Try End Sub diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb index cfd6e48..613d747 100644 --- a/Plain Craft Launcher 2/Controls/MyCard.vb +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -134,9 +134,23 @@ FrmDownloadInstall.MinecraftSelected(sender, e) End Sub, False)) Case 8 - Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click)) + If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <> + CType(Stack.Tag, List(Of CompFile)).Count Then + '存在重复的名称(#1344) + Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True)) + Else + '不存在重复的名称,正常加载 + Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click)) + End If Case 9 - Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click)) + If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <> + CType(Stack.Tag, List(Of CompFile)).Count Then + '存在重复的名称(#1344) + Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True)) + Else + '不存在重复的名称,正常加载 + Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click)) + End If Case 10 Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True)) Case 11 diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb index fce2c8d..f3c6e27 100644 --- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb @@ -70,21 +70,33 @@ Public Sub Btn1_Click() Handles Btn1.Click If MyConverter.IsExited Then Exit Sub - MyConverter.IsExited = True - MyConverter.Result = 1 - Close() + If MyConverter.Button1Action IsNot Nothing Then + MyConverter.Button1Action() + Else + MyConverter.IsExited = True + MyConverter.Result = 1 + Close() + End If End Sub Public Sub Btn2_Click() Handles Btn2.Click If MyConverter.IsExited Then Exit Sub - MyConverter.IsExited = True - MyConverter.Result = 2 - Close() + If MyConverter.Button2Action IsNot Nothing Then + MyConverter.Button2Action() + Else + MyConverter.IsExited = True + MyConverter.Result = 2 + Close() + End If End Sub Public Sub Btn3_Click() Handles Btn3.Click If MyConverter.IsExited Then Exit Sub - MyConverter.IsExited = True - MyConverter.Result = 3 - Close() + If MyConverter.Button3Action IsNot Nothing Then + MyConverter.Button3Action() + Else + MyConverter.IsExited = True + MyConverter.Result = 3 + Close() + End If End Sub Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown diff --git a/Plain Craft Launcher 2/Controls/MyPageRight.vb b/Plain Craft Launcher 2/Controls/MyPageRight.vb index ab6c666..32a7ba3 100644 --- a/Plain Craft Launcher 2/Controls/MyPageRight.vb +++ b/Plain Craft Launcher 2/Controls/MyPageRight.vb @@ -65,7 +65,7 @@ Sub() Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置 - Loop + Loop RunInUiWait(Sub() FinishedInvoke(RealLoader)) Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件 End Sub diff --git a/Plain Craft Launcher 2/Controls/MyTextBox.vb b/Plain Craft Launcher 2/Controls/MyTextBox.vb index cc0d35b..d0c6f44 100644 --- a/Plain Craft Launcher 2/Controls/MyTextBox.vb +++ b/Plain Craft Launcher 2/Controls/MyTextBox.vb @@ -86,11 +86,11 @@ ValidateResult = ValidateRule.Validate(Text) If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For Next - Dim NewResult As Integer = If(ValidateResult = "", 0, 1) + Dim NewResult As Boolean = ValidateResult = "" '根据结果改变样式 - If ShownValidateResult <> NewResult Then + If ShownValidateResult <> If(NewResult, 0, 1) Then If IsLoaded AndAlso labWrong IsNot Nothing Then - ChangeValidateResult(ValidateResult = "", True) + ChangeValidateResult(NewResult, True) Else RunInNewThread(Sub() Thread.Sleep(30) @@ -119,10 +119,17 @@ End If End If End Sub + ''' + ''' 强制显示结果为正常,类似尚未输入过文本的状态。不影响实际的检查结果。 + ''' + Public Sub ForceShowAsSuccess() + IsTextChanged = False + ChangeValidateResult(ValidateResult = "", True) + End Sub Private ShownValidateResult As Integer = -1 Private Sub ChangeValidateResult(NewResult As Boolean, IsLoaded As Boolean) - If IsLoaded AndAlso AniControlEnabled = 0 AndAlso IsTextChanged AndAlso labWrong IsNot Nothing Then - If NewResult Then + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso labWrong IsNot Nothing Then + If NewResult OrElse Not IsTextChanged Then '变为正确 ShownValidateResult = 0 AniStart({ @@ -144,23 +151,6 @@ End If Else ShownValidateResult = 3 - 'AniStop("MyTextBox Validate " & Uuid) - 'If NewResult Then - ' '变为正确 - ' labWrong.Opacity = 0 - ' labWrong.Height = 0 - ' labWrong.Visibility = Visibility.Collapsed - 'Else - ' '变为错误 - ' labWrong.Visibility = Visibility.Visible - ' labWrong.Text = ValidateResult - ' labWrong.Opacity = 1 - ' labWrong.Height = 20.5 - 'End If - 'Dim OriginalEnabled As Integer = AniControlEnabled - 'AniControlEnabled += 1 - 'RefreshColor() - 'AniControlEnabled = OriginalEnabled End If RefreshColor() RaiseEvent ValidateChanged(Me, New EventArgs) diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 58a9526..c8d25ce 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -108,7 +108,7 @@ Public Class FormMain End If If LastVersion < 233 Then 'Release 2.2.3 FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "微软账号支持更换皮肤与披风")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL2 进行快捷安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL 进行快捷安装")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 下载支持显示对应的 MC 版本与 Mod 加载器,且可以跳转到 MCBBS 介绍页")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 1.17 OptiFine + Forge")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "使用 Mojang 账号登录将会显示迁移提醒")) @@ -126,6 +126,12 @@ Public Class FormMain '3:BUG+ IMP* FEAT- '2:BUG* IMP- '1:BUG- + If LastVersion < 284 Then 'Snapshot 2.5.1 + If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API")) + FeatureCount += 22 + BugCount += 21 + End If If LastVersion < 283 Then 'Snapshot 2.5.0 FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页")) @@ -146,10 +152,6 @@ Public Class FormMain If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug")) BugCount += 2 End If - If LastVersion < 278 Then 'Snapshot 2.4.7 - If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug")) - BugCount += 2 - End If If LastVersion < 277 Then 'Snapshot 2.4.6 FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮")) FeatureCount += 8 @@ -284,7 +286,7 @@ Public Class FormMain BugCount += 19 End If If LastVersion < 234 Then 'Snapshot 2.2.3 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL2 进行快捷安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL 进行快捷安装")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持安装 1.17 OptiFine + Forge")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod 详情页面支持跳转 MCBBS 介绍页")) FeatureCount += 10 @@ -329,7 +331,7 @@ Public Class FormMain Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ") '输出更新日志 RunInNewThread(Sub() - If MyMsgBox(Content, "PCL2 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then + If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then OpenWebsite("https://afdian.net/a/LTCat?tab=feed") End If End Sub, "UpdateLog Output") @@ -443,15 +445,12 @@ Public Class FormMain '加载池 RunInNewThread(Sub() If Not Setup.Get("SystemEula") Then -Reopen: - Select Case MyMsgBox("在使用 PCL2 前,请同意 PCL2 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明") + Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", + Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) Case 1 Setup.Set("SystemEula", True) Case 2 EndProgram(False) - Case 3 - OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW") - GoTo Reopen End Select End If Try @@ -478,13 +477,13 @@ Reopen: #If Not BETA Then Select Case Setup.Get("SystemCount") Case 1 - MyMsgBox("欢迎使用 PCL2 快照版!" & vbCrLf & + MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf & "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf & "如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明") End Select If Setup.Get("SystemCount") >= 99 Then If ThemeUnlock(6, False) Then - MyMsgBox("你已经使用了 99 次 PCL2 啦,感谢你长期以来的支持!" & vbCrLf & + MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf & "隐藏主题 铁杆粉 已解锁!", "提示") End If End If @@ -521,7 +520,7 @@ Reopen: Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) UnlockedTheme.Remove("13") Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) - MyMsgBox("由于新版 PCL2 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf & + MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf & "多谢各位的理解啦!", "重新解锁提醒") End If '重置滑稽彩 @@ -529,7 +528,7 @@ Reopen: Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) UnlockedTheme.Remove("12") Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) - MyMsgBox("由于新版 PCL2 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf & + MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf & "多谢各位的理解啦!", "重新解锁提醒") End If '移动自定义皮肤 @@ -838,8 +837,23 @@ Reopen: Log("[System] 接受文件拖拽:" & FilePath, LogLevel.Developer) RunInNewThread(Sub() Dim Extension As String = FilePath.Split(".").Last.ToLower + '自定义主页 + If Extension = "xaml" Then + Log("[System] 文件后缀为 XAML,作为自定义主页加载") + If File.Exists(Path & "PCL\Custom.xaml") Then + If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then + Exit Sub + End If + End If + CopyFile(FilePath, Path & "PCL\Custom.xaml") + RunInUi(Sub() + Setup.Set("UiCustomType", 1) + FrmLaunchRight.ForceRefresh() + End Sub) + Exit Sub + End If 'Mod 安装 - If {"jar", "litemod", "disabled"}.Contains(Extension) Then + If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装") '获取并检查目标版本 Dim TargetVersion As McVersion = McVersionCurrent @@ -873,13 +887,13 @@ Install: Exit Sub End If '安装整合包 - If {"zip", "rar", "mrpack"}.Contains(Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 + If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 Log("[System] 文件为压缩包,尝试作为整合包安装") If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub End If 'RAR 处理 If Extension = "rar" Then - Hint("PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!") + Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!") Exit Sub End If '错误报告分析 @@ -895,7 +909,7 @@ Install: Log(ex, "自主错误报告分析失败", LogLevel.Feedback) End Try '未知操作 - Hint("PCL2 无法确定应当执行的文件拖拽操作……") + Hint("PCL 无法确定应当执行的文件拖拽操作……") End Sub, "文件拖拽") End If Catch ex As Exception diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index a98dad5..213a276 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -10,12 +10,12 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.5.0" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.5.0." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.5.1" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.5.1." & VersionBranchCode '标准格式的四段式版本号 #If BETA Then Public Const VersionCode As Integer = 281 'Release #Else - Public Const VersionCode As Integer = 283 'Snapshot + Public Const VersionCode As Integer = 284 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -778,14 +778,10 @@ Public Module ModBase If Not ToPath.Contains(":\") Then ToPath = Path & ToPath '如果复制同一个文件则跳过 If FromPath = ToPath Then Exit Sub - '读取文件内容 - Dim FileBytes As Byte() - Using ReadStream As New FileStream(FromPath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件 - ReDim FileBytes(ReadStream.Length - 1) - ReadStream.Read(FileBytes, 0, ReadStream.Length) - End Using - '写入文件内容 - WriteFile(ToPath, FileBytes) + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(ToPath)) + '复制文件 + File.Copy(FromPath, ToPath, True) Catch ex As Exception Throw New Exception("复制文件出错:" & FromPath & " -> " & ToPath, ex) End Try @@ -1222,7 +1218,7 @@ Re: Try GetJson(Content) Catch ex As Exception - Throw New Exception("不是有效的 Json 文件", ex) + Throw New Exception("不是有效的 json 文件", ex) End Try End If Return Nothing @@ -1355,14 +1351,14 @@ Re: Dim Desc As String = Join(DescList, vbCrLf & "→ ") Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "") - '常见错误 + '常见错误(记得同时修改下面的) Dim CommonReason As String = Nothing If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" + CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then - CommonReason = "PCL2 的权限不足。请尝试右键 PCL2,选择以管理员身份运行。" + CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。" ElseIf TypeOf InnerEx Is OutOfMemoryException Then - CommonReason = "你的电脑运行内存不足,导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。" + CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。" @@ -1399,18 +1395,19 @@ Re: Ex = Ex.InnerException Loop DescList = DescList.Distinct.ToList - - '常见错误 Dim Desc As String = Join(DescList, vbCrLf & "→ ") + + '常见错误(记得同时修改上面的) Dim CommonReason As String = Nothing If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" + CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then - CommonReason = "PCL2 的权限不足。请尝试右键 PCL2,选择以管理员身份运行。" + CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。" ElseIf TypeOf InnerEx Is OutOfMemoryException Then - CommonReason = "你的电脑运行内存不足,导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。" - ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then - CommonReason = "你的网络环境不佳,导致难以连接到服务器。请重试,或尝试使用 VPN。" + CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" + ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", + "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then + CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。" End If '构造输出信息 @@ -1459,7 +1456,7 @@ 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)) + Throw New Exception("格式化 json 对象失败:" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data)) End Try End Function @@ -2042,7 +2039,8 @@ NextElement: Catch ex As Exception Log(ex, "无法打开网页(" & Url & ")") ClipboardSet(Url, False) - MyMsgBox("可能由于浏览器未正确配置,PCL2 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。", "无法打开网页") + MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf & + $"网址:{Url}", "无法打开网页") End Try End Sub ''' @@ -2299,7 +2297,7 @@ Retry: File.Create(Path & "PCL\Log1.txt").Dispose() Catch ex As IOException IsInitSuccess = False - Hint("可能同时开启了多个 PCL2,程序可能会出现未知问题!", HintType.Critical) + Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical) Log(ex, "日志初始化失败(疑似文件占用问题)") Catch ex As Exception IsInitSuccess = False @@ -2386,14 +2384,14 @@ Retry: If CanFeedback(False) Then If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True) Else - MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True) + MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True) End If Case LogLevel.Assert Dim Time As Long = GetTimeTick() If CanFeedback(False) Then If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True) Else - MsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title) + MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title) End If If GetTimeTick() - Time < 1500 Then '弹窗无法保留 @@ -2455,14 +2453,14 @@ Retry: If CanFeedback(False) Then If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True) Else - MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True) + MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True) End If Case LogLevel.Assert Dim Time As Long = GetTimeTick() If CanFeedback(False) Then If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True) Else - MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title) + MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title) End If If GetTimeTick() - Time < 1500 Then '弹窗无法保留 @@ -2486,7 +2484,7 @@ Retry: End Sub Public Function CanFeedback(ShowHint As Boolean) As Boolean If False.Equals(PageSetupSystem.IsLauncherNewest) Then - If ShowHint Then MyMsgBox("你的 PCL2 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈") + If ShowHint Then MyMsgBox("你的 PCL 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈") Return False Else Return True diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index b8d33ae..a534f2b 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -961,7 +961,7 @@ Capture: Next '是否禁用多线程,以及规定碎片大小 Dim TargetUrl As String = GetSource().Url - If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("mcer.cn") Then Return False + If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") Then Return False Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit) '寻找最大碎片 Dim FilePieceMax As NetThread = Threads diff --git a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb index 12e78cc..e9e74f3 100644 --- a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb +++ b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb @@ -107,32 +107,28 @@ Public Class MyBitmap ''' ''' 旋转角度(单位为角度)。 Public Function Rotation(angle As Double) As System.Drawing.Bitmap - With Me - Dim img As System.Drawing.Image = Me.Pic - Dim bitSize As Single = img.Width - Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize)) - Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) - g.TranslateTransform(bitSize / 2, bitSize / 2) - g.RotateTransform(angle) - g.TranslateTransform(-bitSize / 2, -bitSize / 2) - g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width)) - End Using - Return bmp - End With + Dim img As System.Drawing.Image = Me.Pic + Dim bitSize As Single = img.Width + Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize)) + Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) + g.TranslateTransform(bitSize / 2, bitSize / 2) + g.RotateTransform(angle) + g.TranslateTransform(-bitSize / 2, -bitSize / 2) + g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width)) + End Using + Return bmp End Function ''' ''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。 ''' Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap - With Me - Dim img As System.Drawing.Image = Pic - Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height) - Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) - g.DrawImageUnscaled(img, rect) - End Using - Return bmp - End With + Dim img As System.Drawing.Image = Pic + Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height) + Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) + g.DrawImageUnscaled(img, rect) + End Using + Return bmp End Function ''' diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index 5eb980e..e88b429 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -225,7 +225,7 @@ RawName = Data("name") Description = Data("summary") Website = Data("links")("websiteUrl").ToString.TrimEnd("/") - LastUpdate = Data("dateModified") + LastUpdate = Data("dateReleased") '#1194 DownloadCount = Data("downloadCount") 'Logo If Data("logo").Count > 0 Then @@ -302,6 +302,7 @@ ModLoaders = New List(Of CompModLoaderType) For Each File In If(Data("latestFiles"), {}) Dim NewFile As New CompFile(File, Type) + If Not NewFile.Available Then Continue For ModLoaders.AddRange(NewFile.ModLoaders) Next ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList @@ -414,9 +415,9 @@ Dim NewItem As New MyCompItem With {.Tag = Me} NewItem.LabTitle.Text = TranslatedName NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "") - NewItem.LabLeft.Text = If(ModeDebug, If(FromCurseForge, "[CurseForge] ", "[Modrinth] "), "") & - (If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "] ", "") & + NewItem.LabLeft.Text = (If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "] ", "") & If(ShowMcVersionDesc, GameVersionDescription, "")).Replace("] [", " ") & + If(FromCurseForge, "[CurseForge] ", "[Modrinth] ") & Join(Tags, ",") & If(LastUpdate IsNot Nothing, " (" & GetTimeSpanString(LastUpdate - Date.Now) & "更新)", "") If LogoUrl Is Nothing Then @@ -439,6 +440,7 @@ ''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。 ''' Public Function IsLike(Project As CompProject) As Boolean + If Id = Project.Id Then Return True '相同实例 '提取字符串中的字母和数字 Dim GetRaw = Function(Data As String) As String @@ -448,12 +450,17 @@ Next Return Result.ToString.ToLower End Function - '具体的检查 - '精准匹配:相同实例 或 MCMOD 指定的相同内容 - '模糊匹配:支持的 Mod 加载器一致,且 (原名、描述文本或 Slug 的英文部分相同) - If Id = Project.Id OrElse TranslatedName = Project.TranslatedName OrElse '精准匹配 - ((RawName = Project.RawName OrElse Description = Project.Description OrElse GetRaw(Slug) = GetRaw(Project.Slug)) AndAlso - ModLoaders.Count = Project.ModLoaders.Count AndAlso ModLoaders.Except(Project.ModLoaders).Count = 0) Then '模糊匹配 + '来自不同的网站 + If FromCurseForge = Project.FromCurseForge Then Return False + 'Mod 加载器一致 + If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False + 'MC 版本一致 + If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False + 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 + If TranslatedName = Project.TranslatedName OrElse + RawName = Project.RawName OrElse Description = Project.Description OrElse + GetRaw(Slug) = GetRaw(Project.Slug) Then + Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程") '如果只有一个有 DatabaseEntry,设置给另外一个 If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry @@ -809,8 +816,9 @@ Retry: #Region "提取非重复项,存储于 RealResults" - '将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同 - RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList + '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同 + '这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高) + RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList 'RawResults 去重 RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b)) '已有内容去重 @@ -939,11 +947,18 @@ Retry: End Property '下载信息 - + ''' + ''' 下载信息是否可用。 + ''' + Public ReadOnly Property Available As Boolean + Get + Return FileName IsNot Nothing + End Get + End Property ''' ''' 下载的文件名。 ''' - Public ReadOnly FileName As String + Public ReadOnly FileName As String = Nothing ''' ''' 文件所有可能的下载源。 ''' @@ -1022,8 +1037,11 @@ Retry: ReleaseDate = Data("date_published") Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) DownloadCount = Data("downloads") - FileName = Data("files")(0)("filename") - DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, Net.WebUtility.UrlEncode(FileName))} + '可能为空 + If CType(Data("files"), JArray).Count > 0 Then + FileName = Data("files")(0)("filename") + DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, Net.WebUtility.UrlEncode(FileName))} + End If 'Dependencies If Type = CompType.Mod Then RawDependencies = Data("dependencies"). @@ -1058,15 +1076,15 @@ Retry: ''' ''' 将当前文件信息实例化为控件。 ''' - Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing) As MyListItem + Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing, + Optional BadDisplayName As Boolean = False) As MyListItem '获取描述信息 Dim Info As String = "" Select Case Type Case CompType.Mod - Info += If(ModLoaders.Count > 0, Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/"), "") & - If(GameVersions.Count > 1 AndAlso GameVersions.Count < 10, If(ModLoaders.Count > 0, " ", "") & Join(GameVersions, "、").Replace("-snapshot", " 快照"), "") - If Info <> "" Then Info = "适用于 " & Info & "," + Info += If(ModLoaders.Count > 0, + "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "") Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "") Case CompType.ModPack If GameVersions.All(Function(v) v.Contains("w")) Then @@ -1081,7 +1099,8 @@ Retry: '建立控件 Dim NewItem As New MyListItem With { - .Title = DisplayName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, + .Title = If(BadDisplayName, FileName, DisplayName), + .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, .Info = Info } Select Case Status @@ -1153,7 +1172,8 @@ Retry: 'Modrinth ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True) End If - CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).ToList + CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). + Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330) '获取前置 Mod 列表 If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId) Dim Deps As List(Of String) = CompFilesCache(ProjectId). diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index fd5ae5e..75429ec 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -29,7 +29,7 @@ ''' ''' 将可用于分析的日志存储到 AnalyzeRawFiles。 ''' - ''' 从 PCL2 捕获到的最后 200 行程序输出。 + ''' 从 PCL 捕获到的最后 200 行程序输出。 Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing) Log("[Crash] 步骤 1:收集日志文件") @@ -178,7 +178,7 @@ FileName = "游戏崩溃前的输出.txt" OrElse FileName = "rawoutput.log" Then TargetType = AnalyzeFileType.MinecraftLog If DirectFile Is Nothing Then DirectFile = LogFile - ElseIf FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "log1.txt" Then + ElseIf FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "PCL 启动器日志.txt" OrElse FileName = "log1.txt" Then If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then TargetType = AnalyzeFileType.MinecraftLog If DirectFile Is Nothing Then DirectFile = LogFile @@ -243,7 +243,7 @@ Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志") Next '选择一份最佳的来自启动器的游戏日志 - For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt"} + For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"} If FileNameDict.ContainsKey(FileName) Then Dim CurrentLog = FileNameDict(FileName) '截取 “以下为游戏输出的最后一段内容” 后的内容 @@ -253,12 +253,12 @@ LogMc += Line & vbLf ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then HasLauncherMark = True - Log("[Crash] 找到 PCL2 输出的游戏实时日志头") + Log("[Crash] 找到 PCL 输出的游戏实时日志头") End If Next '导入后 500 行 If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500) - LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) & vbLf & "[" '路径包含中文且存在编码问题导致找不到或无法加载主类的末端检测 + LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为启动器日志") Exit For End If @@ -267,7 +267,7 @@ For Each FileName As String In {"latest.log", "latest log.txt", "debug.log", "debug log.txt"} If FileNameDict.ContainsKey(FileName) Then Dim CurrentLog = FileNameDict(FileName) - LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500) & vbLf & "[" + LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500) Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft 日志") Exit For End If @@ -331,7 +331,7 @@ Java版本过高 Java版本不兼容 显卡驱动不支持导致无法设置像素格式 - 路径包含中文且存在编码问题导致找不到或无法加载主类 + 极短的程序输出 Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-32606 AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-31618 Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION @@ -464,6 +464,7 @@ Done: If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK) If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK) If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容) + If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.(net.minecraft.resources.ResourceLocation, ") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.(int[], int, net.minecraft.core.Direction, net.minecraft.client.renderer.texture.TextureAtlasSprite, boolean, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.addRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9) @@ -478,8 +479,6 @@ Done: 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错误) If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) - If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(vbCrLf)) - If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足) If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界) If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容) @@ -495,21 +494,24 @@ Done: 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("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) - '找不到或无法加载主类 - If (RegexCheck(LogMc, "^[^\n.]+.\w+.[^\n]+\n\[$") OrElse RegexCheck(LogMc, "^\[[^\]]+\] [^\n.]+.\w+.[^\n]+\n\[")) AndAlso - Not (LogMc.Contains("at net.") OrElse LogMc.Contains("/INFO]")) AndAlso - LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 500 Then - AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类) - End If 'Mod 导致的崩溃 If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.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)") + If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )") + If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback )[^./ ]+(?=.mixins.json:)") + If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback mixins.)[^./ ]+(?=.json:)") AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray))) End If - If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray))) + If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray))) + '仅当没有其他分析结果时显示 + If CrashReasons.Count = 0 Then + If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf)) + If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) + End If End If '虚拟机日志分析 @@ -552,9 +554,13 @@ Done: '游戏日志分析 If LogMc IsNot Nothing Then - If LogMc.Contains("]: Warnings were found!") Then AppendReason(CrashReason.Fabric报错, If(RegexSeek(LogMc, "(?<=\]: Warnings were found! ?[\n]+)[\w\W]+?(?=[\n]+\[)"), "").Trim(vbCrLf.ToCharArray)) + 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) + End If 'Mixin 失败可以导致大量 Mod 实例创建失败 If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf))) + '注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报 End If '崩溃报告分析 @@ -600,12 +606,12 @@ NextStack: For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 Dim Word As String = Splited(i) If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For - If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", + 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", - "forge", "setup", "block", "model", "mixin", "event", "unimi", - "common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github", "recipe", + "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", + "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", - "fastutil", "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity" + "fastutil", "optifine", "scheduler", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity" }.Contains(Word.ToLower) Then Continue For PossibleWords.Add(Word.Trim) Next @@ -663,7 +669,7 @@ NextStack: For Each ModString As String In ModNameLines Dim RealModString As String = ModString.ToLower.Replace("_", "") If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For - If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") Then Continue For + If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For HintLines.Add(ModString.Trim(vbCrLf.ToCharArray)) Exit For Next @@ -696,7 +702,7 @@ NextStack: ''' 尝试获取 Mod 名称,若失败则返回原关键字。 ''' Private Function TryAnalyzeModName(Keywords As String) As List(Of String) - Dim RawList As New List(Of String) From {Keywords} + Dim RawList As New List(Of String) From {If(Keywords, "")} If String.IsNullOrEmpty(Keywords) Then Return RawList Return If(AnalyzeModName(RawList), RawList) End Function @@ -709,10 +715,8 @@ NextStack: Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) '弹窗提示 FrmMain.ShowWindowToTop() -Redo: - Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), - "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告")) - Case 2 + Dim ShowLog As Action = + Sub() If File.Exists(DirectFile.Value.Key) Then ShellOnly(DirectFile.Value.Key) Else @@ -720,7 +724,10 @@ Redo: WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) ShellOnly(FilePath) End If - GoTo Redo + End Sub + Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), + "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), + Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog)) Case 3 Dim FileAddress As String = Nothing Try @@ -740,7 +747,7 @@ Redo: Case "LatestLaunch.bat" FileName = "启动脚本.bat" Case "Log1.txt" - FileName = "PCL2 启动器日志.txt" + FileName = "PCL 启动器日志.txt" Case "RawOutput.log" FileName = "游戏崩溃前的输出.txt" End Select @@ -764,157 +771,161 @@ Redo: ''' Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String - '非一个结果的处理 - Dim ResultString As String + '没有结果的处理 If CrashReasons.Count = 0 Then If IsHandAnalyze Then - Return "很抱歉,PCL2 无法确定错误原因。" + Return "很抱歉,PCL 无法确定错误原因。" Else Return "很抱歉,你的游戏出现了一些问题……" & vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf & "你也可以查看错误报告,其中可能会有出错的原因。" End If - ElseIf CrashReasons.Count >= 2 Then - Hint("错误分析时发现数个可能的原因,窗口中仅显示了第一条,你可以在启动器日志中检查更多可能的原因!", HintType.Finish) End If '根据不同原因判断 - Dim Additional As List(Of String) = CrashReasons.First.Value - Select Case CrashReasons.First.Key - Case CrashReason.Mod文件被解压 - ResultString = "由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。" - Case CrashReason.内存不足 - ResultString = "Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h" - Case CrashReason.使用OpenJ9 - ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。" - Case CrashReason.使用JDK - ResultString = "游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。" - Case CrashReason.Java版本过高 - ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。" - Case CrashReason.Java版本不兼容 - ResultString = "游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。" - Case CrashReason.使用32位Java导致JVM无法分配足够多的内存 - If Environment.Is64BitOperatingSystem Then - ResultString = "你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。" - Else - ResultString = "你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h" - End If - Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字 - If Additional.Count = 1 Then - ResultString = "你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL2 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h" - Else - ResultString = "你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL2 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h" - End If - Case CrashReason.崩溃日志堆栈分析发现Mod名称 - If Additional.Count = 1 Then - ResultString = "名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h" - Else - ResultString = "可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h" - End If - Case CrashReason.确定Mod导致游戏崩溃 - If Additional.Count = 1 Then - ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h" - Else - ResultString = "以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h" - End If - Case CrashReason.ModMixin失败 - If Additional.Count = 1 Then - ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着该 Mod 存在 Bug,或与当前环境不兼容。\n\e\h" - Else - ResultString = "以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h" - End If - Case CrashReason.Mod配置文件导致游戏崩溃 - If Additional(1) Is Nothing Then - ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h" - Else - ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。" - End If - Case CrashReason.Mod初始化失败 - If Additional.Count = 1 Then - ResultString = "名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h" - Else - ResultString = "以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\e\h" - End If - Case CrashReason.特定方块导致崩溃 - If Additional.Count = 1 Then - ResultString = "游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h" - Else - ResultString = "游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h" - End If - Case CrashReason.Mod重复安装 - If Additional.Count >= 2 Then - ResultString = "你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。" - Else - ResultString = "你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h" - End If - Case CrashReason.特定实体导致崩溃 - If Additional.Count = 1 Then - ResultString = "游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h" - Else - ResultString = "游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h" - End If - Case CrashReason.OptiFine与Forge不兼容 - ResultString = "由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。\n经测试,Forge 版本过高或过低都可能导致崩溃。" - Case CrashReason.低版本Forge与高版本Java不兼容 - ResultString = "由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java" - Case CrashReason.版本Json中存在多个Forge - ResultString = "可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。" - Case CrashReason.玩家手动触发调试崩溃 - ResultString = "* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?" - Case CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类 - ResultString = "由于游戏路径含有中文字符,且 Java 或系统编码存在错误,导致游戏无法运行。\n\n解决这一问题的最简单方法是检查游戏的完整路径,并删除各个文件夹名中的中文字符。\n这包括了游戏的版本名、它所处的 .minecraft 文件夹及其之前的文件夹名。\h" - Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world - ResultString = "你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现,你可以尝试更换 OptiFine 的版本。\h" - Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL - If LogAll.Contains("hd graphics ") Then - ResultString = "你的显卡驱动存在问题,或未使用独立显卡,导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡,请使用独立显卡而非 Intel 核显启动 PCL2 与 Minecraft。\n如果问题依然存在,请尝试升级你的显卡驱动到最新版本,或回退到出厂版本。\n如果还是不行,还可以尝试使用 8.0.51 或更低版本的 Java。\h" - Else - ResultString = "你的显卡驱动存在问题,导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本,或回退到出厂版本,然后再启动游戏。\n如果还是不行,可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在,那么你可能需要换个更好的显卡……\h" - End If - Case CrashReason.材质过大或显卡配置不足 - ResultString = "你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h" - Case CrashReason.光影或资源包导致OpenGL1282错误 - ResultString = "你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h" - Case CrashReason.Mod过多导致超出ID限制 - ResultString = "你所安装的 Mod 过多,超出了游戏的 ID 限制,导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod,或删除部分大型 Mod。" - Case CrashReason.文件或内容校验失败 - ResultString = "部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h" - Case CrashReason.Fabric报错 - If Additional.Count = 1 Then - ResultString = "Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。" - Else - ResultString = "Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h" - End If - Case CrashReason.Mod加载器报错 - If Additional.Count = 1 Then - ResultString = "Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。" - Else - ResultString = "Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h" - End If - Case CrashReason.Fabric报错并给出解决方案 - If Additional.Count = 1 Then - ResultString = "Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。" - Else - ResultString = "Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h" - End If - Case CrashReason.Forge报错 - If Additional.Count = 1 Then - ResultString = "Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。" - Else - ResultString = "Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h" - End If - Case CrashReason.没有可用的分析文件 - ResultString = "你的游戏出现了一些问题,但 PCL2 未能找到相关记录文件,因此无法进行分析。\h" - Case Else - ResultString = "PCL2 获取到了没有详细信息的错误原因(" & CrashReasons.First.Key & "),请向 PCL2 作者提交反馈以获取详情。\h" - End Select + Dim Results As New List(Of String) + For Each Reason In CrashReasons + Dim Additional As List(Of String) = Reason.Value + Select Case Reason.Key + Case CrashReason.Mod文件被解压 + Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。") + Case CrashReason.内存不足 + Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h") + Case CrashReason.使用OpenJ9 + Results.Add("游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。") + Case CrashReason.使用JDK + Results.Add("游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。") + Case CrashReason.Java版本过高 + Results.Add("游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。") + Case CrashReason.Java版本不兼容 + Results.Add("游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。") + Case CrashReason.使用32位Java导致JVM无法分配足够多的内存 + If Environment.Is64BitOperatingSystem Then + Results.Add("你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。") + Else + Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h") + End If + Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字 + If Additional.Count = 1 Then + Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") + Else + Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") + End If + Case CrashReason.崩溃日志堆栈分析发现Mod名称 + If Additional.Count = 1 Then + Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h") + Else + Results.Add("可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h") + End If + Case CrashReason.确定Mod导致游戏崩溃 + If Additional.Count = 1 Then + Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") + Else + Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\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") + Else + Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h") + End If + Case CrashReason.Mod配置文件导致游戏崩溃 + If Additional(1) Is Nothing Then + Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") + Else + Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。") + End If + Case CrashReason.Mod初始化失败 + If Additional.Count = 1 Then + Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h") + Else + Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\e\h") + End If + Case CrashReason.特定方块导致崩溃 + If Additional.Count = 1 Then + Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h") + Else + Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h") + End If + Case CrashReason.Mod重复安装 + If Additional.Count >= 2 Then + Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。") + Else + Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h") + End If + Case CrashReason.特定实体导致崩溃 + If Additional.Count = 1 Then + Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h") + Else + Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h") + End If + Case CrashReason.OptiFine与Forge不兼容 + Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。") + Case CrashReason.低版本Forge与高版本Java不兼容 + Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java") + Case CrashReason.版本Json中存在多个Forge + Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。") + Case CrashReason.玩家手动触发调试崩溃 + Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?") + Case CrashReason.极短的程序输出 + Results.Add($"程序返回了以下信息:\n{Additional.First}\n\h") + Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world + Results.Add("你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现,你可以尝试更换 OptiFine 的版本。\h") + Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL + If LogAll.Contains("hd graphics ") Then + Results.Add("你的显卡驱动存在问题,或未使用独立显卡,导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡,请使用独立显卡而非 Intel 核显启动 PCL 与 Minecraft。\n如果问题依然存在,请尝试升级你的显卡驱动到最新版本,或回退到出厂版本。\n如果还是不行,还可以尝试使用 8.0.51 或更低版本的 Java。\h") + Else + Results.Add("你的显卡驱动存在问题,导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本,或回退到出厂版本,然后再启动游戏。\n如果还是不行,可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在,那么你可能需要换个更好的显卡……\h") + End If + Case CrashReason.材质过大或显卡配置不足 + Results.Add("你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h") + Case CrashReason.光影或资源包导致OpenGL1282错误 + Results.Add("你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h") + Case CrashReason.Mod过多导致超出ID限制 + Results.Add("你所安装的 Mod 过多,超出了游戏的 ID 限制,导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod,或删除部分大型 Mod。") + Case CrashReason.文件或内容校验失败 + Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h") + Case CrashReason.Fabric报错 + If Additional.Count = 1 Then + Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") + Else + Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") + End If + Case CrashReason.Mod加载器报错 + If Additional.Count = 1 Then + Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") + Else + Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") + End If + Case CrashReason.Fabric报错并给出解决方案 + If Additional.Count = 1 Then + Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") + Else + Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") + End If + Case CrashReason.Forge报错 + If Additional.Count = 1 Then + Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") + Else + Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") + End If + Case CrashReason.没有可用的分析文件 + Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h") + Case Else + Results.Add("PCL 获取到了没有详细信息的错误原因(" & CrashReasons.First.Key & "),请向 PCL 作者提交反馈以获取详情。\h") + End Select + Next - ResultString = ResultString. - Replace("\n", vbCrLf). - Replace("\h", If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。")). - Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). - Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf) - Return ResultString.Trim(vbCrLf.ToCharArray) + '整理多个原因 + IsHandAnalyze = False + Return Join(Results, "\n\n此外,"). + Replace("\n", vbCrLf). + Replace("\h", ""). + Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). + Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf). + Trim(vbCrLf.ToCharArray) & + If(Results.Any(Function(r) r.EndsWith("\h")), + If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。"), "") End Function End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index 576195c..1367161 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -13,7 +13,7 @@ Loop '检查 Json 是否标准 If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then - Throw New Exception("底层版本 " & Version.Name & " 中无 Jar 文件下载信息") + Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息") End If '检查文件 Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1")) @@ -211,7 +211,7 @@ Try Dim Versions As JArray = Json("versions") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") - '添加 PCL2 特供项 + '添加 PCL 特供项 If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) '返回 Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json} @@ -244,7 +244,7 @@ Try Dim Versions As JArray = Json("versions") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") - '添加 PCL2 特供项 + '添加 PCL 特供项 If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) '返回 Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json} @@ -274,10 +274,10 @@ Return Version("url").ToString End If Next - Log("未发现版本 " & Id & " 的 Json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug) + Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug) Return Nothing Catch ex As Exception - Log(ex, "获取版本 " & Id & " 的 Json 下载地址失败") + Log(ex, "获取版本 " & Id & " 的 json 下载地址失败") Return Nothing End Try End Function @@ -977,7 +977,7 @@ End Function Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String() - If MojangBase Is Nothing Then Throw New Exception("无对应的 Json 下载地址") + If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址") If IsStatic Then Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"), MojangBase, diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 0b1a90d..c056fc4 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -181,12 +181,6 @@ NextInner: RunInUiWait(Sub() Dim LoginInput As McLoginData = McLoginInput() CheckResult = McLoginAble(LoginInput) - If CheckResult = "" AndAlso - LoginInput.Type = McLoginType.Legacy AndAlso '离线登录 - Not RegexCheck(CType(LoginInput, McLoginLegacy).UserName, "^[0-9A-Za-z_]+$") AndAlso - McVersionCurrent.Version.McCodeMain >= 18 Then 'MC 1.18 以上 - CheckResult = "玩家名只能由数字、英文和下划线组成,不能包含中文或特殊字符!" - End If End Sub) If CheckResult <> "" Then Throw New ArgumentException(CheckResult) '求赞助 @@ -194,8 +188,8 @@ NextInner: RunInNewThread(Sub() Select Case Setup.Get("SystemLaunchCount") Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000 - If MyMsgBox("PCL2 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf & - "如果觉得 PCL2 还算好用的话,也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf & + If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf & + "如果觉得 PCL 还算好用的话,也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf & "毕竟一个人开发也不容易(小声)……", "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then OpenWebsite("https://afdian.net/a/LTCat/plan") @@ -928,7 +922,7 @@ SystemBrowser: Try Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1) Catch ex As Exception - If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then 'Fix Hex-Dragon/PCL2#269 + If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269 Return {"Relogin", ""} Else Throw @@ -988,11 +982,11 @@ SystemBrowser: "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then OpenWebsite("https://account.live.com/editprof.aspx") MyMsgBox("请在打开的网页中修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf & - "在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示") + "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示") Else OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a") MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf & - "在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示") + "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示") End If Throw New Exception("$$") Else @@ -1373,7 +1367,7 @@ SystemBrowser: '添加 MainClass If Version.JsonObject("mainClass") Is Nothing Then - Throw New Exception("版本 Json 中没有 mainClass 项!") + Throw New Exception("版本 json 中没有 mainClass 项!") Else DataList.Add(Version.JsonObject("mainClass")) End If @@ -1461,7 +1455,7 @@ NextVersion: '添加 MainClass If Version.JsonObject("mainClass") Is Nothing Then - Throw New Exception("版本 Json 中没有 mainClass 项!") + Throw New Exception("版本 json 中没有 mainClass 项!") Else Result += " " & Version.JsonObject("mainClass").ToString End If @@ -1579,7 +1573,7 @@ NextVersion: GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives") GameArguments.Add("${library_directory}", PathMcFolder & "libraries") GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries") - GameArguments.Add("${launcher_name}", "PCL2") + GameArguments.Add("${launcher_name}", "PCL") GameArguments.Add("${launcher_version}", VersionCode) GameArguments.Add("${version_name}", Version.Name) Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent) @@ -1837,19 +1831,20 @@ NextVersion: PackFormat = 9 End If Case 19, 99 '99 是快照版 - If McVersionCurrent.Version.McCodeSub <= 2 Then - PackFormat = 9 + If McVersionCurrent.Version.McCodeSub <= 3 Then + PackFormat = 10 Else PackFormat = 12 End If Case Else PackFormat = 13 + 'https://minecraft.fandom.com/zh/wiki/数据包#数据包版本 End Select McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat) '准备文件 Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png") Bit.Save(PackPicAddress) - WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL2 自定义离线皮肤资源包""}}") + WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}") Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png") If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪") @@ -1861,7 +1856,24 @@ NextVersion: Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create) ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta") ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png") - ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png")) + '1.19.3+ 使用复杂版本的替换 + Dim IsOldType As Boolean + Select Case McVersionCurrent.Version.McCodeMain + Case Is < 19 + IsOldType = True + Case 19 + IsOldType = McVersionCurrent.Version.McCodeSub <= 2 + Case Else + IsOldType = False + End Select + If IsOldType Then + ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png")) + Else + For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"} + ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", + $"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png") + Next + End If End Using End Using File.Delete(Path & "PCL\CustomSkin_Cliped.png") @@ -1917,8 +1929,10 @@ IgnoreCustomSkin: Private Sub McLaunchCustom(Loader As LoaderTask(Of Integer, Integer)) '获取自定义命令 - Dim CustomCommand As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent) - If CustomCommand <> "" Then CustomCommand = ArgumentReplace(CustomCommand) + Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun") + If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal) + Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent) + If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion) '输出 bat Try @@ -1928,7 +1942,8 @@ IgnoreCustomSkin: "echo 游戏正在启动,请稍候。" & vbCrLf & "set APPDATA=""" & PathMcFolder & """" & vbCrLf & "cd /D """ & PathMcFolder & """" & vbCrLf & - CustomCommand & vbCrLf & + CustomCommandGlobal & vbCrLf & + CustomCommandVersion & vbCrLf & """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & "echo 游戏已退出。" & vbCrLf & "pause" @@ -1947,23 +1962,52 @@ IgnoreCustomSkin: End Try '执行自定义命令 - If CustomCommand <> "" Then - McLaunchLog("正在执行自定义命令:" & CustomCommand) + If CustomCommandGlobal <> "" Then + McLaunchLog("正在执行全局自定义命令:" & CustomCommandGlobal) + Dim CustomProcess As New Process Try - Dim Cmd As New Process - Cmd.StartInfo.FileName = "cmd.exe" - Cmd.StartInfo.Arguments = "/c """ & CustomCommand & """" - Cmd.StartInfo.WorkingDirectory = Path - Cmd.StartInfo.UseShellExecute = False - Cmd.StartInfo.CreateNoWindow = True - Cmd.Start() - If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then - Do Until Cmd.HasExited OrElse Loader.IsAborted + CustomProcess.StartInfo.FileName = "cmd.exe" + CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """" + CustomProcess.StartInfo.WorkingDirectory = Path + CustomProcess.StartInfo.UseShellExecute = False + CustomProcess.StartInfo.CreateNoWindow = True + CustomProcess.Start() + If Setup.Get("LaunchAdvanceRunWait") Then + Do Until CustomProcess.HasExited OrElse Loader.IsAborted Thread.Sleep(10) Loop End If Catch ex As Exception - Log(ex, "执行自定义命令失败", LogLevel.Hint) + Log(ex, "执行全局自定义命令失败", LogLevel.Hint) + Finally + If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then + McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183 + CustomProcess.Kill() + End If + End Try + End If + If CustomCommandVersion <> "" Then + McLaunchLog("正在执行版本自定义命令:" & CustomCommandVersion) + Dim CustomProcess As New Process + Try + CustomProcess.StartInfo.FileName = "cmd.exe" + CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """" + CustomProcess.StartInfo.WorkingDirectory = Path + CustomProcess.StartInfo.UseShellExecute = False + CustomProcess.StartInfo.CreateNoWindow = True + CustomProcess.Start() + If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then + Do Until CustomProcess.HasExited OrElse Loader.IsAborted + Thread.Sleep(10) + Loop + End If + Catch ex As Exception + Log(ex, "执行版本自定义命令失败", LogLevel.Hint) + Finally + If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then + McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183 + CustomProcess.Kill() + End If End Try End If @@ -2020,7 +2064,7 @@ IgnoreCustomSkin: '输出信息 McLaunchLog("") McLaunchLog("~ 基础参数 ~") - McLaunchLog("PCL2 版本:" & VersionDisplayName & " (" & VersionCode & ")") + McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")") McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")") McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent)) McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion)) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index c629c63..9e8e894 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -6,7 +6,7 @@ Public Module ModMinecraft '列表初始化 - Public JavaListCacheVersion As Integer = 2 + Public JavaListCacheVersion As Integer = 3 ''' ''' 目前所有可用的 Java。 ''' @@ -46,12 +46,23 @@ Public Module ModMinecraft ''' Private ReadOnly Property PathEnv As String Get - If _PathEnv Is Nothing Then _PathEnv = Environment.GetEnvironmentVariable("Path") + If _PathEnv Is Nothing Then _PathEnv = If(Environment.GetEnvironmentVariable("Path"), "") Return _PathEnv End Get End Property Private _PathEnv As String = Nothing + ''' + ''' JAVA_HOME 环境变量。 + ''' + Private ReadOnly Property PathJavaHome As String + Get + If _PathJavaHome Is Nothing Then _PathJavaHome = If(Environment.GetEnvironmentVariable("JAVA_HOME"), "") + Return _PathJavaHome + End Get + End Property + Private _PathJavaHome As String = Nothing + Public Class JavaEntry '路径 @@ -216,8 +227,9 @@ Public Module ModMinecraft #Region "模糊查找可能可用的 Java" '查找环境变量中的 Java - For Each PathInEnv As String In Split(PathEnv.Replace("\\", "\").Replace("/", "\"), ";") + For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";") PathInEnv = PathInEnv.Trim(" """.ToCharArray()) + If PathInEnv = "" Then Continue For If Not PathInEnv.EndsWith("\") Then PathInEnv += "\" '粗略检查有效性 If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False @@ -235,7 +247,7 @@ Public Module ModMinecraft JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True) End If - '若[不全]为符号链接,则清除符号链接的地址 + '若不全为符号链接,则清除符号链接的地址 Dim JavaWithoutReparse As New Dictionary(Of String, Boolean) For Each Pair In JavaPreList Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\") @@ -252,14 +264,14 @@ Public Module ModMinecraft Next If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse - '若不全为 javapath_target,则清除二重引用的地址 + '若不全为特殊引用,则清除特殊引用的地址 Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) For Each Pair In JavaPreList - If Pair.Key.Contains("javapath_target_") Then - Log("[Java] 位于 " & Pair.Key & " 的 Java 包含二重引用") + If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then + Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用") Continue For End If - Log("[Java] 位于 " & Pair.Key & " 的 Java 不含二重引用") + Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用") JavaWithoutInherit.Add(Pair.Key, Pair.Value) Next If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit @@ -508,6 +520,9 @@ RetryGet: '指定的 Java 不可用,弹窗要求选择 Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString) + For Each Java In AllowedJavaList + Log($"[Java] 实际可用的 Java:{Java.ToString}") + Next Dim Requirement As String = "" Dim ShowRevision As Boolean = False If (MinVersion Is Nothing OrElse MinVersion.Minor = 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 999) Then @@ -529,12 +544,12 @@ RetryGet: AllowedJavaList = New List(Of JavaEntry) From {UserJava} Else Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf & - "如果强制使用该 Java,可能会导致出现异常。" & vbCrLf & - "你可以将 游戏 Java 设置修改为 自动选择合适的 Java 来避免这一提示。" & vbCrLf & + "如果强制使用该 Java,可能导致游戏崩溃。" & vbCrLf & + "你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf & vbCrLf & " - 指定的 Java:" & UserJava.ToString, - "Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java", "取消") - Case 1 '让 PCL2 自动选择 + "Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消") + Case 1 '让 PCL 自动选择 Case 2 '强制使用指定的 Java Log("[Java] 已强制使用用户指定的不兼容 Java") AllowedJavaList = New List(Of JavaEntry) From {UserJava} @@ -662,8 +677,8 @@ NoUserJava: Public Sub JavaMissing(VersionCode As Integer) Select Case VersionCode Case 7 - MyMsgBox("PCL2 未找到 Java 7。" & vbCrLf & - "请自行百度安装 Java 7,安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", + MyMsgBox("PCL 未找到 Java 7。" & vbCrLf & + "请自行百度安装 Java 7,安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", "未找到 Java") Case 8 '291 If Is32BitSystem Then @@ -671,17 +686,17 @@ NoUserJava: Else OpenWebsite("https://wwa.lanzoui.com/i2UyMq0jaqb") End If - MyMsgBox("PCL2 未找到版本适宜的 Java 8。" & vbCrLf & - "请在打开的网页中下载安装包并安装,安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", + MyMsgBox("PCL 未找到版本适宜的 Java 8。" & vbCrLf & + "请在打开的网页中下载安装包并安装,安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", "未找到 Java") Case 16, 17 If Is32BitSystem Then MyMsgBox("该版本的 MC 已不支持 32 位操作系统。你必须增加内存并重装为 64 位系统才能继续。", "系统兼容性提示") Else OpenWebsite("https://www.oracle.com/java/technologies/downloads/#java17") - MyMsgBox("PCL2 未找到 Java 17。" & vbCrLf & + MyMsgBox("PCL 未找到 Java 17。" & vbCrLf & "请在打开的网页中选择 x64 Installer,下载并安装。" & vbCrLf & - "安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", + "安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。", "未找到 Java") End If End Select @@ -812,15 +827,15 @@ NoUserJava: Dim ResultJson As String = "{ ""profiles"": { - ""PCL2"": { + ""PCL"": { ""icon"": ""Grass"", - ""name"": ""PCL2"", + ""name"": ""PCL"", ""lastVersionId"": ""latest-release"", ""type"": ""latest-release"", ""lastUsed"": """ & Date.Now.ToString("yyyy-MM-dd") & "T" & Date.Now.ToString("HH:mm:ss") & ".0000Z"" } }, - ""selectedProfile"": ""PCL2"", + ""selectedProfile"": ""PCL"", ""clientToken"": ""23323323323323323323323323323333"" }" WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030")) @@ -1136,21 +1151,21 @@ VersionSearchFinish: Public Property JsonText As String Get If _JsonText Is Nothing Then - If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 Json 文件:" & Path & Name & ".json") + If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json") _JsonText = ReadFile(Path & Name & ".json") '如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试 If _JsonText.Length = 0 Then If RunInUi() Then - Log("[Minecraft] 版本 Json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug) + Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug) Throw New Exception("版本 Json 文件为空或读取失败") Else - Log("[Minecraft] 版本 Json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug) + Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug) Thread.Sleep(2000) _JsonText = ReadFile(Path & Name & ".json") - If _JsonText.Length = 0 Then Throw New Exception("版本 Json 文件为空或读取失败") + If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败") End If End If - If _JsonText.Length < 100 Then Throw New Exception("版本 Json 文件有误,内容为:" & _JsonText) + If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText) End If Return _JsonText End Get @@ -1222,10 +1237,10 @@ Recheck: GoTo Recheck End If Catch ex As Exception - Log(ex, "合并版本依赖项 Json 失败(" & If(InheritVersion, "null").ToString & ")") + Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")") End Try Catch ex As Exception - Throw New Exception("版本 Json 不规范(" & If(Name, "null") & ")", ex) + Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex) End Try Try '处理 JumpLoader @@ -1317,7 +1332,7 @@ Recheck: CheckPermissionWithException(Path & "PCL\") Catch ex As Exception State = McVersionState.Error - Info = "PCL2 没有对该文件夹的访问权限,请右键以管理员身份运行 PCL2" + Info = "PCL 没有对该文件夹的访问权限,请右键以管理员身份运行 PCL" Log(ex, "没有访问版本文件夹的权限") Return False End Try @@ -1325,7 +1340,7 @@ Recheck: Try Dim JsonObjCheck = JsonObject Catch ex As Exception - Log(ex, "版本 Json 可用性检查失败(" & Path & ")") + Log(ex, "版本 json 可用性检查失败(" & Path & ")") JsonText = "" JsonObject = Nothing Info = ex.Message @@ -1747,11 +1762,7 @@ Reload: '改变当前选择的版本 OnLoaded: - If McVersionList.Count = 0 Then - McVersionCurrent = Nothing - Setup.Set("LaunchVersionSelect", "") - Log("[Minecraft] 未找到可用 Minecraft 版本") - Else + If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '不能判断 Count = 0,这在只有错误版本时导致了误判 '尝试读取已储存的选择 Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version") If Not SavedSelection = "" Then @@ -1773,6 +1784,10 @@ OnLoaded: Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) Log("[Launch] 自动选择 Minecraft 版本:" & McVersionCurrent.Path) End If + Else + McVersionCurrent = Nothing + Setup.Set("LaunchVersionSelect", "") + Log("[Minecraft] 未找到可用 Minecraft 版本") End If If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000)) Catch ex As ThreadInterruptedException @@ -2131,27 +2146,16 @@ NextVersion: ''' ''' 要求玩家选择一个皮肤文件,并进行相关校验。 ''' - Public Function McSkinSelect(MustHaveTwoLayers As Boolean) As McSkinInfo + Public Function McSkinSelect() As McSkinInfo Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件") '验证有效性 If FileName = "" Then Return New McSkinInfo With {.IsVaild = False} Try Dim Image As New MyBitmap(FileName) - If MustHaveTwoLayers Then - If Image.Pic.Width = 64 AndAlso Image.Pic.Height = 32 Then - Hint("自定义离线皮肤只支持 64x64 像素的双层皮肤!", HintType.Critical) - Return New McSkinInfo With {.IsVaild = False} - End If - If Image.Pic.Width <> 64 OrElse Image.Pic.Height <> 64 Then - Hint("自定义离线皮肤图片大小应为 64x64 像素!", HintType.Critical) - Return New McSkinInfo With {.IsVaild = False} - End If - Else - If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then - Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Critical) - Return New McSkinInfo With {.IsVaild = False} - End If + If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then + Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Critical) + Return New McSkinInfo With {.IsVaild = False} End If Dim FileInfo As New FileInfo(FileName) If FileInfo.Length > 24 * 1024 Then @@ -2403,7 +2407,7 @@ NextVersion: '不能调用 RealVersion.Check(),可能会莫名其妙地触发 CheckPermission 正被另一进程使用,导致误判前置不存在 If Not File.Exists(RealVersion.Path & RealVersion.Name & ".json") Then RealVersion = Version - Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & ",找不到对应的 Json 文件", LogLevel.Debug) + Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & ",找不到对应的 json 文件", LogLevel.Debug) End If '获取详细下载信息 If RealVersion.JsonObject("downloads") IsNot Nothing AndAlso RealVersion.JsonObject("downloads")("client") IsNot Nothing Then @@ -2545,7 +2549,7 @@ NextVersion: Dim MainJar As NetFile = DlClientJarGet(Version, True) If MainJar IsNot Nothing Then Result.Add(MainJar) Catch ex As Exception - Log(ex, "版本缺失主 Jar 文件所必须的信息", LogLevel.Developer) + Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer) End Try If CoreJarOnly Then Return Result @@ -3116,7 +3120,7 @@ NextVersion: If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空") Catch ex As UnauthorizedAccessException Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer) - _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL2", ex) + _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex) Jar = Nothing Catch ex As Exception Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer) @@ -3751,27 +3755,15 @@ VersionFindFail: '进行提示 If Version Is Nothing Then Exit Sub Dim Time As Date = Version("releaseTime") - Dim MsgResult As Integer - If (Date.Now - Time).TotalDays > 1 Then - '1 天以上 - MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新时间:" & Time.ToString, "Minecraft 更新提示", "下载", "更新日志", "取消") - ElseIf (Date.Now - Time).TotalHours > 3 Then - '1 天 ~ 3 小时 - MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新于:" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "更新日志", "取消") - Else - '不到 3 小时 - MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新于:" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "取消") - If MsgResult = 2 Then MsgResult = 3 '把 “取消” 移位 - End If + Dim MsgBoxText As String = $"新版本:{VersionName}{vbCrLf}" & + If((Date.Now - Time).TotalDays > 1, "更新时间:" & Time.ToString, "更新于:" & GetTimeSpanString(Time - Date.Now)) + Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""), + Button3Action:=Sub() McUpdateLogShow(Version)) '弹窗结果 - Select Case MsgResult - Case 1 - '下载 - McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, VersionName, Version("url").ToString) - Case 2 - '更新日志 - McUpdateLogShow(Version) - End Select + If MsgResult = 2 Then + '下载 + McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, VersionName, Version("url").ToString) + End If Catch ex As Exception Log(ex, "Minecraft 更新提示发送失败(" & If(VersionName, "Nothing") & ")", LogLevel.Feedback) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index fe23ef2..399d0b7 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -60,7 +60,7 @@ Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Return False ElseIf File.ToLower.EndsWith(".rar") Then - Log(ex, "PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) + Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Return False Else Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) @@ -263,8 +263,10 @@ Retry: IsResourcePack = False End If '实际的添加 - FileList.Add(ModJson("id"), New CompFile(ModJson, CompType.Mod).ToNetFile( - PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\")) + Dim File As New CompFile(ModJson, CompType.Mod) + If Not File.Available Then Continue For + FileList.Add(ModJson("id"), + File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\")) Task.Progress += 1 / (1 + ModFileList.Count) Next Task.Output = FileList.Values.ToList @@ -358,7 +360,7 @@ Retry: Select Case Entry.Name.ToLower Case "minecraft" MinecraftVersion = Entry.Value.ToString - Case "forge" 'eg. 14.23.5.2859 + Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0 ForgeVersion = Entry.Value.ToString Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion) Case "fabric-loader" 'eg. 0.14.14 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index 72cb75c..2e28628 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -206,7 +206,7 @@ 'Log(Text) '关闭与崩溃检测 If Not Text.Contains("[CHAT]") Then - If Text.Contains("Someone is closing me!") Then + If Text.Contains("Someone is closing me!") OrElse Text.Contains("Restarting Minecraft with command") Then '#1258 WatcherLog("识别为关闭的 Log:" & Text) State = MinecraftState.Ended ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index 5e02778..9c19995 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -64,13 +64,13 @@ Case "下载文件" Data(0) = Data(0).Replace("\", "/") If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then - MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL2 不支持其他乱七八糟的协议。", "事件执行失败") + MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的协议。", "事件执行失败") Exit Sub End If PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0))) Case Else - MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL2 是否为最新版本。", "事件执行失败") + MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败") End Select Catch ex As Exception Log(ex, "事件执行失败", LogLevel.Msgbox) @@ -121,6 +121,7 @@ '确认实际路径 Dim Location As String, WorkingDir As String = Path & "PCL" + HelpTryExtract() If RelativeUrl.Contains(":\") Then '绝对路径 Location = RelativeUrl diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index 677edc0..dc64b69 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -265,9 +265,9 @@ If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress) Catch ex As Exception If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then - Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL2 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) + Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then - Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL2 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) + Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) Else Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint) End If diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index 3b27ac5..aa4a463 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 8d3bb4b..9e40572 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -37,7 +37,7 @@ Public Module ModDownloadLib '已有版本检查 If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return Nothing - If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 与 Jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 与 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then File.Delete(VersionFolder & Id & ".jar") File.Delete(VersionFolder & Id & ".json") Else @@ -82,14 +82,14 @@ Public Module ModDownloadLib Dim Loaders As New List(Of LoaderBase) '下载版本 Json 文件 - Loaders.Add(New LoaderDownload("下载版本 Json 文件", New List(Of NetFile) From { + Loaders.Add(New LoaderDownload("下载版本 json 文件", New List(Of NetFile) From { New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) }) With {.ProgressWeight = 2}) '获取支持库文件地址 - Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 Jar 文件下载地址", + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 jar 文件下载地址", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False}) '下载支持库文件 - Loaders.Add(New LoaderDownload("下载核心 Jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) + Loaders.Add(New LoaderDownload("下载核心 jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) '启动 Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} @@ -115,7 +115,7 @@ Public Module ModDownloadLib '下载版本 Json 文件 If JsonUrl Is Nothing Then - Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 Json 文件下载地址", + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Dim JsonAddress As String = DlClientListGet(Id) Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")} @@ -166,7 +166,7 @@ Public Module ModDownloadLib End Function Private Const McDownloadClientLibName As String = "下载原版支持库文件" - Private Const McDownloadClientJsonName As String = "下载原版 Json 文件" + Private Const McDownloadClientJsonName As String = "下载原版 json 文件" #End Region @@ -192,7 +192,7 @@ Public Module ModDownloadLib Else NewItem.Info = Entry("lore").ToString End If - If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL2 特别提供] " & NewItem.Info + If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL 特别提供] " & NewItem.Info AddHandler NewItem.Click, OnClick '建立菜单 If IsSaveOnly Then @@ -333,7 +333,7 @@ Public Module ModDownloadLib '已有版本检查 If File.Exists(VersionFolder & Id & ".json") Then - If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then File.Delete(VersionFolder & Id & ".jar") File.Delete(VersionFolder & Id & ".json") Else @@ -770,7 +770,7 @@ Public Module ModDownloadLib '已有版本检查 If File.Exists(VersionFolder & VersionName & ".json") Then - If MyMsgBox("版本 " & VersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + If MyMsgBox("版本 " & VersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then File.Delete(VersionFolder & VersionName & ".jar") File.Delete(VersionFolder & VersionName & ".json") Else @@ -992,16 +992,16 @@ Public Module ModDownloadLib Public Sub McDownloadForge(DownloadInfo As DlForgeVersionEntry) '老版本提示 If DownloadInfo.Category = "client" Then - If MyMsgBox("该 Forge 版本过于古老,PCL2 暂不支持该版本的自动安装。" & vbCrLf & - "若你仍然希望继续,PCL2 将把安装程序下载到你指定的位置,但不会进行安装。", + If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf & + "若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。", "版本过老", "继续", "取消") = 1 Then McDownloadForgeSave(DownloadInfo) End If Exit Sub End If If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWith("1.5") Then '对该版本自动安装的支持将在之后加入 - If MyMsgBox("该 Forge 版本过于古老,PCL2 暂不支持该版本的自动安装。" & vbCrLf & - "若你仍然希望继续,PCL2 将把安装程序下载到你指定的位置,但不会进行安装。", + If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf & + "若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。", "版本过老", "继续", "取消") = 1 Then McDownloadForgeSave(DownloadInfo) End If @@ -1026,7 +1026,7 @@ Public Module ModDownloadLib '已有版本检查 If File.Exists(VersionFolder & Id & ".json") Then - If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then File.Delete(VersionFolder & Id & ".jar") File.Delete(VersionFolder & Id & ".json") Else @@ -1239,6 +1239,11 @@ Public Module ModDownloadLib '参数初始化 McFolder = If(McFolder, PathMcFolder) + If Version.StartsWith("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 + End If Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim Id As String = Inherit & "-forge-" & Version Dim InstallerAddress As String = PathTemp & "Cache\Code\ForgeInstall-" & Version & "_" & RandomInteger(0, 100000) @@ -1267,20 +1272,20 @@ Public Module ModDownloadLib End If '下载 Forge 主文件 Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载", - Sub(Task As LoaderTask(Of String, List(Of NetFile))) - '启动依赖版本的下载 - If ClientDownloadLoader Is Nothing Then - If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹") - ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit) - End If - '添加主文件 - Dim Files As New List(Of NetFile) From {New NetFile({ - "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, - "http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, - "https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName - }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))} - Task.Output = Files - End Sub) With {.ProgressWeight = 0.5, .Show = False}) + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If ClientDownloadLoader Is Nothing Then + If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹") + ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit) + End If + '添加主文件 + Dim Files As New List(Of NetFile) From {New NetFile({ + "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName + }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))} + Task.Output = Files + End Sub) With {.ProgressWeight = 0.5, .Show = False}) Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) '安装(仅在新版安装时需要原版 Jar) @@ -1788,7 +1793,7 @@ Public Module ModDownloadLib '若要下载 Forge,则需要在下面两项中完成至少一项 ''' - ''' 欲下载的 Forge 版本名。例如 36.1.4。 + ''' 欲下载的 Forge 版本名。接受例如 36.1.4 / 14.23.5.2859 / 1.19-41.1.0 的输入。 ''' Public ForgeVersion As String = Nothing ''' @@ -2065,30 +2070,30 @@ Public Module ModDownloadLib Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing #Region "读取文件并检查文件是否合规" Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath) - If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft Json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000))) + If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000))) MinecraftJson = GetJson(MinecraftJsonText) If HasOptiFine Then Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath) - If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine Json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000))) + If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000))) OptiFineJson = GetJson(OptiFineJsonText) End If If HasForge Then Dim ForgeJsonText As String = ReadFile(ForgeJsonPath) - If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge Json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000))) + If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000))) ForgeJson = GetJson(ForgeJsonText) End If If HasLiteLoader Then Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath) - If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader Json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000))) + If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000))) LiteLoaderJson = GetJson(LiteLoaderJsonText) End If If HasFabric Then Dim FabricJsonText As String = ReadFile(FabricJsonPath) - If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric Json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000))) + If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000))) FabricJson = GetJson(FabricJsonText) End If #End Region diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml index ee70967..879883c 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml @@ -9,7 +9,7 @@ @@ -220,13 +221,21 @@ + + + - + - + - + + + + - + @@ -111,10 +111,8 @@ - - diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb index c6f3924..3ac1db5 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb @@ -154,65 +154,6 @@ If AniControlEnabled = 0 Then Hint("部分调试信息将在刷新或启动器重启后切换显示!",, False) End Sub - '清理缓存 - Private IsClearingCache As Boolean = False - Private Sub BtnSystemCacheClear_Click(sender As Object, e As EventArgs) Handles BtnSystemCacheClear.Click - If HasDownloadingTask() Then - Hint("请在所有下载任务完成后再清理缓存!", HintType.Critical) - Exit Sub - End If - If PathTemp = IO.Path.GetTempPath() & "PCL\" Then - If MyMsgBox("你确定要清理缓存吗?" & vbCrLf & "在清理缓存后,PCL2 会被强制关闭,以避免缓存缺失带来的异常。", "清理确认", "确定", "取消") = 2 Then - Exit Sub - End If - Else - If MyMsgBox("你已将缓存文件夹手动修改为:" & PathTemp & vbCrLf & - "清理缓存将删除你所设置的这一文件夹中的所有内容,且无法恢复!" & vbCrLf & - "请在继续前,确认其中没有除了 PCL2 缓存以外的重要文件!" & vbCrLf & vbCrLf & - "在清理缓存后,PCL2 会被强制关闭,以避免缓存缺失带来的异常。", "清理确认", "永久删除该文件夹", "取消", IsWarn:=True) = 2 Then - Exit Sub - End If - End If - If IsClearingCache Then Exit Sub - IsClearingCache = True - Try - Dim TotalSize As ULong = DeleteCacheDirectory(PathTemp) - DeleteDirectory(PathTemp, True) - TotalSize += DeleteCacheDirectory(OsDrive & "ProgramData\PCL\") - DeleteDirectory(OsDrive & "ProgramData\PCL\", True) - If TotalSize <= 0 Then - Hint("没有可清理的缓存!") - Else - MyMsgBox("已清理 " & GetString(TotalSize) & " 缓存!" & vbCrLf & "PCL2 即将自动关闭。", "缓存已清理", ForceWait:=True) - FrmMain.EndProgram(False) - End If - Catch ex As Exception - Log(ex, "清理缓存失败", LogLevel.Hint) - Finally - IsClearingCache = False - End Try - End Sub - Private Function DeleteCacheDirectory(Path As String, Optional TotalSize As ULong = 0) As ULong - If Not Directory.Exists(Path) Then Return TotalSize - Dim Temp As String() - Temp = Directory.GetFiles(Path) - For Each str As String In Temp - Try - Dim Info As New FileInfo(str) - Dim FileActualSize = Math.Ceiling(Info.Length / 4096) * 4096 - Info.Delete() - TotalSize += FileActualSize - Catch ex As Exception - Log(ex, "删除失败的缓存文件(" & str & ")") - End Try - Next - Temp = Directory.GetDirectories(Path) - For Each str As String In Temp - TotalSize += DeleteCacheDirectory(str) - Next - Return TotalSize - End Function - '自动更新 Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged If AniControlEnabled <> 0 Then Exit Sub diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml index 23f7cb0..33bc4e1 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml @@ -39,7 +39,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb index 54f4de9..2fe2bcd 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb @@ -308,6 +308,7 @@ Public Sub Delete_Click(sender As MyIconButton, e As EventArgs) Try + Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim ListItem As MyListItem = sender.Tag Dim ModEntity As McMod = ListItem.Tag '前置检测警告 @@ -316,7 +317,11 @@ End If '删除 If File.Exists(ModEntity.Path) Then - My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) + If IsShiftPressed Then + File.Delete(ModEntity.Path) + Else + My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) + End If Else '在不明原因下删除的文件可能还在列表里,如果玩家又点了一次就会出错,总之加个判断也不碍事 Log("[System] 需要删除的 Mod 文件不存在(" & ModEntity.Path & ")", LogLevel.Hint) @@ -333,7 +338,11 @@ CType(Parent.Parent, MyCard).Title = McModGetTitle(McModLoader.Output) End If '显示提示 - Hint("已将 " & ModEntity.FileName & " 删除到回收站!", HintType.Finish) + If IsShiftPressed Then + Hint("已删除 " & ModEntity.FileName & "!", HintType.Finish) + Else + Hint("已将 " & ModEntity.FileName & " 删除到回收站!", HintType.Finish) + End If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) Catch ex As Exception diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb index 40491f7..72517aa 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb @@ -92,7 +92,7 @@ Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click Try Dim OldInfo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo") - Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL2 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述") + Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述") If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo", NewInfo) PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() Reload() @@ -121,7 +121,7 @@ Try JsonObject = GetJson(ReadFile(PageVersionLeft.Version.Path & PageVersionLeft.Version.Name & ".json")) Catch ex As Exception - Log(ex, "重命名读取 Json 时失败") + Log(ex, "重命名读取 json 时失败") JsonObject = PageVersionLeft.Version.JsonObject End Try '重命名主文件夹 @@ -162,7 +162,7 @@ JsonObject("id") = NewName WriteFile(NewPath & NewName & ".json", JsonObject.ToString) Catch ex As Exception - Log(ex, "重命名 Json 时失败") + Log(ex, "重命名版本 json 失败") End Try End If '刷新与提示 @@ -315,17 +315,20 @@ Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click '修改此代码时,同时修改 PageSelectRight 中的代码 Try + Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder - Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗?" & + Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageVersionLeft.Version.Name} 吗?" & If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""), - "版本删除确认", , "取消",, True) + "版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed) Case 1 - FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) - Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Finish) + If IsShiftPressed Then + DeleteDirectory(PageVersionLeft.Version.Path) + Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish) + Else + FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) + Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Finish) + End If Case 2 - ' DeleteDirectory(PageVersionLeft.Version.Path) - ' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish) - 'Case 3 Exit Sub End Select LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml index bc5f981..f802b44 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml @@ -47,7 +47,7 @@ - + @@ -190,9 +190,9 @@ - + - + @@ -202,7 +202,7 @@ + ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。 在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。 可以使用以下替换标记实现相对路径(路径均以 \ 结尾): · {path}:PCL 的 exe 文件所在的文件夹 · {minecraft}:.minecraft 文件夹 · {verpath}:版本文件夹(.minecraft\versions\版本名\) · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹 · {java}:游戏运行时的 Java 文件夹 除此之外,也支持以下替换标记: · {user}:玩家名字 · {login}:玩家的登录方式 · {uuid}:玩家的 UUID · {name}:游戏版本名 · {time}:当前的系统时间 · {version}:游戏对应的原版版本号 例如: · "{verpath}test.exe" :运行版本文件夹下的 test.exe 程序 · "{java}java.exe" -jar "{verpath}test.jar" :用 Java 运行版本文件夹下的 test.jar · notepad "{verindie}option.txt" :使用记事本打开该版本的设置文件 涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" /> diff --git a/Plain Craft Launcher 2/Resources/Custom.xaml b/Plain Craft Launcher 2/Resources/Custom.xaml index e77ad26..368b824 100644 --- a/Plain Craft Launcher 2/Resources/Custom.xaml +++ b/Plain Craft Launcher 2/Resources/Custom.xaml @@ -1,6 +1,6 @@  - @@ -84,13 +84,13 @@ + Text="此外,PCL 会将文件中的花括号 path 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" /> + Text="打开 PCL 日志" EventType="打开文件" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" /> + Text="定位游戏启动脚本" EventType="打开文件" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。 点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" /> @@ -162,7 +162,7 @@ + Text="PCL 中包含一些预置的方块与物品图片,可以直接使用。"/> @@ -203,7 +203,7 @@ - Width、Height:设置宽度与高度 - ToolTip:设置鼠标指向时的提示文本 - Foreground:调整前景颜色(十六进制字符串,例如 #FF010203 代表 ARGB 中的 255,1,2,3。前两位代表不透明度,FF 为全不透明,00 为全透明) - - Background:调整背景颜色(使用类似 Background="{DynamicResource ColorBrush5}" 的格式以调用 PCL2 当前的主题颜色,修改末尾的数字编号以改变颜色浓度) + - Background:调整背景颜色(使用类似 Background="{DynamicResource ColorBrush5}" 的格式以调用 PCL 当前的主题颜色,修改末尾的数字编号以改变颜色浓度) - Margin:调整外边距(格式为 左,上,右,下。例如 Margin="0,0,0,2" 即为 2 单位的下边距) - HorizontalAlignment:设置对齐方式(Left、Center、Right) diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip index 7a5cd70..9c75781 100644 Binary files a/Plain Craft Launcher 2/Resources/Help.zip and b/Plain Craft Launcher 2/Resources/Help.zip differ