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

2.12.8.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+140 -147
View File
@@ -9,7 +9,7 @@
TempFolder = RequestTaskTempFolder()
DirectoryUtils.Create(TempFolder & "Temp\")
DirectoryUtils.Create(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder)
Logger.Info($"崩溃分析暂存文件夹：{TempFolder}")
End Sub
'1：准备用于分析的 Log 文件
@@ -19,35 +19,30 @@
''' </summary>
''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param>
Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing)
Log("[Crash] 步骤 1：收集日志文件")
Logger.Info("步骤 1：收集日志文件")
'简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String)
Try
Dim DirInfo As New DirectoryInfo(VersionPathIndie & "crash-reports\")
If DirInfo.Exists Then
For Each File In DirInfo.EnumerateFiles
PossibleLogs.Add(File.FullName)
Next
End If
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
Catch ex As Exception
Log(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try
Try
For Each File In New DirectoryInfo(VersionPathIndie).Parent.Parent.EnumerateFiles
For Each File In DirectoryUtils.GetInfo(VersionPathIndie).Parent.Parent.EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName)
PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 主文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 主文件夹下的日志失败")
End Try
Try
For Each File In New DirectoryInfo(VersionPathIndie).EnumerateFiles
For Each File In DirectoryUtils.GetInfo(VersionPathIndie).EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName)
PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 隔离文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 隔离文件夹下的日志失败")
End Try
PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志
PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志
@@ -57,74 +52,75 @@
Dim RightLogs As New List(Of String)
For Each LogFile In PossibleLogs
Try
Dim Info As New FileInfo(LogFile)
Dim Info = FileUtils.GetInfo(LogFile)
If Not Info.Exists Then Continue For
Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes)
If Time < 3 AndAlso Info.Length > 0 Then
RightLogs.Add(LogFile)
Log("[Crash] 可能可用的日志文件：" & LogFile & "（" & Math.Round(Time, 1) & " 分钟）")
Logger.Info($"可能可用的日志文件：{LogFile}（{Math.Round(Time, 1)} 分钟）")
End If
Catch ex As Exception
Log(ex, "确认崩溃日志时间失败（" & LogFile & "）")
Logger.Warn(ex, $"确认崩溃日志时间失败（{LogFile}）")
End Try
Next
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
If Not RightLogs.Any() Then Logger.Info("未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
Try
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Split(vbCrLf.ToCharArray)))
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, FileUtils.ReadAsLines(FilePath)))
Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
Logger.Warn(ex, $"读取可能的崩溃日志文件失败（{FilePath}）")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
Logger.Info($"以下为游戏输出的最后一段内容：{vbCrLf}{RawOutput}")
FileUtils.Write(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear()
End If
Log("[Crash] 步骤 1：收集日志文件完成，收集到 " & AnalyzeRawFiles.Count & " 个文件")
Logger.Info($"步骤 1：收集日志文件完成，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub
''' <summary>
''' 从文件路径直接导入日志文件或崩溃报告压缩包。
''' </summary>
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1：自主导入日志文件")
Logger.Info("步骤 1：自主导入日志文件")
'尝试视作压缩包解压
Try
Dim Info As New FileInfo(FilePath)
Dim Info = FileUtils.GetInfo(FilePath)
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractCompressedFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件：" & FilePath)
FileUtils.ExtractToDirectory(FilePath, TempFolder & "Temp\")
Logger.Info($"已解压导入的日志文件：{FilePath}")
GoTo Extracted
End If
Catch
End Try
'并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath)
FileUtils.Copy(FilePath, TempFolder & "Temp\" & PathUtils.GetLastPart(FilePath))
Logger.Info($"已复制导入的日志文件：{FilePath}")
Extracted:
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
For Each TargetFile As FileInfo In DirectoryUtils.GetInfo(TempFolder & "Temp\").EnumerateFiles
Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.Lower
If Ext = ".log" OrElse Ext = ".txt" Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(
PathUtils.RemoveExtendedPrefix(TargetFile.FullName), FileUtils.ReadAsLines(TargetFile.FullName)))
Else
File.Delete(TargetFile.FullName)
FileUtils.Delete(TargetFile.FullName)
End If
Catch ex As Exception
Log(ex, "导入单个日志文件失败")
Logger.Warn(ex, "导入单个日志文件失败")
End Try
Next
Log("[Crash] 步骤 1：自主导入日志文件，收集到 " & AnalyzeRawFiles.Count & " 个文件")
Logger.Info($"步骤 1：自主导入日志文件，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub
'2：确认实际用于分析的 Log 文本
@@ -141,25 +137,25 @@ Extracted:
''' 返回是否有足够信息可用于分析。
''' </summary>
Public Function Prepare() As Boolean
Log("[Crash] 步骤 2：准备日志文本")
Logger.Info("步骤 2：准备日志文本")
'对日志文件进行分类
DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower
Dim MatchName As String = PathUtils.GetLastPart(LogFile.Key).Lower
Dim TargetType As AnalyzeFileType
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
MatchName = "debug.log" OrElse MatchName = "debug log.txt" OrElse
MatchName = "游戏崩溃前的输出.txt" OrElse MatchName = "rawoutput.log" Then
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
DirectFile = LogFile
ElseIf MatchName = "启动器日志.txt" OrElse MatchName = "PCL2 启动器日志.txt" OrElse MatchName = "PCL 启动器日志.txt" OrElse MatchName = "log1.txt" Then
If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then
TargetType = AnalyzeFileType.MinecraftLog
@@ -172,20 +168,20 @@ Extracted:
ElseIf MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraReportFile
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Logger.Info($"{MatchName} 分类为 Ignore")
Continue For
End If
If LogFile.Value.Any Then
AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType))
Logger.Info($"{MatchName} 分类为 {TargetType}")
Else
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Logger.Info($"{MatchName} 由于内容为空跳过")
End If
Next
'若只有额外日志，则将它们视作 Minecraft 日志
If AllFiles.Any() AndAlso AllFiles.All(Function(p) p.Key = AnalyzeFileType.ExtraLogFile) Then
Log("[Crash] 由于仅发现了额外日志，将它们视作 Minecraft 日志进行分析")
Logger.Info("由于仅发现了额外日志，将它们视作 Minecraft 日志进行分析")
AllFiles = AllFiles.Select(Function(p) New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(AnalyzeFileType.MinecraftLog, p.Value)).ToList
End If
@@ -205,9 +201,9 @@ Extracted:
Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))()
For Each File In SelectedFiles
Try
DatedFiles.Add(New FileInfo(File.Key).LastWriteTime, File)
DatedFiles.Add(FileUtils.GetInfo(File.Key).LastWriteTime, File)
Catch ex As Exception
Log(ex, "获取日志文件修改时间失败")
Logger.Warn(ex, "获取日志文件修改时间失败")
DatedFiles.Add(New Date(1900, 1, 1), File)
End Try
Next
@@ -216,12 +212,12 @@ Extracted:
OutputFiles.Add(NewestFile.Key)
If SelectType = AnalyzeFileType.HsErr Then
LogHs = GetHeadTailLines(NewestFile.Value, 200, 100)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为虚拟机错误信息")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为虚拟机错误信息")
Logger.Info($"输出报告：{NewestFile.Key}，作为虚拟机错误信息")
Logger.Info($"导入分析：{NewestFile.Key}，作为虚拟机错误信息")
Else
LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
Logger.Info($"输出报告：{NewestFile.Key}，作为 Minecraft 崩溃报告")
Logger.Info($"导入分析：{NewestFile.Key}，作为 Minecraft 崩溃报告")
End If
Case AnalyzeFileType.MinecraftLog
LogMc = ""
@@ -229,9 +225,9 @@ Extracted:
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
FileNameDict(PathUtils.GetLastPart(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志")
Logger.Info($"输出报告：{SelectedFile.Key}，作为 Minecraft 或启动器日志")
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
@@ -244,13 +240,13 @@ Extracted:
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL 输出的游戏实时日志头")
Logger.Info("找到 PCL 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为启动器日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为启动器日志")
Exit For
Next
'选择一份最佳的 Minecraft Log
@@ -258,7 +254,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft 日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft 日志")
Exit For
Next
'查找 Debug Log
@@ -266,7 +262,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft Debug 日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft Debug 日志")
Exit For
Next
'兜底
@@ -276,7 +272,7 @@ Extracted:
ElseIf FileNameDict.Any() Then '如果都没有找到，则使用第一个文件
Dim CurrentLog = FileNameDict.First.Value
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为兜底日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为兜底日志")
Else
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
@@ -287,21 +283,22 @@ Extracted:
'全部丢过去
For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，不用作分析")
Logger.Info($"输出报告：{SelectedFile.Key}，不用作分析")
Next
End Select
Catch ex As Exception
Log(ex, "分类处理日志文件时出错")
Logger.Warn(ex, "分类处理日志文件时出错")
End Try
Next
'结束
Prepare = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Prepare Then
Log(("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Dim Result = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Result Then
Logger.Info($"{("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、")}用作分析")
Else
Log("[Crash] 步骤 2：准备日志文本完成，没有任何可供分析的日志")
Logger.Info("步骤 2：准备日志文本完成，没有任何可供分析的日志")
End If
Return Result
End Function
''' <summary>
''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
@@ -392,7 +389,7 @@ Extracted:
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze()
Log("[Crash] 步骤 3：分析崩溃原因")
Logger.Info("步骤 3：分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
'1. 精准日志匹配，中/高优先级
@@ -406,21 +403,21 @@ Extracted:
Dim Keywords As New List(Of String)
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Logger.Info("开始进行崩溃日志堆栈分析")
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If
'Minecraft 日志
If LogMc IsNot Nothing Then
Dim Fatals As List(Of String) = RegexSearch(LogMc, "/FATAL] .+?(?=[\n]+\[)")
Dim Fatals As List(Of String) = LogMc.RegexSearch("/FATAL] .+?(?=[\n]+\[)").ToList
If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper"))
Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项")
Logger.Info($"开始进行 Minecraft 日志堆栈分析，发现 {Fatals.Count} 个报错项")
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
End If
'虚拟机日志
If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析")
Logger.Info("开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
@@ -435,7 +432,7 @@ Extracted:
GoTo Done
End If
Else
Log("[Crash] 可能并未安装 Mod，不进行堆栈分析")
Logger.Info("可能并未安装 Mod，不进行堆栈分析")
End If
'3. 精准日志匹配，低优先级
@@ -444,27 +441,27 @@ Extracted:
'输出到日志
Done:
If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3：分析崩溃原因完成，未找到可能的原因")
Logger.Info("步骤 3：分析崩溃原因完成，未找到可能的原因")
Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因")
Logger.Info($"步骤 3：分析崩溃原因完成，找到 {CrashReasons.Count} 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Reason.Value.Join("；"c) & "）", ""))
Logger.Info($"- {Reason.Key}{If(Reason.Value.Any, "（" & Reason.Value.Join("；"c) & "）", "")}")
Next
End If
End Sub
''' <summary>
''' 增加一个可能的崩溃原因。
''' </summary>
Private Sub AppendReason(Reason As CrashReason, Optional Additional As ICollection(Of String) = Nothing)
Private Sub AppendReason(Reason As CrashReason, Optional Additional As IEnumerable(Of String) = Nothing)
If CrashReasons.ContainsKey(Reason) Then
If Additional IsNot Nothing Then
CrashReasons(Reason).AddRange(Additional)
CrashReasons(Reason) = CrashReasons(Reason).Distinct.ToList
End If
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}).ToList))
End If
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Additional.Join("；"c) & "）", ""))
Logger.Info($"可能的崩溃原因：{Reason}{If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Additional.Join("；"c) & "）", "")}")
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -485,7 +482,7 @@ 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
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(LogCrash.RegexSeek("(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
End If
'游戏日志分析
@@ -495,7 +492,6 @@ Done:
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)
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>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'java.lang.String com.mojang.blaze3d.systems.RenderSystem.getBackendDescription") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
@@ -515,7 +511,7 @@ Done:
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void 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("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(LogMc.RegexSeek("(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
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版本不兼容)
@@ -536,18 +532,18 @@ Done:
End If
End If
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(LogMc.RegexSeek("(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, LogMc.RegexSearch("(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, If(LogMc.RegexSeek("Found a duplicate mod[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, LogMc.RegexSearch("(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, If(LogMc.RegexSeek("ModResolutionException: Duplicate[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
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))
AppendReason(CrashReason.Mod互不兼容, If(LogMc.RegexSeek("(?<=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版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
LogMc.RegexSearch("(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
End If
End If
@@ -569,19 +565,19 @@ Done:
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogCrash.Contains("has mods that were not found") AndAlso LogCrash.RegexCheck("The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsIgnoreCase(".jar") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(LogCrashMod.RegexSeek("(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
AppendReason(CrashReason.Mod加载器报错, If(LogCrash.RegexSeek("(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If
End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
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)})
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(LogCrash.RegexSeek("(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If
End Sub
@@ -600,14 +596,14 @@ Done:
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
If Not IsMixin Then Return False
'Mod 名称匹配
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
Dim ModName As String = LogText.RegexSeek("(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = LogText.RegexSeek("(?<=for mod )[^.\/ ]+(?= failed)")
If ModName IsNot Nothing Then
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
Return True
End If
'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
For Each JsonName In LogText.RegexSearch("(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
@@ -622,12 +618,12 @@ Done:
'Mixin 崩溃
Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息
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报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, LogMc.RegexSeek("(?<=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报错并给出解决方案, If(LogMc.RegexSeek("(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, If(LogMc.RegexSeek("(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, If(LogMc.RegexSeek("(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogMc.RegexSeek("(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
End If
@@ -639,7 +635,7 @@ Done:
If LogCrash.Contains("Suspected Mod") Then
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
Dim Suspects = SuspectsRaw.RegexSearch("(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If
@@ -660,14 +656,14 @@ Done:
'Mod 解析错误（常见于 Fabric 前置校验失败）
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.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)))
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(LogMc.RegexSeek("(?<=Failed to create mod instance. ModID: )[^,]+"), If(LogMc.RegexSeek("(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
'注意：Fabric 的 Warnings were found! 不一定是崩溃原因，它可能是单纯的警报
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(RegexSeek(LogCrash, "(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(RegexSeek(LogCrash, "(?<=\tBlock location: World: )\([^\)]+\)"), ""))
If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(LogCrash.RegexSeek("(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(LogCrash.RegexSeek("(?<=\tBlock location: World: )\([^\)]+\)"), ""))
If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(LogCrash.RegexSeek("(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(LogCrash.RegexSeek("(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
End If
End Sub
@@ -679,8 +675,8 @@ Done:
'进行正则匹配
Dim StackSearchResults As New List(Of String)
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx
StackSearchResults.AddRange(ErrorStack.RegexSearch("(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(ErrorStack.RegexSearch("(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx
StackSearchResults = StackSearchResults.Distinct.ToList
'检查堆栈开头
@@ -698,10 +694,10 @@ Done:
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
Logger.Info($"找到 {PossibleStacks.Count} 条可能的堆栈信息")
If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Logger.Info($"- {Stack}")
Next
'检查堆栈关键词
@@ -724,10 +720,10 @@ NextStack:
Next
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", "))
Logger.Info($"从堆栈信息中找到 {PossibleWords.Count} 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Logger.Info($"- {PossibleWords.Join(", ")}")
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑")
Logger.Info("关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String)
Else
Return PossibleWords
@@ -738,7 +734,7 @@ NextStack:
''' 根据 Mod 关键词尝试获取实际的 Mod 名称。
''' 若失败则返回 Nothing。
''' </summary>
Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String)
Private Function AnalyzeModName(Keywords As IEnumerable(Of String)) As List(Of String)
Dim ModFileNames As New List(Of String)
'预处理关键词（分割括号）
@@ -756,7 +752,7 @@ NextStack:
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
Logger.Info("崩溃报告中检测到 Fabric Mod 信息格式")
End If
Details = Details.AfterLast("¨")
@@ -765,9 +761,9 @@ NextStack:
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If (Line.ContainsIgnoreCase(".jar") AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not Line.RegexCheck("\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
Logger.Info($"崩溃报告中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
@@ -781,18 +777,18 @@ NextStack:
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 崩溃报告中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
Logger.Info($"崩溃报告中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Logger.Info($"- {ModLine}")
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Name = Line.RegexSeek("(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
Name = Line.RegexSeek("(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
@@ -803,8 +799,8 @@ NextStack:
If LogMcDebug IsNot Nothing Then
'Forge: Found valid mod file YungsBetterStrongholds-1.20-Forge-4.0.1.jar with {betterstrongholds} mods - versions {1.20-Forge-4.0.1}
Dim ModNameLines As List(Of String) = RegexSearch(LogMcDebug, "(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Log("[Crash] Debug 信息中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
Dim ModNameLines = LogMcDebug.RegexSearch("(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Logger.Info($"Debug 信息中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
@@ -814,15 +810,15 @@ NextStack:
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] Debug 信息中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
Logger.Info($"Debug 信息中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Logger.Info($"- {ModLine}")
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
Name = RegexSeek(Line, ".*(?= with)")
Name = Line.RegexSeek(".*(?= with)")
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
@@ -833,9 +829,9 @@ NextStack:
If Not ModFileNames.Any() Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
Logger.Info($"找到 {ModFileNames.Count} 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Logger.Info($"- {ModFileName}")
Next
Return ModFileNames
End If
@@ -851,9 +847,9 @@ NextStack:
''' <summary>
''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords
Return If(AnalyzeModName(Keywords), Keywords)
Private Function TryAnalyzeModName(Keywords As IEnumerable(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords.ToList
Return If(AnalyzeModName(Keywords), Keywords.ToList)
End Function
'4：根据原因输出信息
@@ -866,11 +862,11 @@ NextStack:
FrmMain.ShowWindowToTop()
Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"),
"确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看输出"), If(IsManualAnalyze, "", "导出错误报告"),
Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub()
'弹窗选择：查看日志
If File.Exists(DirectFile.Value.Key) Then
'弹窗选择：查看输出
If FileUtils.Exists(DirectFile.Value.Key) Then
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
@@ -883,17 +879,16 @@ NextStack:
Dim FileAddress As String = Nothing
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Return
If File.Exists(FileAddress) Then File.Delete(FileAddress)
DirectoryUtils.Create(FileAddress, isFilePath:=True)
RunInUiWait(Sub() FileAddress = Dialogs.SaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", filter:={("zip", "Minecraft 错误报告")}))
If FileAddress Is Nothing Then Return
FileUtils.Delete(FileAddress)
'输出诊断信息
FeedbackInfo()
LogFlush()
Logger.Instance.Flush()
'复制文件
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile)
Dim FileName As String = PathUtils.GetLastPart(OutputFile)
Dim FileEncoding As Encoding = Nothing
Select Case FileName
Case "LatestLaunch.bat"
@@ -905,23 +900,21 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
FileEncoding = Encoding.UTF8
End Select
If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
End If
If Not FileUtils.Exists(OutputFile) Then Continue For
Dim FileContent As String = FileUtils.ReadAsString(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, FileEncoding)
Logger.Info($"导出错误报告文件：{FileName}")
Next
'导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\")
FileUtils.CreateZipFromDirectory(FileAddress, TempFolder & "Report\")
DirectoryUtils.Delete(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Green)
OpenExplorer(FileAddress)
Catch ex As Exception
Log(ex, "导出错误报告失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "导出错误报告失败")
Return
End Try
OpenExplorer(FileAddress)
End Select
'上报
If IsManualAnalyze Then Return
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+59 -57
View File
@@ -13,7 +13,7 @@
Instance = New McInstance(Instance.InheritName)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
Logger.Warn(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
@@ -39,7 +39,7 @@
'获取信息
Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Logger.Info($"版本 {Instance.Name} 对应的资源文件索引为 {IndexInfo("id")}")
Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then
Return Nothing
@@ -65,7 +65,7 @@
#Region "下载资源文件"
If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查")
Logger.Info("已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
@@ -75,7 +75,7 @@
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
@@ -96,7 +96,7 @@
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
Task.Interrupt()
Throw New ThreadInterruptedException
End If
@@ -105,19 +105,19 @@
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新：每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引，取消")
If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
Logger.Info("无需更新资源文件索引，取消")
Task.Interrupt()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
FileUtils.Copy(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台检查资源文件索引")
Logger.Info("开始后台检查资源文件索引")
Updater.Start()
End If
'获取资源文件地址
@@ -158,8 +158,8 @@
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then
_AllDrops = Settings.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
_AllDrops = Settings.Get(Of String)("CacheDrops").ToString.
Split(",", True).Select(Function(d) CInt(Val(d))).ToList()
End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing，以防止反复获取设置尝试初始化
End Get
@@ -191,7 +191,7 @@
''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -211,7 +211,9 @@
'提取所有 Drop 序数
Dim Drops As New List(Of Integer)
For Each Version As JObject In Loader.Output.Value("versions")
Dim Drop As Integer = McVersion.VersionToDrop(Version("id"))
Dim Id As String = Version("id").ToString
If Id.Contains("-") Then Continue For
Dim Drop As Integer = McVersion.VersionToDrop(Id)
If Drop = 209 Then Continue For
Drops.Add(Drop)
Next
@@ -233,10 +235,10 @@
If Not DlPreferMojang Then
Dim DeltaTime = GetTimeMs() - StartTime
DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'MC 更新提示
@@ -244,16 +246,16 @@
Dim Version As String
'快照版
Version = Json("latest")("snapshot")
If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
If Settings.Get(Of Boolean)("ToolUpdateSnapshot") AndAlso Not Settings.Get(Of String)("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get(Of String)("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
If Settings.Get(Of Boolean)("ToolUpdateRelease") AndAlso Not Settings.Get(Of String)("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get(Of String)("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
@@ -272,7 +274,7 @@
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
'检查是否有要求的版本（#5195）
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
@@ -313,10 +315,10 @@
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", NotifyLevel.DebugModeOnly)
Logger.Warn($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value}")
Return Nothing
Catch ex As Exception
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Logger.Warn(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -385,7 +387,7 @@
''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -413,9 +415,9 @@
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
Try
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
Dim Forge As List(Of String) = Result.RegexSearch("(?<=colForge'>)[^<]*").ToList
Dim ReleaseTime As List(Of String) = Result.RegexSearch("(?<=colDate'>)[^<]+").ToList
Dim Name As List(Of String) = Result.RegexSearch("(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")").ToList
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
@@ -491,7 +493,7 @@
''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
@@ -518,7 +520,7 @@
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|[_-]snapshot[_-]?)[0-9]?)?(?=.html)")
Dim Names As List(Of String) = Result.RegexSearch("(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)").ToList
Names.Add("1.2.4") '1.2.4 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -640,7 +642,7 @@
Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
@@ -669,7 +671,7 @@
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then
If ex.GetDisplay(False).Contains("(404)") Then
Throw New Exception("无")
Else
Throw
@@ -685,14 +687,14 @@
Dim VersionCode = VersionCodes(i)
Try
'基础信息获取
Dim Name As String = RegexSeek(VersionCode, "(?<=[^(0-9)]+)[0-9\.]+")
Dim Name As String = VersionCode.RegexSeek("(?<=[^(0-9)]+)[0-9\.]+")
Dim IsRecommended As Boolean = VersionCode.Contains("fa promo-recommended")
Dim Inherit As String = Loader.Input
'分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
Dim Branch As String = VersionCode.RegexSeek($"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
'发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeOriginal = VersionCode.RegexSeek("(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式："2021-02-15 03:24:02"
Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
@@ -703,17 +705,17 @@
If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip，支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
'没有任何下载（1.6.4 有一部分这种情况）
@@ -875,7 +877,7 @@
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -931,7 +933,7 @@
End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
Dim VersionNames = (LatestLegacyJson & LatestJson).RegexSearch(
"(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
@@ -1000,7 +1002,7 @@
''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -1099,7 +1101,7 @@
''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1170,32 +1172,32 @@
''' </summary>
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Dim Urls As New List(Of (Url As String, Timeout As Integer))
Dim McimUrl As String = DlSourceModGet(Url)
If McimUrl <> Url Then
Select Case Settings.Get("ToolDownloadMod")
Select Case Settings.Get(Of Integer)("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add((McimUrl, 10))
Urls.Add((McimUrl, 10))
Urls.Add((Url, 30))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来
Urls.Add((McimUrl, 10))
Urls.Add((Url, 30))
Urls.Add((McimUrl, 30))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add((Url, 30))
Urls.Add((McimUrl, 30))
End Select
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add((Url, 30))
End If
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, RequireJson:=True))
Return GetJson(NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
@@ -1213,7 +1215,7 @@
''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean
Get
Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
Return Settings.Get(Of Integer)("ToolDownloadSource") = 2 OrElse (Settings.Get(Of Integer)("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
@@ -1227,7 +1229,7 @@
''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get
Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
Return Settings.Get(Of Integer)("ToolDownloadVersion") = 2 OrElse (Settings.Get(Of Integer)("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+79 -80
View File
@@ -79,8 +79,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径，不限制结尾。
''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\")
PathFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder))
Me.IsUserImport = IsUserImport
End Sub
@@ -94,18 +93,18 @@
Dim Output As String = Nothing
Try
'确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If Not FileUtils.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsIgnoreCase(n)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
If FileUtils.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not FileUtils.Exists(PathFolder & "javac.exe")
'运行 -version
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output)
Logger.Trace($"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 或系统存在问题")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
Dim VersionString = If(Output.RegexSeek("(?<=version "")[^""]+"), If(Output.RegexSeek("(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493，VersionString = "21.0.2.0.2"
Do While VersionString.Split(".").Count < 4
If VersionString.StartsWithF("1.") Then
@@ -117,7 +116,7 @@
If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为：{vbCrLf}{Output}", "")}")
Version = New Version(VersionString)
If Version.Minor = 0 Then
Log("[Java] 疑似 X.0.X.X 格式版本号：" & Version.ToString)
Logger.Info($"疑似 X.0.X.X 格式版本号：{Version}")
Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If
Is64Bit = Output.Contains("64-bit")
@@ -129,7 +128,7 @@
Catch ex As ThreadInterruptedException
Throw ex
Catch ex As Exception
Log("[Java] 检查失败的 Java 输出：" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
Logger.Info($"检查失败的 Java 输出：{If(PathJava, "Nothing")}{vbCrLf}{If(Output, "无程序输出")}")
Throw New Exception("检查 Java 失败（" & If(PathJava, "Nothing") & "）", ex)
End Try
IsChecked = True
@@ -165,25 +164,25 @@
Public Sub JavaListInit()
JavaList = New List(Of JavaEntry)
Try
If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then
If Settings.Get(Of Integer)("CacheJavaListVersion") < JavaListCacheVersion Then
'不使用缓存
Log("[Java] 要求 Java 列表缓存更新")
Logger.Info("要求 Java 列表缓存更新")
Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
Else
'使用缓存
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
For Each JsonEntry In GetJson(Settings.Get(Of String)("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", NotifyLevel.DevelopOnly)
Logger.Warn("初始化未找到可用的 Java，将自动触发搜索")
JavaSearchLoader.Start(0)
Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java：")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}"))
Logger.Info($"缓存中有 {JavaList.Count} 个可用的 Java：")
JavaList.ForEach(Sub(j) Logger.Info($"- {j}"))
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "初始化 Java 列表失败")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
@@ -205,7 +204,7 @@
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
JavaSearchFolder(PathUtils.AddSlashSuffix(PathUtils.RemoveLastPart(McFolderSelected)), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
End If
JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
@@ -219,9 +218,9 @@
'检查特定的 Java
If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java：")
Logger.Info($"检查后找到 {TargetJavaList.Count} 个特定路径下的 Java：")
For Each Java In TargetJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
End If
@@ -232,7 +231,7 @@
'获取版本独立设置中指定的 Java
Dim VersionSelect As String = ""
If GameInstance IsNot Nothing Then
VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
VersionSelect = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,28 +241,28 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
Logger.Error(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try
End If
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get(Of String)("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
UserJava = JavaEntry.FromJson(GetJson(Settings.Get(Of String)("LaunchArgumentJavaSelect")))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
Logger.Error(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try
End If
'添加到特定 Java 列表
If UserJava IsNot Nothing Then
Log($"[Java] 用户指定的 Java：{UserJava}")
Logger.Info($"用户指定的 Java：{UserJava}")
TargetJavaList.Add(UserJava)
End If
@@ -294,7 +293,7 @@ RetryGet:
'若未找到适合的 Java，尝试触发搜索
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java，尝试进行搜索")
Logger.Info("未找到满足条件的 Java，尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
End If
@@ -304,16 +303,16 @@ RetryGet:
'确保指定的 Java 可用
If UserJava Is Nothing Then GoTo ExitUserJavaCheck
If AllowedJavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
Log("[Java] 使用用户指定的 Java：" & UserJava.PathFolder)
Logger.Info($"使用用户指定的 Java：{UserJava.PathFolder}")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
GoTo UserPass
End If
'指定的 Java 不可用，弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java：" & UserJava.ToString)
Log($"[Java] 目前实际可用的 Java 列表：")
Logger.Info($"发现用户指定的不兼容 Java：{UserJava}")
Logger.Info($"目前实际可用的 Java 列表：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
Dim Requirement As String = ""
Dim ShowRevision As Boolean = False
@@ -330,20 +329,20 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
If GameInstance IsNot Nothing AndAlso Settings.Get(Of Boolean)("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", NotifyLevel.DebugModeOnly)
Logger.Warn($"设置中指定了使用 Java {JavaCurrent}，但当前版本{Requirement}，这可能会导致游戏崩溃！")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能导致游戏崩溃。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择。" & vbCrLf &
vbCrLf &
" - 指定的 Java：" & UserJava.ToString,
"Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL 自动选择
Case 2 '强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
Logger.Info("已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Case 3 '取消启动
Throw New Exception(CancelException)
@@ -364,7 +363,7 @@ ExitUserJavaCheck:
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
Log("[Java] 优先使用特定路径下的 Java：" & Java.ToString)
Logger.Info($"优先使用特定路径下的 Java：{Java}")
GoTo UserPass
End If
Next
@@ -372,9 +371,9 @@ UserPass:
'对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序：")
Logger.Info($"排序后的 Java 优先顺序：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
'检查选定的 Java，若测试失败则尝试进行搜索
@@ -384,23 +383,23 @@ UserPass:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso TypeOf (ex.InnerException) Is ThreadInterruptedException Then Throw ex.InnerException
Log(ex, "最终选定的 Java 已无法使用，尝试进行搜索")
If ex.InnerException IsNot Nothing AndAlso TypeOf ex.InnerException Is ThreadInterruptedException Then Throw ex.InnerException
Logger.Warn(ex, "最终选定的 Java 已无法使用，尝试进行搜索")
AllowedJavaList = New List(Of JavaEntry)
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
End Try
'返回
Log("[Java] 最终选定的 Java：" & AllowedJavaList.First.ToString)
Logger.Info($"最终选定的 Java：{AllowedJavaList.First}")
Return SelectedJava
Catch ex As ThreadInterruptedException
Log(ex, "查找符合条件的 Java 时出现加载器中断")
Logger.Warn(ex, "查找符合条件的 Java 时出现加载器中断")
Return Nothing
Catch ex As Exception
If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "查找符合条件的 Java 失败")
Return Nothing
End Try
End Function
@@ -410,9 +409,9 @@ UserPass:
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try
'检查强制指定
Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
Dim UserSetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
Dim UserSetupVersion As String = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If
If UserSetup <> "" Then
@@ -420,7 +419,7 @@ UserPass:
Try
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Logger.Warn(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava
End Try
@@ -435,7 +434,7 @@ NoUserJava:
Next
Return False
Catch ex As Exception
Log(ex, "检查 Java 类别时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "检查 Java 类别时出错")
Settings.Set("LaunchArgumentJavaSelect", "")
Return True
End Try
@@ -444,12 +443,12 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(PathExeFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
Dim PathInfo = DirectoryUtils.GetInfo(PathExeFolder)
ProgramPathParent = PathUtils.RemoveExtendedPrefix(If(PathInfo.Parent, PathInfo).FullName)
Dim PathMcInfo = DirectoryUtils.GetInfo(McFolderSelected)
If McFolderSelected <> "" Then MinecraftPathParent = PathUtils.RemoveExtendedPrefix(If(PathMcInfo.Parent, PathMcInfo).FullName)
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If McFolderSelected <> "" Then
@@ -505,12 +504,12 @@ NoUserJava:
#Region "模糊查找可能可用的 Java"
'查找环境变量中的 Java
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
For Each PathInEnv As String In (PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\").Split(";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
If FileUtils.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
@@ -530,15 +529,15 @@ NoUserJava:
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\")
Dim Info As FileSystemInfo = New FileInfo(Folder & "javaw.exe")
Dim Info As FileSystemInfo = FileUtils.GetInfo(Folder & "javaw.exe")
Do
If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
Log("[Java] 位于 " & Folder & " 的 Java 包含符号链接")
Logger.Info($"位于 {Folder} 的 Java 包含符号链接")
Continue For
End If
Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent)
Loop While Info IsNot Nothing
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
Logger.Info($"位于 {Folder} 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
@@ -547,7 +546,7 @@ NoUserJava:
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.Contains("system32") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径，不应优先使用")
Logger.Info($"位于 {Pair.Key} 的 Java 位于特殊路径，不应优先使用")
Else
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
@@ -558,14 +557,14 @@ NoUserJava:
#Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
Dim ImportedJava As String = Settings.Get(Of String)("LaunchArgumentJavaAll")
Try
For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject)
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "Java 列表已损坏")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
@@ -587,11 +586,11 @@ NoUserJava:
JavaList = NewJavaList
Catch ex As Exception
Log(ex, "搜索 Java 时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "搜索 Java 时出错")
JavaList = New List(Of JavaEntry)
End Try
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java")
Logger.Info($"Java 搜索完成，发现 {JavaList.Count} 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub
@@ -600,8 +599,8 @@ NoUserJava:
''' 多线程检查列表中的所有 Java 项。
''' </summary>
Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry)
Log("[Java] 开始确认列表 Java 状态，共 " & JavaEntries.Count & " 项")
JavaCheckList = New List(Of JavaEntry)
Logger.Info($"开始确认列表 Java 状态，共 {JavaEntries.Count} 项")
Dim Result = New List(Of JavaEntry)
Dim ListLock As New Object
'启动检查线程
@@ -611,16 +610,16 @@ NoUserJava:
Sub()
Try
Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString)
Logger.Trace($"- {Entry}")
SyncLock ListLock
JavaCheckList.Add(Entry)
Result.Add(Entry)
End SyncLock
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", NotifyLevel.AllUsers)
Logger.Error(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常，将被自动移除", LogBehavior.Toast)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
Logger.Warn(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常")
End If
End Try
End Sub)
@@ -634,6 +633,7 @@ Wait:
For Each CheckThread In CheckThreads
If CheckThread.IsAlive Then GoTo Wait
Next
Return Result
End Function
''' <summary>
''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。
@@ -642,12 +642,12 @@ Wait:
''' <param name="IsFullSearch">搜索当前文件夹下的全部文件夹（此参数不会传递到子文件夹）。</param>
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(OriginalPath), Results, Source, IsFullSearch)
Logger.Info($"开始{If(IsFullSearch, "完全", "部分")}遍历查找：{OriginalPath}")
JavaSearchFolder(DirectoryUtils.GetInfo(OriginalPath), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath)
Logger.Info($"遍历查找 Java 时遭遇无权限的文件夹：{OriginalPath}")
Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath & "）")
Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath}）")
End Try
End Sub
''' <summary>
@@ -659,10 +659,9 @@ Wait:
Try
'确认目录存在
If Not OriginalPath.Exists Then Return
Dim Folder As String = OriginalPath.FullName.Replace("\\", "\")
If Not Folder.EndsWithF("\") Then Folder += "\"
Dim Folder As String = PathUtils.AddSlashSuffix(PathUtils.ForCompare(OriginalPath.FullName))
'若该目录有 Java，则加入结果
If File.Exists(Folder & "javaw.exe") Then Results(Folder) = Source
If FileUtils.Exists(Folder & "javaw.exe") Then Results(Folder) = Source
'查找其下的所有文件夹
'不应使用网易的 Java：https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Static Keywords As String() = {
@@ -674,16 +673,16 @@ Wait:
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "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).Lower '用于搜索的字符串
Dim SearchEntry = PathUtils.GetLastPart(FolderInfo.Name).Lower '用于搜索的字符串
If IsFullSearch OrElse
OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath.FullName)
Logger.Trace(Function() $"遍历查找 Java 时遭遇无权限的文件夹（{OriginalPath.FullName}）：{ex.GetDisplay(False)}")
Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）")
Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath.FullName}）")
End Try
End Sub
@@ -704,8 +703,8 @@ Wait:
AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", NotifyLevel.DebugModeOnly)
DeleteDirectory(LastJavaBaseDir)
Logger.Warn($"由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}")
DirectoryUtils.Delete(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing
End If
@@ -715,7 +714,7 @@ Wait:
End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Logger.Info("开始获取 Java 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
@@ -751,7 +750,7 @@ Wait:
Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker))
Next
Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
Logger.Info($"需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
End Sub
#End Region
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+262 -272
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+280 -254
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+136 -143
View File
@@ -5,7 +5,7 @@
''' 弹窗要求选择一个整合包文件并进行安装。
''' </summary>
Public Sub ModpackInstall()
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
Dim File As String = Dialogs.SelectFile("选择整合包压缩文件", False, filter:={({"rar", "zip", "mrpack"}, "整合包文件")}).FirstOrDefault() '选择整合包文件
If String.IsNullOrEmpty(File) Then Return
RunInThread(
Sub()
@@ -13,7 +13,7 @@
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
Log(ex, "手动安装整合包失败", NotifyLevel.MsgBox)
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try
End Sub)
End Sub
@@ -23,7 +23,7 @@
''' </summary>
''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求：" & If(File, "null"))
Logger.Info($"整合包安装请求：{If(File, "null")}")
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
Try
@@ -33,13 +33,13 @@
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
Archive = FileUtils.OpenZip(File)
'从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
Dim Json As JObject = GetJson(Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8))
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -50,27 +50,27 @@
If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/"
Dim PathSplits As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = PathSplits(0) & "/"
'确定为一级目录下
If FullNames.Count <> 2 Then Continue For
If PathSplits.Count <> 2 Then Continue For
'判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
If PathSplits(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If PathSplits(1) = "manifest.json" Then
Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
End If
End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
If PathSplits(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If PathSplits(1) = "modpack.zip" OrElse PathSplits(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next
Catch ex As Exception
If ex.GetDetail(True).Contains("Error.WinIOError") Then
If ex.GetDisplay(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
@@ -81,25 +81,25 @@
'执行对应的安装方法
Select Case PackType
Case 0
Log("[ModPack] 整合包种类：CurseForge")
Logger.Info("整合包种类：CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1
Log("[ModPack] 整合包种类：HMCL")
Logger.Info("整合包种类：HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2
Log("[ModPack] 整合包种类：MMC")
Logger.Info("整合包种类：MMC")
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类：MCBBS")
Logger.Info("整合包种类：MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4
Log("[ModPack] 整合包种类：Modrinth")
Logger.Info("整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9
Log("[ModPack] 整合包种类：带启动器的压缩包")
Logger.Info("整合包种类：带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
Case Else
Log("[ModPack] 整合包种类：未能识别，假定为压缩包")
Logger.Info("整合包种类：未能识别，假定为压缩包")
Return InstallPackCompress(File, Archive)
End Select
Finally
@@ -111,13 +111,14 @@
'解压文件
Dim RetryCount As Integer = 1
Dim InitialProgress = Loader.Progress
Try
Retry:
Try
Loader.Progress = InitialProgress
DeleteDirectory(InstallTemp)
ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
DirectoryUtils.Delete(InstallTemp)
Dim RawProgress As Double = Loader.Progress
FileUtils.ExtractToDirectory(FileAddress, InstallTemp, progressHandler:=Sub(Percentage) Loader.Progress = RawProgress + Percentage * ProgressIncrement)
Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
Logger.Warn(ex, $"第 {RetryCount} 次解压尝试失败")
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000)
@@ -134,25 +135,24 @@ Retry:
''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
''' 对路径末尾是否为 \ 没有要求。
''' </summary>
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase, ProgressIncrement As Double)
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase)
If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\"
If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\"
'复制文件
If Directory.Exists(OverridesFolder) Then
Log($"[ModPack] 处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
CopyDirectory(OverridesFolder, VersionFolder, Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
If DirectoryUtils.Exists(OverridesFolder) Then
Logger.Info($"处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
DirectoryUtils.Copy(OverridesFolder, VersionFolder)
Else
Log($"[ModPack] 整合包中没有覆写文件夹：{OverridesFolder}")
Loader.Progress += ProgressIncrement
Logger.Info($"整合包中没有覆写文件夹：{OverridesFolder}")
End If
'设置 ini
Dim OverridesIni As String = $"{OverridesFolder}PCL\Setup.ini"
Dim VersionIni As String = $"{VersionFolder}PCL\Setup.ini"
If File.Exists(OverridesIni) Then
If FileUtils.Exists(OverridesIni) Then
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
WriteIni(OverridesIni, "IsStar", False)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
FileUtils.Copy(OverridesIni, VersionIni) '覆写已有的 ini
Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(VersionIni, "VersionArgumentIndieV2", True)
@@ -178,7 +178,7 @@ Retry:
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try
@@ -194,24 +194,23 @@ Retry:
End If
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
Dim TargetVersion As New McVersion
TargetVersion.VanillaName = Json("minecraft")("version").ToString
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
Log("[ModPack] 整合包 Forge 版本：" & Id)
ForgeVersion = Id.Replace("forge-", "")
Logger.Info($"整合包 Forge 版本：{Id}")
TargetVersion.Forge = Id.Replace("forge-", "")
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Log("[ModPack] 整合包 NeoForge 版本：" & Id)
NeoForgeVersion = Id.Replace("neoforge-", "")
Logger.Info($"整合包 NeoForge 版本：{Id}")
TargetVersion.NeoForge = Id.Replace("neoforge-", "")
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Log("[ModPack] 整合包 Fabric 版本：" & Id)
FabricVersion = Id.Replace("fabric-", "")
Logger.Info($"整合包 Fabric 版本：{Id}")
TargetVersion.Fabric = Id.Replace("fabric-", "")
Else
'ElseIf Id.StartsWithF("quilt-") Then
NotifyIncompatibleLoader(Id)
@@ -227,10 +226,9 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{McFolderSelected}versions\{InstanceName}",
Task, 0.4)
$"{McFolderSelected}versions\{InstanceName}", Task)
End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End If
'获取 Mod 列表
Dim ModList As New List(Of Integer)
@@ -253,17 +251,17 @@ Retry:
'如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
'获取缺失的 fileId 列表
Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList
Log("[Modpack] 缺失的 fileIds：" & MissingIds.Join("、"))
Logger.Info($"缺失的 fileIds：{MissingIds.Join("、")}")
'将 fileId 映射到 projectId
Dim Missings = MissingIds.Select(Of (ProjectId As Integer, FileId As Integer))(
Function(id) (CType(Json("files").AsEnumerable.First(Function(f) f("fileID").ToObject(Of Integer) = id), JObject)("projectID").ToObject(Of Integer), id)).ToList
Log("[Modpack] 缺失项：" & Missings.Join("、"))
Logger.Info($"缺失项：{Missings.Join("、")}")
'尝试获取对应的工程信息
Dim Projects As New List(Of ResourceProject)
Try
Projects = ResourceProject.FromProjectIds(Missings.Select(Function(e) e.ProjectId.ToString), ResourcePlatforms.CurseForge).ToList
Catch ex As Exception
Log(ex, "获取缺失的工程信息失败")
Logger.Warn(ex, "获取缺失的工程信息失败")
End Try
Dim MissingDesc As New List(Of String)
For Each Missing In Missings
@@ -312,7 +310,8 @@ Retry:
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
If Not File.DownloadAvailable Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\",
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -328,10 +327,10 @@ Retry:
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
@@ -342,22 +341,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
Logger.Info($"已设置整合包 Logo：{Logo}")
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target)
File.Delete(Target)
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件：{Target}")
FileUtils.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Logger.Info($"删除安装整合包文件：{FileAddress}")
FileUtils.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -383,29 +382,26 @@ Retry:
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString)
Catch ex As Exception
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
Dim TargetVersion As New McVersion
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.Lower
Case "minecraft"
MinecraftVersion = Entry.Value.ToString
TargetVersion.VanillaName = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本：" & ForgeVersion)
TargetVersion.Forge = Entry.Value.ToString
Logger.Info($"整合包 Forge 版本：{TargetVersion.Forge}")
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本：" & NeoForgeVersion)
TargetVersion.NeoForge = Entry.Value.ToString
Logger.Info($"整合包 NeoForge 版本：{TargetVersion.NeoForge}")
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
TargetVersion.Fabric = Entry.Value.ToString
Logger.Info($"整合包 Fabric 版本：{TargetVersion.Fabric}")
Case Else
'Case "quilt-loader" 'eg. 1.0.0
NotifyIncompatibleLoader(Entry.Name)
@@ -427,13 +423,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
McFolderSelected & "versions\" & InstanceName, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {})
@@ -441,7 +435,7 @@ Retry:
If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString
Case "optional"
If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "？",
If MyMsgBox("是否要下载可选文件 " & PathUtils.GetLastPart(File("path").ToString) & "？",
"下载可选文件", "是", "否") = 2 Then
Continue For
End If
@@ -452,10 +446,12 @@ Retry:
'添加下载文件
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = ResourceVersion.ParseModrinthTrackArguments(Urls,
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders).ToList 'Modrinth 来源追踪信息
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
FileList.Add(New NetFile(Urls, TargetPath,
@@ -469,10 +465,10 @@ Retry:
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
@@ -483,22 +479,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
Logger.Info($"已设置整合包 Logo：{Logo}")
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target)
File.Delete(Target)
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件：{Target}")
FileUtils.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Logger.Info($"删除安装整合包文件：{FileAddress}")
FileUtils.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -523,7 +519,7 @@ Retry:
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8))
Catch ex As Exception
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
@@ -541,9 +537,8 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
McFolderSelected & "versions\" & InstanceName, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
@@ -577,13 +572,13 @@ Retry:
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
Catch ex As Exception
Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
@@ -597,15 +592,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
'读取 MMC 设置文件（#2655）
Try
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MmcSetupFile) Then
If FileUtils.Exists(MmcSetupFile) Then
'将其中的等号替换为冒号，以符合 ini 文件格式
Dim Lines As New List(Of String)
For Each Line In ReadFile(MmcSetupFile).Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
For Each Line In FileUtils.ReadAsLines(MmcSetupFile, True)
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
@@ -620,42 +614,42 @@ Retry:
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
Log("[ModPack] 迁移 MultiMC 版本独立设置：启动前执行命令：" & PreLaunchCommand)
Logger.Info($"迁移 MultiMC 版本独立设置：启动前执行命令：{PreLaunchCommand}")
End If
End If
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置：自动进入服务器：" & ServerAddress)
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
End If
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Logger.Info($"迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs)
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：{JvmArgs}")
Else
JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
JvmArgs += " " & Settings.Get(Of String)("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（追加）：" & JvmArgs)
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（追加）：{JvmArgs}")
End If
End If
End If
Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
Logger.Warn(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
End Try
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
@@ -674,7 +668,7 @@ Retry:
'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Case Else
If UID.StartsWithF("org.lwjgl") Then '#8210
Log("[ModPack] 已跳过 LWJGL 项：" & UID)
Logger.Info($"已跳过 LWJGL 项：{UID}")
Else
NotifyIncompatibleLoader(UID)
End If
@@ -710,7 +704,7 @@ Retry:
Dim Json As JObject
Try
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Json = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Catch ex As Exception
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
@@ -731,15 +725,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
Dim LaunchInfo As JObject = Json("launchInfo")
If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument")))
If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument")))
End If
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")
Dim Addons As New Dictionary(Of String, String)
@@ -787,9 +780,9 @@ Retry:
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径
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.Red) : Throw New CancelledException
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -799,42 +792,42 @@ Retry:
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
For Each ExeFile In DirectoryUtils.GetFiles(TargetFolder, True, "*.exe")
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器：{ExeFile}")
Logger.Info($"发现整合包附带的 PCL 启动器：{ExeFile}")
ElseIf (Info.ProductName.ContainsIgnoreCase("Launcher") OrElse Info.ProductName.Contains("启动")) AndAlso
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
If Launcher Is Nothing Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的疑似第三方启动器：{ExeFile}")
Logger.Info($"发现整合包附带的疑似第三方启动器：{ExeFile}")
End If
End If
Next
Task.Progress = 0.95
'尝试使用附带的启动器打开
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
Logger.Info($"找到压缩包中附带的启动器：{Launcher}")
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
Logger.Info("为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
Return
End If
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
Logger.Info("未找到压缩包中附带的启动器")
End If
'加入文件夹列表
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Dim InstanceName As String = PathUtils.GetLastPart(TargetFolder)
DirectoryUtils.Create(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
ModpackInstall(ModpackFile)
End Sub)
})
@@ -859,20 +852,20 @@ Retry:
Next
If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 Minecraft 客户端压缩包？") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & Match.Groups(1).Value)
Logger.Info($"检测到压缩包的 .minecraft 根目录：{ArchiveBaseFolder}，命中的版本名：{Match.Groups(1).Value}")
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then 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
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, PathUtils.GetLastPart(TargetFolder), False)
Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+19 -18
View File
@@ -33,13 +33,13 @@
HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放
If Settings.Get("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放"))
ElseIf Settings.Get("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放"))
If Settings.Get(Of Boolean)("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置，在结束后开始音乐播放"))
ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置，在结束后暂停音乐播放"))
End If
'启动器可见性
Select Case Settings.Get("LaunchArgumentVisible")
Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
Case 2
'直接关闭
If TriggerLauncherShutdown Then
@@ -105,7 +105,7 @@
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "Minecraft 日志监控主循环出错")
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
@@ -174,7 +174,7 @@
End If
End If
Catch ex As Exception
Log(ex, "输出 Minecraft 日志失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "输出 Minecraft 日志失败")
End Try
End Sub
Public LatestLog As New Queue(Of String)
@@ -186,6 +186,7 @@
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
Logger.Trace(Text)
'进度处理
If LogProgress < 1 Then
WatcherLog("日志 1/5：已出现日志输出")
@@ -265,7 +266,7 @@
MinecraftWindow = TryGetMinecraftWindow()
Catch ex As ComponentModel.Win32Exception
'拒绝访问（#1062）
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", NotifyLevel.AllUsers)
Logger.Error(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogBehavior.Toast)
IsWindowFinished = True
End Try
If MinecraftWindow Is Nothing Then Return
@@ -277,7 +278,7 @@
WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）")
IsWindowFinished = True
'最大化
If Settings.Get("LaunchArgumentWindowType") = 4 Then
If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then
RunInNewThread(
Sub()
Try
@@ -287,7 +288,7 @@
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
@@ -297,7 +298,7 @@
End If
IsWindowAppeared = True
Catch ex As Exception
Log(ex, "检查 Minecraft 窗口失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "检查 Minecraft 窗口失败")
End Try
End Sub
''' <summary>
@@ -305,10 +306,10 @@
''' Nothing 代表未找到。
''' </summary>
Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)?
TryGetMinecraftWindow = Nothing
Dim Result = Nothing
EnumWindows(
Sub(hwnd As IntPtr, lParam As Integer)
If TryGetMinecraftWindow IsNot Nothing Then Return
If Result IsNot Nothing Then Return
'检查类名
Dim str As New StringBuilder(512)
GetClassName(hwnd, str, str.Capacity)
@@ -327,13 +328,13 @@
Try
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
Catch ex As Exception
Log(ex, "枚举 Minecraft 窗口进程失败")
Logger.Warn(ex, "枚举 Minecraft 窗口进程失败")
Return
End Try
'返回
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
End Sub, 0)
Return TryGetMinecraftWindow
Return Result
End Function
Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer)
Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean
@@ -363,7 +364,7 @@
Analyzer.Output(False, New List(Of String) From
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "崩溃分析失败")
End Try
End Sub, "Crash Analyzer")
End Sub
@@ -376,7 +377,7 @@
If Not GameProcess.HasExited Then GameProcess.Kill()
WatcherLog("已强制结束 Minecraft 进程")
Catch ex As Exception
Log(ex, "强制结束 Minecraft 进程失败", NotifyLevel.AllUsers)
Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast)
End Try
End Sub