InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.5.1

Browse Source
This commit is contained in:
龙腾猫跃
2023-03-08 23:34:10 +08:00
parent 36c10ade8c
commit d886acdeac
50 changed files with 781 additions and 659 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+29 -31
View File
@@ -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
''' <summary>
@@ -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
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+1 -1
View File
@@ -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
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+16 -20
View File
@@ -107,32 +107,28 @@ Public Class MyBitmap
''' </summary>
''' <param name="angle">旋转角度（单位为角度）。</param>
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
''' <summary>
''' 获取裁切的图片，这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
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
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+41 -21
View File
@@ -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 是相同的工程，只是在不同的网站。
''' </summary>
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
'下载信息
''' <summary>
''' 下载信息是否可用。
''' </summary>
Public ReadOnly Property Available As Boolean
Get
Return FileName IsNot Nothing
End Get
End Property
''' <summary>
''' 下载的文件名。
''' </summary>
Public ReadOnly FileName As String
Public ReadOnly FileName As String = Nothing
''' <summary>
''' 文件所有可能的下载源。
''' </summary>
@@ -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:
''' <summary>
''' 将当前文件信息实例化为控件。
''' </summary>
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).
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+180 -169
View File
@@ -29,7 +29,7 @@
''' <summary>
''' 将可用于分析的日志存储到 AnalyzeRawFiles。
''' </summary>
''' <param name="LatestLog">从 PCL2 捕获到的最后 200 行程序输出。</param>
''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param>
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.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>(net.minecraft.resources.ResourceLocation, ") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>(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 名称，若失败则返回原关键字。
''' </summary>
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:
''' </summary>
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
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+6 -6
View File
@@ -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,
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+78 -34
View File
@@ -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))
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+65 -73
View File
@@ -6,7 +6,7 @@ Public Module ModMinecraft
'列表初始化
Public JavaListCacheVersion As Integer = 2
Public JavaListCacheVersion As Integer = 3
''' <summary>
''' 目前所有可用的 Java。
''' </summary>
@@ -46,12 +46,23 @@ Public Module ModMinecraft
''' </summary>
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
''' <summary>
''' JAVA_HOME 环境变量。
''' </summary>
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:
''' <summary>
''' 要求玩家选择一个皮肤文件，并进行相关校验。
''' </summary>
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)
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+6 -4
View File
@@ -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
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+1 -1
View File
@@ -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
Plain Craft Launcher 2/Modules/ModEvent.vb
+3 -2
View File
@@ -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
Plain Craft Launcher 2/Modules/ModMusic.vb
+2 -2
View File
@@ -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