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

Merge branch 'main' into fix#6230

Browse Source
This commit is contained in:
wyc-26
2025-11-15 11:20:58 +08:00
committed by GitHub
parent 80f89cdf4f ad757f54b7
commit 43db6f073e
131 changed files with 5615 additions and 4384 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+9 -10
View File
@@ -347,7 +347,7 @@
Case 4475 : Tags.Add("冒险")
Case 4476 : Tags.Add("探索")
Case 4477 : Tags.Add("小游戏")
Case 4471 : Tags.Add("科幻")
Case 4474 : Tags.Add("科幻")
Case 4736 : Tags.Add("空岛")
Case 5128 : Tags.Add("原版改良")
Case 4487 : Tags.Add("FTB")
@@ -1161,9 +1161,9 @@ Retry:
ElseIf [Error] IsNot Nothing Then
'有结果但是有错误
If CurseForgeFailed Then
Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后重试，或使用 VPN 以改善网络环境。"
Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
Else
Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后重试，或使用 VPN 以改善网络环境。"
Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
End If
End If
@@ -1211,11 +1211,11 @@ Retry:
Function(Project As CompProject) As Double
Select Case Request.Type
Case CompType.Mod, CompType.ModPack
Return If(Project.FromCurseForge, 1, 7)
Return If(Project.FromCurseForge, 1, 5)
Case CompType.DataPack
Return If(Project.FromCurseForge, 10, 1)
Case CompType.ResourcePack, CompType.Shader
Return If(Project.FromCurseForge, 1, 5)
Return If(Project.FromCurseForge, 1, 4)
Case Else
Return 1
End Select
@@ -1354,7 +1354,7 @@ Retry:
''' </summary>
''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), SimulateBrowserHeaders:=True)
End Function
'实例化
@@ -1395,10 +1395,9 @@ Retry:
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
DownloadUrls = HandleCurseForgeDownloadUrls(Url.Replace(FileName, WebUtility.UrlEncode(FileName))) '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies
If Data.ContainsKey("dependencies") Then
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+24 -12
View File
@@ -341,6 +341,7 @@ Extracted:
''' 导致崩溃的原因枚举。
''' </summary>
Private Enum CrashReason
Java虚拟机参数有误
Mod文件被解压
MixinBootstrap缺失
内存不足
@@ -484,10 +485,12 @@ Done:
'崩溃报告分析，高优先级
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
End If
'游戏日志分析
If LogMc IsNot Nothing Then
If LogMc.Contains("Unrecognized option:") Then AppendReason(CrashReason.Java虚拟机参数有误)
If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
@@ -516,7 +519,7 @@ Done:
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版本不兼容)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") AndAlso Not CrashReasons.ContainsKey(CrashReason.Mod配置文件导致游戏崩溃) Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
@@ -539,8 +542,8 @@ Done:
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Incompatible mods found!") Then '#5006
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息：").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
End If
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
@@ -656,7 +659,7 @@ Done:
End If
'Mod 解析错误（常见于 Fabric 前置校验失败）
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
'Mixin 失败可以导致大量 Mod 实例创建失败
'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
@@ -715,7 +718,7 @@ NextStack:
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill"
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -868,11 +871,11 @@ NextStack:
Sub()
'弹窗选择：查看日志
If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key)
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath)
StartProcess(FilePath)
End If
End Sub))
Case 3
@@ -905,8 +908,7 @@ NextStack:
If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
FileContent = FilterUserName(FileContent, "*")
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
End If
@@ -914,7 +916,7 @@ NextStack:
'导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Finish)
Hint("错误报告已导出！", HintType.Green)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Return
@@ -946,6 +948,8 @@ NextStack:
For Each Reason In CrashReasons
Dim Additional As List(Of String) = Reason.Value
Select Case Reason.Key
Case CrashReason.Java虚拟机参数有误
Results.Add("由于 Java 参数有误，导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了，导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可，若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod，然后再启动游戏。")
Case CrashReason.内存不足
@@ -1026,9 +1030,17 @@ NextStack:
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并生成一个该实体，然后观察游戏的运行情况。\h")
If Additional.First.Contains("minecraft:player") Then
If Additional.First.Contains(" ") Then
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
Else
Results.Add($"游戏因为玩家实体导致了崩溃。\h")
End If
Else
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
End If
Else
Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界，并生成各种实体，然后观察游戏的运行情况。\h")
Results.Add($"游戏因为下列实体导致了崩溃：{Additional.Join("、")}\h")
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容，导致了游戏崩溃。\n\n请前往 OptiFine 官网（https://optifine.net/downloads）查看 OptiFine 所兼容的 Forge 版本，并严格按照对应版本重新安装游戏。")
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+25 -18
View File
@@ -73,8 +73,10 @@
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
@@ -93,6 +95,11 @@
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort()
Throw New ThreadInterruptedException
End If
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
@@ -198,7 +205,7 @@
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json"))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -235,7 +242,7 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json"))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -413,7 +420,7 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList"))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -483,7 +490,7 @@
''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", UseBrowserUserAgent:=True)
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -631,9 +638,9 @@
Try
Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
".html", UseBrowserUserAgent:=True)
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用")
Else
Throw
@@ -701,7 +708,7 @@
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"))) '兼容 Forge 1.7.10-pre4，#4057
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -839,8 +846,8 @@
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge")
Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge")
Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
'解析
Try
@@ -857,8 +864,8 @@
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge")
Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge")
Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足（" & ResultLatest & "）")
'解析
Try
@@ -963,7 +970,7 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json"))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -991,7 +998,7 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json"))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1062,7 +1069,7 @@
''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions"))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1077,7 +1084,7 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions"))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1134,7 +1141,7 @@
Dim Exs As String = ""
For Each Source In Urls
Try
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8))
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+15 -30
View File
@@ -10,7 +10,7 @@
'路径
''' <summary>
''' Java.exe 文件的完整路径。
''' java.exe 文件的完整路径。
''' </summary>
Public ReadOnly Property PathJava As String
Get
@@ -18,15 +18,7 @@
End Get
End Property
''' <summary>
''' Javaw.exe 文件的完整路径。
''' </summary>
Public ReadOnly Property PathJavaw As String
Get
Return PathFolder & "javaw.exe"
End Get
End Property
''' <summary>
''' Javaw.exe 文件所在文件夹的路径，以 \ 结尾。
''' java.exe 文件所在文件夹的路径，以 \ 结尾。
''' </summary>
Public PathFolder As String
''' <summary>
@@ -102,20 +94,13 @@
Dim Output As String = Nothing
Try
'确定文件存在
If Not File.Exists(PathJavaw) Then
Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw)
End If
If Not File.Exists(PathFolder & "java.exe") Then
Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
End If
If File.Exists(PathFolder & "pdf-bookmark") Then
Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
End If
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出：" & PathFolder & "java.exe" & vbCrLf & Output)
If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java，该 Java 或系统存在问题")
'获取详细信息
@@ -136,17 +121,17 @@
End If
Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString)
'基于 #3649，在 64 位系统上禁用 32 位 Java
'#3649：在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败，干脆禁用更多版本的 JRE
'#2249：JRE 17 似乎会导致 Forge 安装失败，干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！")
Catch ex As ApplicationException
Throw ex
Catch ex As ThreadInterruptedException
Throw ex
Catch ex As Exception
Log("[Java] 检查失败的 Java 输出：" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败（" & If(PathJavaw, "Nothing") & "）", ex)
Log("[Java] 检查失败的 Java 输出：" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败（" & If(PathJava, "Nothing") & "）", ex)
End Try
IsChecked = True
End Sub
@@ -460,8 +445,8 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(ShortenPath(Path))
Dim PathMcInfo As New DirectoryInfo(ShortenPath(PathMcFolder))
Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(PathMcFolder)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
@@ -533,7 +518,7 @@ NoUserJava:
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 .jdks 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, True)
'查找 APPDATA 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
@@ -661,7 +646,7 @@ Wait:
Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try
Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath)
JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch)
JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath)
Catch ex As Exception
@@ -689,7 +674,7 @@ Wait:
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "1.", "启动"}
"4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+109 -143
View File
@@ -35,7 +35,7 @@ Public Module ModLaunch
'预检查
If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中！", HintType.Critical)
Hint("已有游戏正在启动中！", HintType.Red)
Return False
End If
'强制切换需要启动的版本
@@ -44,7 +44,7 @@ Public Module ModLaunch
'检查版本
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical)
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Red)
Return False
End If
'切换版本
@@ -98,7 +98,7 @@ Public Module ModLaunch
McLaunchPrecheck()
McLaunchLog("预检测已通过")
Catch ex As Exception
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
Throw
End Try
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -146,7 +146,7 @@ Public Module ModLaunch
'成功与失败处理
Select Case LaunchLoader.State
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Green)
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动成功",
@@ -155,9 +155,9 @@ Public Module ModLaunch
End If
Case LoadState.Aborted
If AbortHint Is Nothing Then
Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Info)
Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Blue)
Else
Hint(AbortHint, HintType.Finish)
Hint(AbortHint, HintType.Green)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
@@ -178,7 +178,7 @@ NextInner:
GoTo NextInner
Else
'没有特殊处理过的错误信息
McLaunchLog("错误：" & GetExceptionDetail(ex))
McLaunchLog("错误：" & ex.GetDetail())
Log(ex,
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox,
If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
@@ -187,7 +187,7 @@ NextInner:
Telemetry("Minecraft 启动失败",
"Version", McVersionCurrent.Version.ToString,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
"Exception", FilterUserName(FilterAccessToken(GetExceptionDetail(ex), "*"), "*"))
"Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
End If
Throw
End If
@@ -270,7 +270,7 @@ NextInner:
Select Case MyMsgBox("你必须先登录正版账号，才能进行离线登录！", "正版验证", "购买正版", "试玩", "返回",
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
Case 2
Hint("游戏将以试玩模式启动！", HintType.Critical)
Hint("游戏将以试玩模式启动！", HintType.Red)
CurrentLaunchOptions.ExtraArgs.Add("--demo")
Case 3
Throw New Exception("$$")
@@ -609,12 +609,8 @@ SkipLogin:
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
Dim AllMessage = GetExceptionDetail(ex)
McLaunchLog("验证登录失败：" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败")
Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后重试，或使用加速器或 VPN 以改善网络环境。")
End If
Log(ex, "验证登录失败")
If IsNetworkRelated(ex) Then Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后再试，或使用加速器、VPN 改善网络环境。")
End Try
Data.Progress = 0.25
'尝试刷新登录
@@ -624,7 +620,7 @@ Refresh:
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
McLaunchLog("刷新登录失败：" & GetExceptionDetail(ex))
McLaunchLog("刷新登录失败：" & ex.GetDetail())
If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
End Try
Data.Progress = If(NeedRefresh, 0.85, 0.45)
@@ -634,7 +630,7 @@ Refresh:
If Data.IsAborted Then Throw New ThreadInterruptedException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败：" & GetExceptionDetail(ex))
McLaunchLog("登录失败：" & ex.GetDetail())
Throw
End Try
If NeedRefresh Then
@@ -726,7 +722,7 @@ LoginFinish:
New JProperty("requestUser", True)
).ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8"))
ContentType:="application/json; charset=utf-8", RequireJson:=True))
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效！")
Data.Output.AccessToken = LoginJson("accessToken").ToString
@@ -756,13 +752,13 @@ LoginFinish:
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8"))
ContentType:="application/json; charset=utf-8", RequireJson:=True))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Critical)
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Red)
Throw New Exception("$你还没有创建角色，请在创建角色后再试！")
ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then
Hint("你的账户中只有一个角色，无法更换！", HintType.Critical)
Hint("你的账户中只有一个角色，无法更换！", HintType.Red)
End If
Dim SelectedName As String = Nothing
Dim SelectedId As String = Nothing
@@ -814,13 +810,14 @@ LoginFinish:
McLaunchLog("登录成功（Login, " & Data.Input.Token & "）")
Return NeedRefresh
Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex)
Dim AllMessage As String = ex.GetBrief()
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Dim Response = DirectCast(ex, ResponsedWebException).Response
If ErrorMessage.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -838,7 +835,7 @@ LoginFinish:
End If
End If
'通用关键字检测
If AllMessage.Contains("403") Then
If AllMessage.Contains("(403)") Then
Select Case Data.Input.Type
Case McLoginType.Auth
Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf &
@@ -852,8 +849,8 @@ LoginFinish:
If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号，而非游戏角色 ID。" & vbCrLf) &
" - 只注册了账号，但没有加入对应服务器。")
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后重试，或使用加速器或 VPN 以改善网络环境。")
ElseIf ex.IsNetworkRelated() Then
Throw New Exception("$登录失败：你的网络环境不佳，导致难以连接到海外服务器。" & vbCrLf & "请稍后再试，或使用加速器、VPN 改善网络环境。")
ElseIf ex.Message.StartsWithF("$") Then
Throw
Else
@@ -872,7 +869,7 @@ Retry:
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded"))
ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
'弹窗
@@ -907,9 +904,17 @@ Retry:
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2)
Catch ex As ResponsedWebException
If ex.Response.ContainsF("must sign in again", True) OrElse ex.Response.ContainsF("password expired", True) OrElse
(ex.Response.Contains("refresh_token") AndAlso ex.Response.Contains("is not valid")) Then '#269
'修改错误列表时，同时检查 MyMsgLogin.xaml.vb 中的对应代码
Dim Response = ex.Response
If Response.ContainsF("must sign in again", True) OrElse Response.ContainsF("password expired", True) OrElse
(Response.Contains("refresh_token") AndAlso Response.Contains("is not valid")) Then '#269
Return {"Relogin", ""}
ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
ElseIf Response.Contains("service abuse") Then
MyMsgBox("非常抱歉，该账号已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Else
Throw
End If
@@ -934,7 +939,7 @@ Retry:
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json")
Content:=Request, ContentType:="application/json", RequireJson:=True)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
@@ -956,7 +961,7 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
Content:=Request, ContentType:="application/json")
Content:=Request, ContentType:="application/json", RequireJson:=True)
Catch ex As ResponsedWebException
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Response.Contains("2148916227") Then
@@ -968,7 +973,7 @@ Retry:
End If
Throw New Exception("$$")
ElseIf ex.Response.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN。", "登录失败", "我知道了")
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN，然后再试。", "登录失败", "我知道了")
Throw New Exception("$$")
ElseIf ex.Response.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf &
@@ -987,15 +992,11 @@ Retry:
End If
End Try
Try '这个 Try 块仅为了追踪 #6683 而添加
Dim ResultJson As JObject = GetJson(Result)
Dim XSTSToken As String = ResultJson("Token").ToString
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
Return {XSTSToken, UHS}
Catch
Log("[Launch] 返回内容：" & vbCrLf & Result)
Throw
End Try
Dim ResultJson As JObject = GetJson(Result)
Return {
ResultJson("Token"), 'XSTSToken
ResultJson("DisplayClaims")("xui")(0)("uhs") 'UHS
}
End Function
'微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
Private Function MsLoginStep4(Tokens As String()) As String
@@ -1005,9 +1006,9 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientRetry("https://api.minecraftservices.com/authentication/login_with_xbox", HttpMethod.Post,
Content:=Request, ContentType:="application/json")
Content:=Request, ContentType:="application/json", RequireJson:=True)
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
Dim Message As String = ex.GetBrief()
If Message.Contains("(429)") Then
Log(ex, "微软登录第 4 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -1019,16 +1020,14 @@ Retry:
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken
Return GetJson(Result)("access_token").ToString
End Function
'微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP
Private Sub MsLoginStep5(AccessToken As String)
McLaunchLog("开始微软登录步骤 5/6")
Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
Try
Dim ResultJson As JObject = GetJson(Result)
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
@@ -1050,9 +1049,9 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://api.minecraftservices.com/minecraft/profile",
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
Catch ex As WebException
Dim Message As String = ex.GetBrief()
If Message.Contains("(429)") Then
Log(ex, "微软登录第 6 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -1123,7 +1122,7 @@ Retry:
If Len(Uuid) = 32 Then Return Uuid
'从官网获取
Try
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name))
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）")
Uuid = If(GotJson("id"), "")
Catch ex As Exception
@@ -1305,7 +1304,7 @@ Retry:
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java，已取消启动！", HintType.Critical)
Hint("没有可用的 Java，已取消启动！", HintType.Red)
Throw New Exception("$$")
End If
@@ -1396,7 +1395,7 @@ Retry:
Next
'自定义
Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent)
Arguments += " " & If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame)
Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame))
'进行参数替换
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1413,6 +1412,9 @@ Retry:
FinalArguments += Argument & " "
Next
FinalArguments = FinalArguments.TrimEnd
'替换 Module Path 为短路径（Forge 会在版本 JSON 硬编码这些路径）
FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )",
Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]{1}:\\[^;]+", Function(m) ShortenPath(m.Value)))
'进服
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then
@@ -1428,7 +1430,7 @@ Retry:
'不包含端口号
FinalArguments += $" --server {Server} --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical)
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
End If
End If
'输出
@@ -1448,7 +1450,7 @@ Retry:
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
@@ -1461,9 +1463,7 @@ Retry:
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", McVersionCurrent))
Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1488,6 +1488,9 @@ Retry:
DataList.Add(Version.JsonObject("mainClass"))
End If
'处理 DataList 的换行符
DataList = DataList.Select(Function(d) d.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim).ToList
Return Join(DataList, " ")
End Function
Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String
@@ -1531,9 +1534,7 @@ NextVersion:
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1555,7 +1556,7 @@ NextVersion:
'如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重
Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i)
Dim CurrentEntry As String = DataList(i).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim
If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1
If DataList(i + 1).StartsWithF("-") Then
@@ -1571,7 +1572,7 @@ NextVersion:
'去重
DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M") '#3511 的清理
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
@@ -1592,7 +1593,7 @@ NextVersion:
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
DataList.Add(BasicString)
Dim Result As String = Join(DataList, " ")
Dim Result As String = DataList.Join(" ")
'特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
@@ -1697,7 +1698,7 @@ NextVersion:
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))
GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)))
GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
GameArguments.Add("${user_properties}", "{}")
@@ -1707,7 +1708,7 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221
GameArguments.Add("${primary_jar}", Version.Path & Version.Name & ".jar") '#6942
GameArguments.Add("${primary_jar}", ShortenPath(Version.Path & Version.Name & ".jar")) '#6942
'窗口尺寸参数
Dim GameSize As Size
@@ -1796,7 +1797,7 @@ NextVersion:
File.Delete(FilePath)
Catch ex As UnauthorizedAccessException
McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath)
McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
McLaunchLog("实际的错误信息：" & ex.GetDetail())
Exit For
End Try
End If
@@ -1816,7 +1817,7 @@ NextVersion:
File.Delete(FileName)
Catch ex As UnauthorizedAccessException
McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤")
McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
McLaunchLog("实际的错误信息：" & ex.GetDetail())
Return
End Try
Next
@@ -1827,10 +1828,14 @@ NextVersion:
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
If IsGBKEncoding OrElse Result.IsASCII() Then Return Result
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Result.IsASCII() Then Return Result
Return OsDrive & "ProgramData\PCL\natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
Result = OsDrive & "ProgramData\PCL\natives"
End If
End If
Directory.CreateDirectory(Result) '提前创建，这样 ShortenPath 才有结果（否则在长路径下首次启动 Forge 会崩溃）
Return ShortenPath(Result)
End Function
#End Region
@@ -1842,7 +1847,7 @@ NextVersion:
'要求 Java 使用高性能显卡
If Setup.Get("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJavaw)
SetGPUPreference(McLaunchJavaSelected.PathJava)
SetGPUPreference(PathWithName)
Catch ex As Exception
If IsAdmin() Then
@@ -1850,7 +1855,7 @@ NextVersion:
Else
Log(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
Try
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJavaw}""") = ProcessReturnValues.TaskDone Then
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
Else
Throw New Exception("调整过程中出现异常")
@@ -1981,7 +1986,7 @@ NextVersion:
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical)
Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Red)
End If
'离线皮肤资源包
@@ -2125,9 +2130,9 @@ IgnoreCustomSkin:
'获取自定义命令
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal, True)
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion, True)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
'输出 bat
Try
@@ -2159,14 +2164,15 @@ IgnoreCustomSkin:
'执行自定义命令
If CustomCommandGlobal <> "" Then
McLaunchLog("正在执行全局自定义命令：" & CustomCommandGlobal)
Dim CustomProcess As New Process
Dim CustomProcess As Process = Nothing
Try
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """"
CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandGlobal}""",
.WorkingDirectory = PathMcFolder,
.UseShellExecute = False,
.CreateNoWindow = True
})
If Setup.Get("LaunchAdvanceRunWait") Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
@@ -2175,7 +2181,7 @@ IgnoreCustomSkin:
Catch ex As Exception
Log(ex, "执行全局自定义命令失败", LogLevel.Hint)
Finally
If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2183,14 +2189,15 @@ IgnoreCustomSkin:
End If
If CustomCommandVersion <> "" Then
McLaunchLog("正在执行版本自定义命令：" & CustomCommandVersion)
Dim CustomProcess As New Process
Dim CustomProcess As Process = Nothing
Try
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """"
CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandVersion}""",
.WorkingDirectory = PathMcFolder,
.UseShellExecute = False,
.CreateNoWindow = True
})
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
@@ -2199,7 +2206,7 @@ IgnoreCustomSkin:
Catch ex As Exception
Log(ex, "执行版本自定义命令失败", LogLevel.Hint)
Finally
If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2210,27 +2217,27 @@ IgnoreCustomSkin:
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
'启动信息
Dim GameProcess = New Process()
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
'设置环境变量
Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
'设置其他参数
StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
StartInfo.RedirectStandardError = True
StartInfo.CreateNoWindow = False
StartInfo.CreateNoWindow = True
StartInfo.Arguments = McLaunchArgument
GameProcess.StartInfo = StartInfo
'开始进程
GameProcess.Start()
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJavaw)
Dim GameProcess = StartProcess(StartInfo)
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava)
If Loader.IsAborted Then
McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631
GameProcess.Kill()
@@ -2283,7 +2290,7 @@ IgnoreCustomSkin:
'获取窗口标题
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
WindowTitle = ArgumentReplace(WindowTitle, False)
WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
'初始化等待
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
@@ -2332,47 +2339,6 @@ IgnoreCustomSkin:
End Sub
''' <summary>
''' 在启动结束时，对 PCL 约定的替换标记进行处理。
''' </summary>
Private Function ArgumentReplace(Raw As String, ReplaceTimeAndDate As Boolean) As String
If Raw Is Nothing Then Return Nothing
'路径替换
Raw = Raw.Replace("{minecraft}", PathMcFolder)
Raw = Raw.Replace("{verpath}", McVersionCurrent.Path)
Raw = Raw.Replace("{verindie}", McVersionCurrent.PathIndie)
Raw = Raw.Replace("{java}", McLaunchJavaSelected.PathFolder)
'普通替换
Raw = Raw.Replace("{user}", McLoginLoader.Output.Name)
Raw = Raw.Replace("{uuid}", McLoginLoader.Output.Uuid)
If ReplaceTimeAndDate Then '设置窗口标题时需要动态替换日期和时间
Raw = Raw.Replace("{date}", Date.Now.ToString("yyyy/M/d"))
Raw = Raw.Replace("{time}", Date.Now.ToString("HH:mm:ss"))
End If
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
Raw = Raw.Replace("{login}", "联机离线")
Else
Raw = Raw.Replace("{login}", "离线")
End If
Case McLoginType.Ms
Raw = Raw.Replace("{login}", "正版")
Case McLoginType.Nide
Raw = Raw.Replace("{login}", "统一通行证")
Case McLoginType.Auth
Raw = Raw.Replace("{login}", "Authlib-Injector")
End Select
Raw = Raw.Replace("{name}", McVersionCurrent.Name)
If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
Raw = Raw.Replace("{version}", McVersionCurrent.Name)
Else
Raw = Raw.Replace("{version}", McVersionCurrent.Version.McName)
End If
Raw = Raw.Replace("{path}", Path)
Return Raw
End Function
#End Region
End Module
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+93 -44
View File
@@ -68,7 +68,7 @@ Public Module ModMinecraft
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Critical)
Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Red)
Continue For
End If
Dim Name As String = Folder.Split(">")(0)
@@ -86,7 +86,7 @@ Public Module ModMinecraft
Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
Catch ex As Exception
MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
End Try
Next
@@ -261,6 +261,12 @@ Public Module ModMinecraft
''' 显示的描述文本。
''' </summary>
Public Info As String = "该版本未被加载，请向作者反馈此问题"
Public ReadOnly Property HasCustomInfo As Boolean
Get
Return ReadIni(Path & "PCL\Setup.ini", "CustomInfo") <> ""
End Get
End Property
''' <summary>
''' 该版本的列表检查原始结果，不受自定义影响。
''' </summary>
@@ -695,7 +701,7 @@ Recheck:
Catch ex As Exception
Log(ex, "依赖版本检查出错（" & Name & "）")
State = McVersionState.Error
Info = "未知错误：" & GetExceptionSummary(ex)
Info = "未知错误：" & ex.GetBrief()
Return False
End Try
@@ -784,7 +790,17 @@ ExitDataLoad:
End If
'确定版本描述
Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
If CustomInfo <> "" Then
Info = CustomInfo
Else
Info = GetVersionDescription()
If State = McVersionState.Fool Then
Info = GetMcFoolName(Version.McName)
ElseIf State <> McVersionState.Error Then
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
End If
'确定版本收藏状态
IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
'确定版本显示种类
@@ -808,7 +824,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub)
End If
Catch ex As Exception
Info = "未知错误：" & GetExceptionSummary(ex)
Info = "未知错误：" & ex.GetBrief()
Logo = PathImage & "Blocks/RedstoneBlock.png"
State = McVersionState.Error
Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback)
@@ -817,11 +833,13 @@ ExitDataLoad:
End Try
Return Me
End Function
Public IsLoaded As Boolean = False
''' <summary>
''' 获取版本的默认描述。
''' 获取对该版本的简短描述。
''' 例如 “快照 16w01a”、“原版 1.12.2”、“愚人节版本 2.0”。
''' </summary>
Public Function GetDefaultDescription() As String
Dim Info As String = ""
Public Function GetVersionDescription() As String
Dim Info As String
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
@@ -838,21 +856,38 @@ ExitDataLoad:
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Info = "愚人节版本 " & Version.McName
Case McVersionState.Error
Return Me.Info '已有错误信息
Case Else
Info = "发生了未知错误，请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Return Info
End Function
Public IsLoaded As Boolean = False
Public Function ToListItem() As MyListItem
Dim NewItem As New MyListItem With {.Info = Info, .Height = 42, .Tag = Me, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
'标题
NewItem.Inlines.Clear()
NewItem.Inlines.Add(New Run(Name))
If HasCustomInfo Then '如果版本设置了自定义描述，在标题后面以淡灰色显示其版本号
NewItem.Inlines.Add(New Run(" | " & GetVersionDescription()) With {.Foreground = New MyColor(215, 215, 215), .FontSize = 12})
End If
'Logo
Try
If Logo.EndsWith("PCL\Logo.png") Then
NewItem.Logo = Path & "PCL\Logo.png" '修复老版本中，存储的自定义 Logo 使用完整路径，导致移动后无法加载的 Bug
Else
NewItem.Logo = Logo
End If
Catch ex As Exception
Log(ex, "加载版本图标失败", LogLevel.Hint)
NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
End Try
Return NewItem
End Function
'运算符支持
Public Overrides Function Equals(obj As Object) As Boolean
Dim version = TryCast(obj, McVersion)
Return version IsNot Nothing AndAlso Path = version.Path
@@ -865,7 +900,6 @@ ExitDataLoad:
Public Shared Operator <>(a As McVersion, b As McVersion) As Boolean
Return Not (a = b)
End Operator
End Class
Public Enum McVersionState
[Error]
@@ -1186,6 +1220,7 @@ OnLoaded:
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Loader.IsAborted Then Return '#5617
WriteIni(Path & "PCL.ini", "VersionCache", "") '要求下次重新加载
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
End Try
@@ -1566,12 +1601,12 @@ OnLoaded:
Try
Dim Image As New MyBitmap(FileName)
If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素！", HintType.Critical)
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素！", HintType.Red)
Return New McSkinInfo With {.IsVaild = False}
End If
Dim FileInfo As New FileInfo(FileName)
If FileInfo.Length > 24 * 1024 Then
Hint("皮肤文件大小需小于 24 KB，而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Critical)
Hint("皮肤文件大小需小于 24 KB，而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Red)
Return New McSkinInfo With {.IsVaild = False}
End If
Catch ex As Exception
@@ -1592,11 +1627,11 @@ OnLoaded:
''' <summary>
''' 获取 Uuid 对应的皮肤文件地址，失败将抛出异常。
''' </summary>
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
If Uuid = "" Then Throw New Exception("Uuid 为空。")
If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
Public Function McSkinGetAddress(UUID As String, Type As String) As String
If UUID = "" Then Throw New Exception("UUID 为空。")
If UUID.StartsWithF("00000") AndAlso Type <> "Auth" Then Throw New Exception("离线 UUID 无正版皮肤文件：" & UUID)
'尝试读取缓存
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID)
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
'获取皮肤地址
Dim Url As String
@@ -1610,7 +1645,7 @@ OnLoaded:
Case Else
Throw New ArgumentException("皮肤地址种类无效：" & If(Type, "null"))
End Select
Dim SkinString = NetRequestByClientRetry(Url & Uuid)
Dim SkinString = NetRequestByClientRetry(Url & UUID, RequireJson:=True)
If SkinString = "" Then Throw New Exception("皮肤返回值为空，可能是未设置自定义皮肤的用户")
'处理皮肤地址
Dim SkinValue As String
@@ -1635,8 +1670,8 @@ OnLoaded:
SkinValue = If(SkinUrl.Contains("minecraft.net/"), SkinUrl.Replace("http://", "https://"), SkinUrl)
End If
'保存缓存
WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid, SkinValue)
Log("[Skin] UUID " & Uuid & " 对应的皮肤文件为 " & SkinValue)
WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID, SkinValue)
Log("[Skin] UUID " & UUID & " 对应的皮肤文件为 " & SkinValue)
Return SkinValue
End Function
@@ -1891,17 +1926,29 @@ OnLoaded:
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
.LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
CustomMcFolder & "libraries\" & Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")),
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
$"{CustomMcFolder}libraries\{Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")}"),
.Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString),
.IsNatives = True,
.SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
Else
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End If
Catch ex As Exception
Log(ex, "处理实际支持库列表失败（有 Natives，" & If(Library("name"), "Nothing").ToString & "）")
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End Try
End If
@@ -1966,7 +2013,7 @@ OnLoaded:
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)))
DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version), RequireJson:=True))
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
End Try
@@ -1983,16 +2030,20 @@ OnLoaded:
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
Dim TargetFile = PathPure & "\authlib-injector.jar"
Dim TargetFile = PathPure & "authlib-injector.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetRequestByClientRetry(
"https://authlib-injector.yushi.moe/artifact/latest.json",
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"))
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
Catch ex As Exception
Log(ex, "获取 Authlib-Injector 下载信息失败")
If File.Exists(TargetFile) Then
Log(ex, "获取 Authlib-Injector 下载信息失败")
Else
Throw New Exception("获取 Authlib-Injector 下载信息失败", ex)
End If
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
@@ -2091,19 +2142,12 @@ OnLoaded:
''' <param name="WithHead">是否包含 Lib 文件夹头部，若不包含，则会类似以 com\xxx\ 开头。</param>
Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
'有时候原始的有四段，例如 net.minecraftforge:forge:1.21.4-54.0.34:client
'文件夹名应该忽略最后一段（client），但文件名需要保留
'参见 #7306（以及 #5376 也是因为这里没有处理好导致的）
Dim Splited = Original.Split(":")
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer
If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1).BeforeFirst("_"))
Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 2, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
End If
End If
$"{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited.Skip(1).Join("-")}.jar"
End Function
''' <summary>
@@ -2415,7 +2459,12 @@ NextEntry:
Public Function FilterUserName(Raw As String, FilterChar As Char) As String
If Raw.Contains(":\Users\") Then
For Each Token In RegexSearch(Raw, "(?<=:\\Users\\)[^\\]+")
Raw = Raw.Replace("\" & Token, "\" & New String(FilterChar, Token.Count))
Raw = Raw.Replace("\Users\" & Token, "\Users\" & New String(FilterChar, Token.Count))
Next
End If
If Raw.Contains(":/Users/") Then
For Each Token In RegexSearch(Raw, "(?<=:/Users/)[^/]+")
Raw = Raw.Replace("/Users/" & Token, "/Users/" & New String(FilterChar, Token.Count))
Next
End If
Return Raw
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+11 -10
View File
@@ -73,7 +73,7 @@ Public Module ModMod
Get
If _Name Is Nothing Then Load()
If _Name Is Nothing Then _Name = _ModId
If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path)
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
Set(value As String)
@@ -688,7 +688,7 @@ Finished:
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) AndAlso ChangelogUrls.Any()
End Get
End Property
@@ -1113,8 +1113,8 @@ Finished:
End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Return
Thread.Sleep(10)
If Loader.IsAborted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -1126,6 +1126,7 @@ Finished:
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsAborted Then Return
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
@@ -1212,7 +1213,7 @@ Finished:
If ReqVersionHead = ReqVersionTail Then
VersionRequire = "应为 " & ReqVersionHead
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
ElseIf ReqVersionHead.Contains(".") Then
If ReqVersionHeadCanEqual Then
VersionRequire = "最低应为 " & ReqVersionHead
@@ -1230,7 +1231,7 @@ Finished:
End If
'检查前置 Mod 是否存在，并获取其版本
If Not CurrentDependencies.ContainsKey(ReqId) Then
Result.Add("缺少前置 Mod：" & ReqId & If(VersionRequire = "", "", "，其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"缺少前置 Mod：{ReqId}{If(VersionRequire = "", "", "，其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
@@ -1239,7 +1240,7 @@ Finished:
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), ""))
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
@@ -1247,26 +1248,26 @@ Finished:
If ReqVersionTail.Contains(".") Then
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), ""))
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
Else
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
Result.Add("缺少前置 Mod：" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"缺少前置 Mod：{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
End If
Next
Catch ex As Exception
Result.Add("检查 Mod 时出错：" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"检查 Mod 时出错：{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
Log(ex, "检查 Mod 时出错")
End Try
Next
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log("[Minecraft] Mod 检查异常结果：" & vbCrLf & Join(Result, vbCrLf))
Log($"[Minecraft] Mod 检查异常结果：{vbCrLf}{Join(Result, vbCrLf)}")
End If
Return Result
End Function
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+34 -25
View File
@@ -31,7 +31,7 @@ Public Module ModModpack
Try
'字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Critical) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
@@ -72,7 +72,7 @@ Public Module ModModpack
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next
Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
If ex.GetDetail(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
@@ -158,6 +158,7 @@ Retry:
If File.Exists(OverridesIni) Then
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
WriteIni(OverridesIni, "IsStar", False)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
@@ -165,6 +166,15 @@ Retry:
End If
IniClearCache(VersionIni) '重置缓存，避免被安装过程中写入的 ini 覆盖
End Sub
''' <summary>
''' 弹窗提示整合包中存在不兼容的加载器。
''' 如果取消，则抛出 CancelledException。
''' </summary>
''' <exception cref="CancelledException" />
Private Sub NotifyIncompatibleLoader(LoaderName As String)
If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
End Sub
#Region "不同类型整合包的安装方法"
@@ -210,7 +220,8 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本：" & Id)
FabricVersion = Id.Replace("fabric-", "")
Else
Log("[ModPack] 未知 Mod 加载器：" & Id)
'ElseIf Id.StartsWithF("quilt-") Then
NotifyIncompatibleLoader(Id)
End If
Next
'解压
@@ -324,7 +335,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
End If
@@ -333,7 +344,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
@@ -375,12 +386,9 @@ Retry:
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
Throw New CancelledException
Case Else
Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical)
Throw New CancelledException
'Case "quilt-loader" 'eg. 1.0.0
NotifyIncompatibleLoader(Entry.Name)
End Select
Next
'获取版本名
@@ -468,7 +476,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
End If
@@ -477,7 +485,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = $"Modrinth 整合包安装：{VersionName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
@@ -532,7 +540,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
'启动
@@ -631,8 +639,9 @@ Retry:
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
Select Case If(Component("uid"), "").ToString
For Each Component As JObject In PackJson("components")
If Not Component.ContainsKey("uid") Then Continue For
Select Case Component("uid").ToString
Case "org.lwjgl"
Log("[ModPack] 已跳过 LWJGL 项")
Case "net.minecraft"
@@ -643,9 +652,9 @@ Retry:
Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
Throw New CancelledException
Case Else
'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
NotifyIncompatibleLoader(Component("uid"))
End Select
Next
'构造加载器
@@ -658,7 +667,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
@@ -716,7 +725,7 @@ Retry:
Next
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
Throw New CancelledException
End If
Dim Request As New McInstallRequest With {
@@ -737,7 +746,7 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
@@ -757,7 +766,7 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -786,7 +795,7 @@ Retry:
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
Return
@@ -834,8 +843,8 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+1 -1
View File
@@ -349,7 +349,7 @@
State = MinecraftState.Crashed
'崩溃分析
WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Critical)
Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Red)
FeedbackInfo()
RunInNewThread(
Sub()