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

2.12.7.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-04-29 05:37:25 +08:00
parent 6aedd20512
commit 67764b393d
113 changed files with 5147 additions and 5865 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
-1776
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+10 -10
View File
@@ -7,8 +7,8 @@
Me.TargetInstance = TargetInstance
'构建文件结构
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\")
DirectoryUtils.Create(TempFolder & "Temp\")
DirectoryUtils.Create(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder)
End Sub
@@ -81,7 +81,7 @@
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
FileUtils.Write(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear()
End If
@@ -573,7 +573,7 @@ Done:
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsF(".jar", True) Then
If LogCrashMod.ContainsIgnoreCase(".jar") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
@@ -764,7 +764,7 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
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)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -874,7 +874,7 @@ NextStack:
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
FileUtils.Write(FilePath, DirectFile.Value.Value.Join(vbCrLf))
StartProcess(FilePath)
End If
End Sub))
@@ -885,8 +885,8 @@ NextStack:
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Return
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
DirectoryUtils.Create(FileAddress, isFilePath:=True)
'输出诊断信息
FeedbackInfo()
LogFlush()
@@ -909,7 +909,7 @@ NextStack:
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
End If
Next
@@ -918,7 +918,7 @@ NextStack:
DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Green)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Log(ex, "导出错误报告失败", NotifyLevel.MsgBoxAndFeedback)
Return
End Try
OpenExplorer(FileAddress)
@@ -1117,7 +1117,7 @@ NextStack:
Replace("\n", vbCrLf).
Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
ReplaceLineEndings(vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。" &
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+13 -13
View File
@@ -75,7 +75,7 @@
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
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 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
Task.Interrupt()
Throw New ThreadInterruptedException
End If
@@ -313,7 +313,7 @@
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}", LogLevel.Debug)
Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", NotifyLevel.DebugModeOnly)
Return Nothing
Catch ex As Exception
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
@@ -426,9 +426,9 @@
Dim Entry As New DlOptiFineListEntry With {
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
.IsPreview = Name(i).ContainsF("pre", True),
.IsPreview = Name(i).ContainsIgnoreCase("pre"),
.Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.FileName = If(Name(i).ContainsIgnoreCase("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
@@ -452,7 +452,7 @@
Dim Entry As New DlOptiFineListEntry With {
.DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.IsPreview = Token("patch").ToString.ContainsIgnoreCase("pre"),
.Inherit = Token("mcversion").ToString,
.FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -679,7 +679,7 @@
Dim Versions As New List(Of DlForgeVersionEntry)
Try
'分割版本信息
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
Dim VersionCodes = Result.Substring(0, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
'获取所有版本信息
For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i)
@@ -720,7 +720,7 @@
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.ReplaceLineEndings(""), .ReleaseTime = ReleaseTime})
Catch ex As Exception
Throw New Exception("Forge 官方源版本信息提取失败（" & VersionCode & "）", ex)
End Try
@@ -846,7 +846,7 @@
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.ContainsF("beta", True) OrElse ApiName.ContainsF("alpha", True)
IsBeta = ApiName.ContainsIgnoreCase("beta") OrElse ApiName.ContainsIgnoreCase("alpha")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
@@ -1151,14 +1151,14 @@
''' <summary>
''' Fabric API 列表，官方源。
''' </summary>
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of CompFile))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("fabric-api", False))
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of ResourceVersion))) Task.Output = ResourceVersion.FromProjectId("fabric-api", ResourcePlatforms.Modrinth, LoadDependencies:=False))
''' <summary>
''' OptiFabric 列表，官方源。
''' </summary>
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of CompFile))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("322385", True))
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of ResourceVersion))) Task.Output = ResourceVersion.FromProjectId("322385", ResourcePlatforms.CurseForge, LoadDependencies:=False))
#End Region
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+22 -22
View File
@@ -54,7 +54,7 @@
Public ReadOnly Property HasEnvironment As Boolean
Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
Return PathEnv.Replace("\", "").Replace("/", "").ContainsIgnoreCase(PathFolder.Replace("\", ""))
End Get
End Property
@@ -70,7 +70,7 @@
''' </summary>
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
If VersionString.StartsWithF("1.") Then VersionString = VersionString.Substring(2)
Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", "，32 位") & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
End Function
@@ -95,7 +95,7 @@
Try
'确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
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")
'运行 -version
@@ -176,14 +176,14 @@
Next
End If
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", LogLevel.Developer)
Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", NotifyLevel.DevelopOnly)
JavaSearchLoader.Start(0)
Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java：")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}"))
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
Log(ex, "初始化 Java 列表失败", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
@@ -242,7 +242,7 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
End Try
End If
End If
@@ -257,7 +257,7 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
End Try
End If
@@ -332,7 +332,7 @@ RetryGet:
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug)
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", NotifyLevel.DebugModeOnly)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
@@ -400,7 +400,7 @@ UserPass:
Return Nothing
Catch ex As Exception
If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", LogLevel.Feedback)
Log(ex, "查找符合条件的 Java 失败", NotifyLevel.MsgBoxAndFeedback)
Return Nothing
End Try
End Function
@@ -435,7 +435,7 @@ NoUserJava:
Next
Return False
Catch ex As Exception
Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
Log(ex, "检查 Java 类别时出错", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaSelect", "")
Return True
End Try
@@ -444,7 +444,7 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathInfo As New DirectoryInfo(PathExeFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
@@ -522,9 +522,9 @@ NoUserJava:
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(PathExeFolder, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso PathExeFolder <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
'若不全为符号链接，则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -546,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.ContainsF("system32") Then
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 位于特殊路径，不应优先使用")
Else
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
@@ -565,7 +565,7 @@ NoUserJava:
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback)
Log(ex, "Java 列表已损坏", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
@@ -573,7 +573,7 @@ NoUserJava:
'确保可用并获取详细信息，转入正式列表
Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
For Each Entry In JavaPreList.ToList.DistinctBy(Function(a) a.Key.Lower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
@@ -587,7 +587,7 @@ NoUserJava:
JavaList = NewJavaList
Catch ex As Exception
Log(ex, "搜索 Java 时出错", LogLevel.Feedback)
Log(ex, "搜索 Java 时出错", NotifyLevel.MsgBoxAndFeedback)
JavaList = New List(Of JavaEntry)
End Try
@@ -618,7 +618,7 @@ NoUserJava:
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", LogLevel.Hint)
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", NotifyLevel.AllUsers)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
End If
@@ -659,10 +659,10 @@ Wait:
Try
'确认目录存在
If Not OriginalPath.Exists Then Return
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWithF("\") Then Path += "\"
Dim Folder As String = OriginalPath.FullName.Replace("\\", "\")
If Not Folder.EndsWithF("\") Then Folder += "\"
'若该目录有 Java，则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
If File.Exists(Folder & "javaw.exe") Then Results(Folder) = Source
'查找其下的所有文件夹
'不应使用网易的 Java：https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Static Keywords As String() = {
@@ -704,7 +704,7 @@ 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}", LogLevel.Debug)
Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", NotifyLevel.DebugModeOnly)
DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+57 -61
View File
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModLaunch
Public Module ModLaunch
#Region "开始"
@@ -186,7 +184,7 @@ NextInner:
'没有特殊处理过的错误信息
McLaunchLog("错误：" & ex.GetDetail())
Log(ex,
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox,
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), NotifyLevel.MsgBox,
If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
'上报
If Not IsSavingBatch Then
@@ -239,9 +237,8 @@ NextInner:
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
If CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
If BuildType = BuildTypes.Release AndAlso CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
RunInNewThread(
Sub()
Select Case Settings.Get("SystemLaunchCount")
@@ -255,7 +252,6 @@ NextInner:
End Select
End Sub, "Donate")
End If
#End If
'正版购买提示
If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
Not Settings.Get("HintBuy") AndAlso Settings.Get("LoginType") <> McLoginType.Ms Then
@@ -496,7 +492,7 @@ NextInner:
End If
End Select
Catch ex As Exception
Log(ex, "获取登录输入信息失败（" & GetStringFromEnum(LoginType) & "）", LogLevel.Feedback)
Log(ex, "获取登录输入信息失败（" & GetStringFromEnum(LoginType) & "）", NotifyLevel.MsgBoxAndFeedback)
End Try
Return LoginData
End Function
@@ -665,7 +661,7 @@ LoginFinish:
Settings.Set("Login" & Input.Token & "Email", Emails.Join("¨"c))
Settings.Set("Login" & Input.Token & "Pass", Passwords.Join("¨"c))
Catch ex As Exception
Log(ex, "保存启动记录失败", LogLevel.Hint)
Log(ex, "保存启动记录失败", NotifyLevel.AllUsers)
Settings.Set("Login" & Input.Token & "Email", "")
Settings.Set("Login" & Input.Token & "Pass", "")
End Try
@@ -817,17 +813,17 @@ LoginFinish:
Return NeedRefresh
Catch ex As Exception
Dim AllMessage As String = ex.GetBrief()
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Log(ex, "登录失败原始错误信息", NotifyLevel.Silent)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
Dim Response = DirectCast(ex, ResponsedWebException).Response
If Response.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsIgnoreCase("Incorrect username or password") Then
'密码错误，退出登录 (#5090)
McLaunchLog("密码错误，退出登录")
Select Case Data.Input.Type
@@ -905,15 +901,15 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded",
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2)
Catch ex As ResponsedWebException
'修改错误列表时，同时检查 MyMsgLogin.xaml.vb 中的对应代码
Dim Response = ex.Response
If Response.ContainsF("must sign in again", True) OrElse Response.ContainsF("password expired", True) OrElse
(Response.Contains("refresh_token") AndAlso Response.Contains("is not valid")) Then '#269
If Response.ContainsIgnoreCase("must sign in again") OrElse Response.ContainsIgnoreCase("password expired") OrElse
(Response.Contains("refresh_token") AndAlso Response.ContainsIgnoreCase("is not valid")) Then '#269
Return {"Relogin", ""}
ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
@@ -1105,7 +1101,7 @@ Retry:
Uuid = McLoginMojangUuid(SkinName, False)
End If
Catch ex As Exception
Log(ex, "皮肤信息获取失败，游戏将以无皮肤的方式启动", LogLevel.Hint)
Log(ex, "皮肤信息获取失败，游戏将以无皮肤的方式启动", NotifyLevel.AllUsers)
End Try
Case 4
'自定义
@@ -1118,7 +1114,7 @@ Retry:
End Function
'根据用户名返回对应 UUID，需要多线程
Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
If Name.Trim.Length = 0 Then Return StrFill("", "0", 32)
If Name.Trim.Length = 0 Then Return New String("0"c, 32)
'从缓存获取
Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "")
If Len(Uuid) = 32 Then Return Uuid
@@ -1141,7 +1137,7 @@ Retry:
Return Uuid
End Function
Public Function McLoginLegacyUuid(Name As String)
Dim FullUuid As String = StrFill(Name.Length.ToString("X"), "0", 16) & StrFill(GetHash(Name).ToString("X"), "0", 16)
Dim FullUuid As String = Name.Length.ToString("X").EnsureLength("0", 16) & GetHash(Name).ToString("X").EnsureLength("0", 16)
Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15)
End Function
@@ -1583,7 +1579,7 @@ NextInstance:
McLaunchLog("发现错误的 OptiFineForge TweakClass，目前的游戏参数：" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json", ReadFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
FileUtils.Write(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json", ReadFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1627,15 +1623,15 @@ NextInstance:
Private Iterator Function McLaunchArgumentsReplace(Arguments As List(Of String)) As IEnumerable(Of (Key As String, Value As String))
'基础参数
Yield ("${classpath_separator}", ";")
Yield ("${natives_directory}", ShortenPath(GetNativesFolder()))
Yield ("${library_directory}", ShortenPath(McFolderSelected & "libraries"))
Yield ("${libraries_directory}", ShortenPath(McFolderSelected & "libraries"))
Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
Yield ("${library_directory}", FileUtils.ShortenPath(McFolderSelected & "libraries"))
Yield ("${libraries_directory}", FileUtils.ShortenPath(McFolderSelected & "libraries"))
Yield ("${pure_directory}", PathPure.TrimEnd("\"c)) '由 PCL 添加，这会允许在分割参数并去重后再替换路径，防止路径中的特殊字符影响参数分割和去重
Yield ("${launcher_name}", "PCL")
Yield ("${launcher_version}", VersionCode)
Yield ("${version_name}", McInstanceSelected.Name)
Yield ("${game_directory}", ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
Yield ("${assets_root}", ShortenPath(McFolderSelected & "assets"))
Yield ("${game_directory}", FileUtils.ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
Yield ("${assets_root}", FileUtils.ShortenPath(McFolderSelected & "assets"))
Yield ("${user_properties}", "{}")
Yield ("${auth_player_name}", McLoginLoader.Output.Name)
Yield ("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1643,8 +1639,8 @@ NextInstance:
Yield ("${access_token}", McLoginLoader.Output.AccessToken)
Yield ("${auth_session}", McLoginLoader.Output.AccessToken)
Yield ("${user_type}", "msa") '#1221
Yield ("${primary_jar}", ShortenPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
Yield ("${game_assets}", ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
Yield ("${primary_jar}", FileUtils.ShortenPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
Yield ("${game_assets}", FileUtils.ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
Yield ("${assets_index_name}", McAssetsGetIndexName(McInstanceSelected))
'自定义信息
@@ -1697,14 +1693,14 @@ NextInstance:
End If
Next
If OptiFineCp IsNot Nothing Then Cps.Insert(Cps.Count - 2, OptiFineCp) 'OptiFine 的总是需要放到倒数第二位
Yield ("${classpath}", Cps.Select(Function(c) ShortenPath(c)).Join(";"c))
Yield ("${classpath}", Cps.Select(Function(c) FileUtils.ShortenPath(c)).Join(";"c))
End Function
''' <summary>
''' 分割 Java 参数字符串。
''' </summary>
Private Iterator Function SplitJavaArguments(Arg As String) As IEnumerable(Of String)
Arg = Arg.Replace(vbLf, " ").Replace(vbCr, " ").Trim '预处理换行符
Arg = Arg.ReplaceLineEndings(" ", mergeMultiple:=True).Trim '预处理换行符
If String.IsNullOrWhiteSpace(Arg) Then Return
Dim Current As New StringBuilder
Dim InQuotes As Boolean = False
@@ -1783,8 +1779,8 @@ NextInstance:
Private Sub McLaunchNatives(Loader As LoaderTask(Of Integer, Integer))
'创建文件夹
Dim Target As String = GetNativesFolder() & "\"
Directory.CreateDirectory(Target)
Dim Target As String = GetNativesFolder()
DirectoryUtils.Create(Target)
'解压文件
McLaunchLog("正在解压 Natives 文件")
@@ -1821,7 +1817,7 @@ NextInstance:
End Try
End If
'解压新文件
WriteFile(FilePath, Entry.Open)
FileUtils.Write(FilePath, Entry.Open)
McLaunchLog("已解压：" & FilePath)
End If
Next
@@ -1843,18 +1839,18 @@ NextInstance:
End Sub
''' <summary>
''' 获取 Natives 文件夹路径，不以 \ 结尾。
''' 获取 Natives 文件夹路径，以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = ShortenPath(McInstanceSelected.PathVersion) & McInstanceSelected.Name & "-natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
Result = OsDrive & "ProgramData\PCL\natives"
Dim Result As String = FileUtils.ShortenPath(McInstanceSelected.PathVersion) & McInstanceSelected.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
If Not Result.IsAsciiOnly() Then
Result = OsDrive & "ProgramData\PCL\natives\"
End If
End If
Directory.CreateDirectory(Result) '提前创建，这样 ShortenPath 才有结果（否则在长路径下首次启动 Forge 会崩溃）
Return ShortenPath(Result)
DirectoryUtils.Create(Result) '提前创建，这样 DirectoryUtils.Shorten 才有结果（否则在长路径下首次启动 Forge 会崩溃）
Return FileUtils.ShortenPath(Result)
End Function
#End Region
@@ -1867,7 +1863,7 @@ NextInstance:
If Settings.Get("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
SetGPUPreference(PathWithName)
SetGPUPreference(PathExe)
Catch ex As Exception
If IsAdmin() Then
Log(ex, "直接调整显卡设置失败")
@@ -1880,7 +1876,7 @@ NextInstance:
Throw New Exception("调整过程中出现异常")
End If
Catch exx As Exception
Log(exx, "调整显卡设置失败，Minecraft 可能会使用默认显卡运行", LogLevel.Hint)
Log(exx, "调整显卡设置失败，Minecraft 可能会使用默认显卡运行", NotifyLevel.AllUsers)
End Try
End If
End Try
@@ -1914,7 +1910,7 @@ NextInstance:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败，将在删除文件后重试")
@@ -1944,10 +1940,10 @@ NextInstance:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
Log(exx, "更新 launcher_profiles.json 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Try
@@ -1997,7 +1993,7 @@ NextInstance:
WriteIni(SetupFileAddress, "fullscreen", "false")
End Select
Catch ex As Exception
Log(ex, "更新 options.txt 失败", LogLevel.Hint)
Log(ex, "更新 options.txt 失败", NotifyLevel.AllUsers)
End Try
'离线皮肤 Alex 警告
@@ -2010,11 +2006,11 @@ NextInstance:
'离线皮肤资源包
Try
Directory.CreateDirectory(McInstanceSelected.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
DirectoryUtils.Create(ZipFileAddress, isFilePath:=True)
Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then
Directory.CreateDirectory(PathTemp)
DirectoryUtils.Create(PathTemp)
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
@@ -2063,13 +2059,13 @@ NextInstance:
'准备文件
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤，已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32)
End If
Skin.Save(Path & "PCL\CustomSkin_Cliped.png")
Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
'构建压缩文件
Using ZipFile As New FileStream(ZipFileAddress, FileMode.Create)
Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create)
@@ -2078,15 +2074,15 @@ NextInstance:
'1.19.3+ 使用复杂版本的替换
If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
ZipAr.CreateEntryFromFile(PathExeFolder & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Settings.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next
Else
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Settings.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
ZipAr.CreateEntryFromFile(PathExeFolder & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Settings.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
End If
End Using
End Using
File.Delete(Path & "PCL\CustomSkin_Cliped.png")
File.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
'更改设置文件
IniClearCache(SetupFileAddress)
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
@@ -2132,7 +2128,7 @@ IgnoreCustomSkin:
End If
End If
Catch ex As Exception
Log(ex, "离线皮肤资源包设置失败", LogLevel.Hint)
Log(ex, "离线皮肤资源包设置失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -2151,13 +2147,13 @@ IgnoreCustomSkin:
"@echo off" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
$"cd /D ""{ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
$"cd /D ""{FileUtils.ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
FileUtils.Write(If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
Encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
@@ -2189,7 +2185,7 @@ IgnoreCustomSkin:
Loop
End If
Catch ex As Exception
Log(ex, "执行全局自定义命令失败", LogLevel.Hint)
Log(ex, "执行全局自定义命令失败", NotifyLevel.AllUsers)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
@@ -2214,7 +2210,7 @@ IgnoreCustomSkin:
Loop
End If
Catch ex As Exception
Log(ex, "执行版本自定义命令失败", LogLevel.Hint)
Log(ex, "执行版本自定义命令失败", NotifyLevel.AllUsers)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
@@ -2233,9 +2229,9 @@ IgnoreCustomSkin:
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
Paths.Add(FileUtils.ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
StartInfo.EnvironmentVariables("appdata") = ShortenPath(McFolderSelected)
StartInfo.EnvironmentVariables("appdata") = FileUtils.ShortenPath(McFolderSelected)
'设置其他参数
StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
@@ -2267,7 +2263,7 @@ IgnoreCustomSkin:
Case Else '中
End Select
Catch ex As Exception
Log(ex, "设置进程优先级失败", LogLevel.Feedback)
Log(ex, "设置进程优先级失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -2276,7 +2272,7 @@ IgnoreCustomSkin:
'输出信息
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本：" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("PCL 版本：" & VersionDisplay & " (" & VersionCode & ")")
McLaunchLog($"游戏版本：{McInstanceSelected.VersionDisplayName}（{McInstanceSelected.Version.Vanilla}，Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", "，无法完全确定")}）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承：" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+76 -78
View File
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModMinecraft
Public Module ModMinecraft
#Region "文件夹"
@@ -18,8 +16,8 @@ Public Module ModMinecraft
End Property
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", Path)
Settings.Set("LaunchFolderSelect", Value.Replace(Path, "$"))
_McFolderSelected = Value.Replace("$", PathExeFolder)
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$"))
Log("[Minecraft] 当前选择的 Minecraft 文件夹：" & _McFolderSelected)
End Sub
Private _McFolderSelected As String
@@ -65,8 +63,8 @@ Public Module ModMinecraft
'扫描当前文件夹
Try
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
If Directory.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(PathExeFolder).GetDirectories
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Vanilla})
Next
Catch ex As Exception
@@ -122,8 +120,8 @@ Public Module ModMinecraft
'若没有可用文件夹，则创建 .minecraft
If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Vanilla})
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If
For Each Folder As McFolder In CacheMcFolderList
@@ -135,7 +133,7 @@ Public Module ModMinecraft
McFolderList = CacheMcFolderList
Catch ex As Exception
Log(ex, "加载 Minecraft 文件夹列表失败", LogLevel.Feedback)
Log(ex, "加载 Minecraft 文件夹列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -159,10 +157,10 @@ Public Module ModMinecraft
""selectedProfile"": ""PCL"",
""clientToken"": ""23323323323323323323323323323333""
}"
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
Log("[Minecraft] 已创建 launcher_profiles.json：" & Folder)
Catch ex As Exception
Log(ex, "创建 launcher_profiles.json 失败（" & Folder & "）", LogLevel.Feedback)
Log(ex, "创建 launcher_profiles.json 失败（" & Folder & "）", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -170,7 +168,7 @@ Public Module ModMinecraft
#Region "版本处理"
Public Const McInstanceCacheVersion As Integer = 35
Public Const McInstanceCacheVersion As Integer = 36
Private _McInstanceSelected As McInstance
''' <summary>
@@ -185,13 +183,12 @@ Public Module ModMinecraft
If ReferenceEquals(_McInstanceSelectedLast, value) Then Return
_McInstanceSelected = value '由于有可能是 Nothing，导致无法初始化，才得这样弄一圈
_McInstanceSelectedLast = value
Settings.MakeInstanceDirty()
'更新 MC 文件夹所选取的 Minecraft 版本
Log("[Launch] 当前选择的 Minecraft 版本：" & If(value?.PathVersion, "无"))
WriteIni(McFolderSelected & "PCL.ini", "Version", If(value?.Name, ""))
If value Is Nothing Then Return
'重置缓存的下载文件夹
PageDownloadCompDetail.CachedFolder.Clear()
PageDownloadResourceDetail.CachedFolder.Clear()
'统一通行证重判
If AniControlEnabled = 0 AndAlso
Settings.Get("VersionServerNide", Instance:=value) <> Settings.Get("CacheNideServer") AndAlso
@@ -481,7 +478,7 @@ VersionSearchFinish:
If JsonPath Is Nothing Then
Throw New Exception($"未找到版本 JSON 文件：{PathVersion}{Name}.json")
Else
Log("[Minecraft] 未找到同名版本 JSON，自动换用 " & JsonPath, LogLevel.Debug)
Log("[Minecraft] 未找到同名版本 JSON，自动换用 " & JsonPath, NotifyLevel.DebugModeOnly)
End If
End If
Return JsonPath
@@ -503,10 +500,10 @@ VersionSearchFinish:
'如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", LogLevel.Debug)
Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", NotifyLevel.DebugModeOnly)
GetJson(_JsonText) '触发异常
Else
Log($"[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）", LogLevel.Debug)
Log($"[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）", NotifyLevel.DebugModeOnly)
Thread.Sleep(2000)
_JsonText = ReadFile(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
@@ -566,7 +563,7 @@ VersionSearchFinish:
Try
InstanceNameInheritFrom = If(_JsonObject("inheritsFrom") Is Nothing, "", _JsonObject("inheritsFrom").ToString)
If InstanceNameInheritFrom = Name Then
Log("[Minecraft] 自引用的继承版本：" & Name, LogLevel.Debug)
Log("[Minecraft] 自引用的继承版本：" & Name, NotifyLevel.DebugModeOnly)
InstanceNameInheritFrom = ""
Exit Try
End If
@@ -684,7 +681,7 @@ Recheck:
End If
'检查权限
Try
Directory.CreateDirectory(PathVersion & "PCL\")
DirectoryUtils.Create(PathVersion & "PCL\")
CheckPermissionWithException(PathVersion & "PCL\")
Catch ex As Exception
State = McInstanceState.Error
@@ -823,8 +820,6 @@ ExitDataLoad:
If State = McInstanceState.Fool Then
Info = GetMcFoolName(Version.VanillaName)
ElseIf State <> McInstanceState.Error Then
'这里不应使用缓存，因为不同实例有不同值 (#8508)
Settings.MakeInstanceDirty()
If Settings.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证"
If Settings.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证"
End If
@@ -853,15 +848,15 @@ ExitDataLoad:
Info = "未知错误：" & ex.GetBrief()
Logo = PathImage & "Blocks/RedstoneBlock.png"
State = McInstanceState.Error
Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback)
Log(ex, "加载版本失败（" & Name & "）", NotifyLevel.MsgBoxAndFeedback)
Finally
IsLoaded = True
End Try
Return Me
End Function
Private Function IsSnapshot() As Boolean
Return {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) Version.VanillaName.ContainsF(s, True)) OrElse
Name.ContainsF("combat", True) OrElse
Return {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) Version.VanillaName.ContainsIgnoreCase(s)) OrElse
Name.ContainsIgnoreCase("combat") OrElse
If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending"
End Function
@@ -882,15 +877,15 @@ ExitDataLoad:
Dim Info As String
Select Case State
Case McInstanceState.Snapshot, McInstanceState.Original, McInstanceState.Forge, McInstanceState.NeoForge, McInstanceState.Fabric, McInstanceState.OptiFine, McInstanceState.LiteLoader
If Version.VanillaName.ContainsF("pre", True) Then
If Version.VanillaName.ContainsIgnoreCase("pre") Then
Info = "预发布版 " & Version.VanillaName
ElseIf Version.VanillaName.ContainsF("rc", True) Then
ElseIf Version.VanillaName.ContainsIgnoreCase("rc") Then
Info = "发布候选 " & Version.VanillaName
ElseIf Version.VanillaName.Contains("experimental") Then
ElseIf Version.VanillaName.ContainsIgnoreCase("experimental") Then
Info = "实验性快照" & Version.VanillaName
ElseIf Version.VanillaName = "pending" Then
Info = "实验性快照"
ElseIf IsSnapshot Then
ElseIf IsSnapshot() Then
Info = If(Version.Reliable, "快照版 " & Version.VanillaName.Replace("-snapshot", ""), "快照版")
Else
Info = If(Version.Reliable, "正式版 " & Version.VanillaName, "正式版")
@@ -928,7 +923,7 @@ ExitDataLoad:
NewItem.Logo = Logo
End If
Catch ex As Exception
Log(ex, "加载版本图标失败", LogLevel.Hint)
Log(ex, "加载版本图标失败", NotifyLevel.AllUsers)
NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
End Try
Return NewItem
@@ -1026,8 +1021,8 @@ ExitDataLoad:
Result += Val(RegexSeek(Right(OptiFine, OptiFine.Length - 1), "[0-9]+"))
'测试标记（正式版为 99，Pre[x] 为 50+x，Beta[x] 为 x）
Result *= 100
If OptiFine.ContainsF("pre", True) Then Result += 50
If OptiFine.ContainsF("pre", True) OrElse OptiFine.ContainsF("beta", True) Then
If OptiFine.ContainsIgnoreCase("pre") Then Result += 50
If OptiFine.ContainsIgnoreCase("pre") OrElse OptiFine.ContainsIgnoreCase("beta") Then
If Val(Right(OptiFine, 1)) = 0 AndAlso Right(OptiFine, 1) <> "0" Then
Result += 1 '为 pre 或 beta 结尾，视作 1
Else
@@ -1134,7 +1129,7 @@ ExitDataLoad:
If Drop >= 250 Then
Return $"{Drop \ 10}.{Drop Mod 10}"
ElseIf Drop = 209 Then
Log("[Minecraft] 尝试将旧快照版 Drop 序数转换为版本字符串，这不应该发生！" & vbCrLf & GetStackTrace(), LogLevel.Debug)
Log("[Minecraft] 尝试将旧快照版 Drop 序数转换为版本字符串，这不应该发生！" & vbCrLf & GetStackTrace(), NotifyLevel.DebugModeOnly)
Return "1.20"
Else
Return $"1.{Drop \ 10}"
@@ -1294,24 +1289,24 @@ OnLoaded:
Catch ex As Exception
If Loader.IsInterrupted Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
Log(ex, "加载 .minecraft 版本列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
'获取版本列表
Private Function InitMcInstanceListWithCache(Path As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Private Function InitMcInstanceListWithCache(Folder As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Dim Results As New Dictionary(Of McInstanceCardType, List(Of McInstance))
Try
Dim CardCount As Integer = ReadIni(Path & "PCL.ini", "CardCount", -1)
Dim CardCount As Integer = ReadIni(Folder & "PCL.ini", "CardCount", -1)
If CardCount = -1 Then Return Nothing
For i = 0 To CardCount - 1
Dim CardType As McInstanceCardType = ReadIni(Path & "PCL.ini", "CardKey" & (i + 1), ":")
Dim CardType As McInstanceCardType = ReadIni(Folder & "PCL.ini", "CardKey" & (i + 1), ":")
Dim InstanceList As New List(Of McInstance)
'循环读取版本
For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If Folder = "" Then Continue For
Dim FolderVersions As String = $"{Path}versions\{Folder}\"
For Each VersionName As String In ReadIni(Folder & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If VersionName = "" Then Continue For
Dim FolderVersions As String = $"{Folder}versions\{VersionName}\"
If File.Exists(FolderVersions & ".pclignore") Then
If IsFirstMcInstanceListLoad Then
Log("[Minecraft] 清理残留的忽略项目：" & FolderVersions) '#2781
@@ -1332,7 +1327,7 @@ OnLoaded:
Instance.ReleaseTime = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "ReleaseTime", Instance.ReleaseTime)
Instance.State = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "State", Instance.State)
Instance.IsStar = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "IsStar", False)
Instance.DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
Instance.DisplayType = ReadIni(Folder & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
If Instance.State <> McInstanceState.Error AndAlso
ReadIni(Instance.PathVersion & "PCL\Setup.ini", "VersionVanillaName", "Unknown") <> "Unknown" Then
'读取版本信息
@@ -1375,7 +1370,7 @@ OnLoaded:
End If
Catch ex As Exception
Log(ex, "读取版本加载缓存失败（" & Folder & "）", LogLevel.Debug)
Log(ex, "读取版本加载缓存失败（" & VersionName & "）", NotifyLevel.DebugModeOnly)
Return Nothing
End Try
Next
@@ -1388,20 +1383,21 @@ OnLoaded:
Return Nothing
End Try
End Function
Private Function InitMcInstanceListWithoutCache(Path As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Private Function InitMcInstanceListWithoutCache(Folder As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Dim InstanceList As New List(Of McInstance)
#Region "循环加载每个版本的信息"
For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹：" & Folder.FullName)
For Each VersionFolderInfo As DirectoryInfo In New DirectoryInfo(Folder & "versions").GetDirectories
If Not VersionFolderInfo.Exists OrElse Not VersionFolderInfo.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹：" & VersionFolderInfo.FullName)
Continue For
End If
If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目：" & Folder.FullName)
If (VersionFolderInfo.Name = "cache" OrElse VersionFolderInfo.Name = "BLClient" OrElse VersionFolderInfo.Name = "PCL") AndAlso
Not File.Exists(VersionFolderInfo.FullName & "\" & VersionFolderInfo.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目：" & VersionFolderInfo.FullName)
Continue For
End If
Dim VersionFolder As String = Folder.FullName & "\"
Dim VersionFolder As String = VersionFolderInfo.FullName & "\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcInstanceListLoad Then
Log("[Minecraft] 清理残留的忽略项目：" & VersionFolder) '#2781
@@ -1517,7 +1513,7 @@ OnLoaded:
Catch ex As Exception
Results.Clear()
Log(ex, "分类版本列表失败", LogLevel.Feedback)
Log(ex, "分类版本列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
#End Region
#Region "对卡片与版本进行排序"
@@ -1558,14 +1554,14 @@ OnLoaded:
#End Region
#Region "保存卡片缓存"
WriteIni(Path & "PCL.ini", "CardCount", Results.Count)
WriteIni(Folder & "PCL.ini", "CardCount", Results.Count)
For i = 0 To Results.Count - 1
WriteIni(Path & "PCL.ini", "CardKey" & (i + 1), Results.Keys(i))
WriteIni(Folder & "PCL.ini", "CardKey" & (i + 1), Results.Keys(i))
Dim Value As String = ""
For Each Instance As McInstance In Results.Values(i)
Value += Instance.Name & ":"
Next
WriteIni(Path & "PCL.ini", "CardValue" & (i + 1), Value)
WriteIni(Folder & "PCL.ini", "CardValue" & (i + 1), Value)
Next
#End Region
Return Results
@@ -1637,7 +1633,7 @@ OnLoaded:
Return New McSkinInfo With {.IsVaild = False}
End If
Catch ex As Exception
Log(ex, "皮肤文件存在错误", LogLevel.Hint)
Log(ex, "皮肤文件存在错误", NotifyLevel.AllUsers)
Return New McSkinInfo With {.IsVaild = False}
End Try
@@ -1685,7 +1681,7 @@ OnLoaded:
Next
Throw New Exception("未从皮肤返回值中找到符合条件的 Property")
Catch ex As Exception
Log(ex, "无法完成解析的皮肤返回值，可能是未设置自定义皮肤的用户：" & SkinString, LogLevel.Developer)
Log(ex, "无法完成解析的皮肤返回值，可能是未设置自定义皮肤的用户：" & SkinString, NotifyLevel.DevelopOnly)
Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex)
End Try
SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue))
@@ -1796,7 +1792,7 @@ OnLoaded:
Public OriginalName As String
Public Overrides Function ToString() As String
Return If(IsNatives, "[Native] ", "") & GetString(Size) & " | " & LocalPath
Return If(IsNatives, "[Native] ", "") & FormatFileSize(Size) & " | " & LocalPath
End Function
End Class
@@ -1885,7 +1881,7 @@ OnLoaded:
'不能调用 RealVersion.Check()，可能会莫名其妙地触发 CheckPermission 正被另一进程使用，导致误判前置不存在
If Not File.Exists(RealInstance.PathVersion & RealInstance.Name & ".json") Then
RealInstance = Instance
Log("[Minecraft] 可能缺少前置版本 " & RealInstance.Name & "，找不到对应的 json 文件", LogLevel.Debug)
Log("[Minecraft] 可能缺少前置版本 " & RealInstance.Name & "，找不到对应的 json 文件", NotifyLevel.DebugModeOnly)
End If
'获取详细下载信息
If RealInstance.JsonObject("downloads") IsNot Nothing AndAlso RealInstance.JsonObject("downloads")("client") IsNot Nothing Then
@@ -1933,7 +1929,7 @@ OnLoaded:
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.Url = If(Library("downloads")("artifact")("url"), RootUrl),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
@@ -1947,24 +1943,26 @@ OnLoaded:
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End Try
ElseIf Library("natives")("windows") IsNot Nothing Then '有 Windows Natives
Dim NativeName As String = Library("natives")("windows")
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("classifiers") IsNot Nothing AndAlso Library("downloads")("classifiers")("natives-windows") IsNot Nothing Then
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("classifiers") IsNot Nothing AndAlso Library("downloads")("classifiers")(NativeName) IsNot Nothing Then
Dim NativeData = Library("downloads")("classifiers")(NativeName)
BasicArray.Add(New McLibToken With {
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
.LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
.Url = If(NativeData("url"), RootUrl),
.LocalPath = If(NativeData("path") Is Nothing,
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").
Replace(".jar", "-" & NativeName & ".jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
$"{CustomMcFolder}libraries\{Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")}"),
.Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString),
$"{CustomMcFolder}libraries\{NativeData("path").ToString.Replace("/", "\")}"),
.Size = Val(NativeData("size").ToString),
.IsNatives = True,
.SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
.SHA1 = NativeData("sha1").ToString})
Else
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace(".jar", $"-{NativeName}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End If
@@ -1973,7 +1971,7 @@ OnLoaded:
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace(".jar", $"-{NativeName}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End Try
@@ -2026,7 +2024,7 @@ OnLoaded:
Dim MainJar As NetFile = DlClientJarGet(Instance, True)
If MainJar IsNot Nothing Then Result.Add(MainJar)
Catch ex As Exception
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
Log(ex, "版本缺失主 jar 文件所必须的信息", NotifyLevel.DevelopOnly)
End Try
'Library 文件
@@ -2077,11 +2075,11 @@ OnLoaded:
'跳过校验
If ShouldIgnoreFileCheck(Instance) Then
Log("[Minecraft] 设置要求尽量忽略文件检查，这可能会保留有误的文件", LogLevel.Debug)
Log("[Minecraft] 设置要求尽量忽略文件检查，这可能会保留有误的文件", NotifyLevel.DebugModeOnly)
Result = Result.Where(
Function(f)
If File.Exists(f.LocalPath) Then
Log("[Minecraft] 跳过下载的支持库文件：" & f.LocalPath, LogLevel.Debug)
Log("[Minecraft] 跳过下载的支持库文件：" & f.LocalPath, NotifyLevel.DebugModeOnly)
Return False
Else
Return True
@@ -2101,7 +2099,7 @@ OnLoaded:
For Each Token As McLibToken In Libs
'检查器
Dim Checker As FileChecker
If Token.Name.ContainsF("labymod") Then
If Token.Name.ContainsIgnoreCase("labymod") Then
Checker = New FileChecker '不检查 LabyMod 的文件，它们提供的文件校验信息是错的（#3225）
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
@@ -2120,7 +2118,7 @@ OnLoaded:
End If
If Token.Url.Contains("maven") Then
Dim BmclapiUrl As String =
Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven")
Token.Url.Replace(Token.Url.Substring(0, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven")
If DlSourcePreferMojang Then
Urls.Add(BmclapiUrl) '官方源优先
Else
@@ -2130,8 +2128,8 @@ OnLoaded:
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
If Not File.Exists(Token.LocalPath) Then WriteFile(Token.LocalPath, GetResources("Transformer"))
Log("[Download] 已自动释放 Transformer Discovery Service", LogLevel.Developer)
If Not File.Exists(Token.LocalPath) Then FileUtils.Write(Token.LocalPath, GetResources("Transformer"))
Log("[Download] 已自动释放 Transformer Discovery Service", NotifyLevel.DevelopOnly)
Continue For
ElseIf Token.LocalPath.Contains("optifine\OptiFine") Then
'OptiFine 主 Jar
@@ -2146,7 +2144,7 @@ OnLoaded:
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next
'去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
Return Result.DistinctBy(Function(a) a.LocalPath).ToList
End Function
''' <summary>
''' 获取对应的支持库文件地址。
@@ -2253,7 +2251,7 @@ OnLoaded:
Public Hash As String
Public Overrides Function ToString() As String
Return GetString(Size) & " | " & LocalPath
Return FormatFileSize(Size) & " | " & LocalPath
End Function
End Structure
''' <summary>
@@ -2367,7 +2365,7 @@ OnLoaded:
End If
Catch ex As Exception
Log(ex, "Minecraft 更新提示发送失败（" & If(VersionName, "Nothing") & "）", LogLevel.Feedback)
Log(ex, "Minecraft 更新提示发送失败（" & If(VersionName, "Nothing") & "）", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -2459,7 +2457,7 @@ NextEntry:
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken IsNot Nothing AndAlso AccessToken.Length >= 10 AndAlso Raw.ContainsF(AccessToken, True) AndAlso
If AccessToken IsNot Nothing AndAlso AccessToken.Length >= 10 AndAlso Raw.ContainsIgnoreCase(AccessToken) AndAlso
McLoginLoader.Output.Uuid <> McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Raw = Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
-876
View File
@@ -1,876 +0,0 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 13
Public Class McMod
#Region "基础"
''' <summary>
''' Mod 文件的地址。
''' </summary>
Public ReadOnly Path As String
Public Sub New(Path As String)
Me.Path = If(Path, "")
End Sub
''' <summary>
''' Mod 的完整路径，去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawPath As String
Get
Return GetPathFromFullPath(Path) & RawFileName
End Get
End Property
''' <summary>
''' Mod 的完整文件名。
''' </summary>
Public ReadOnly Property FileName As String
Get
Return GetFileNameFromPath(Path)
End Get
End Property
''' <summary>
''' Mod 的完整文件名，去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawFileName As String
Get
Return FileName.Replace(".disabled", "").Replace(".old", "")
End Get
End Property
''' <summary>
''' Mod 的状态。
''' </summary>
Public ReadOnly Property State As McModState
Get
If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
End If
End Get
End Property
Public Enum McModState As Integer
Fine = 0
Disabled = 1
End Enum
#End Region
#Region "信息项"
''' <summary>
''' 当任何信息在初始化后更新时触发。
''' </summary>
Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名，但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get
If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value
End If
End Set
End Property
Private _Name As String = Nothing
''' <summary>
''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary>
Public Property Description As String
Get
Return _Description
End Get
Set(value As String)
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf)
'优化显示：若以 [a-zA-Z0-9] 结尾，加上小数点句号
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If
End Set
End Property
Private _Description As String = Nothing
''' <summary>
''' Mod 的版本。
''' 不保证符合版本格式规范，且可能为 Nothing。
''' </summary>
Public Property Version As String
Get
If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value
End Set
End Property
Public _Version As String = Nothing
#End Region
#Region "从 JAR 获取信息"
''' <summary>
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(Path, "null") & "）")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open, FileAccess.Read, FileShare.Read))
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开（" & Path & "）", LogLevel.Developer)
Catch ex As Exception
Log(ex, "Mod 文件无法打开（" & Path & "）", LogLevel.Developer)
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
'获取信息文件
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open())
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
'获取可用 Json 项
Dim InfoObject As JObject
Dim JsonObject = GetJson(InfoString)
If JsonObject.Type = JTokenType.Array Then
InfoObject = JsonObject(0)
Else
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
DisplayName = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Log(ex, "读取 mcmod.info 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open())
If TomlText.Length < 15 Then TomlText = Nothing
End If
If TomlText Is Nothing Then Exit Try
'文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, "　"c}) '去除头尾的空格
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, "　"c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, "　"c})
Dim Value As Object
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理（#2732）
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
ValueLines.Add(ValueLine)
End If
Loop
End If
Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型
Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then
'数字型
Value = Val(RawValue)
Else
'不知道是个啥玩意儿，直接存储
Value = RawValue
End If
TomlData.Last.Value(Key) = Value
Else
'不知道是个啥玩意儿
Exit Try
End If
Next
'从文件数据中获取信息
Dim ModEntry As Dictionary(Of String, Object) = Nothing
For Each TomlSubData In TomlData
If TomlSubData.Key = "mods" Then
ModEntry = TomlSubData.Value
Exit For
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 mods.toml 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then
FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If
If FmlText Is Nothing Then Exit Try
Dim FmlJson As JObject = GetJson(FmlText)
'获取可用 Json 项
Dim FmlObject As JObject = Nothing
For Each ModFilePair In FmlJson
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
If ModFileAnnos IsNot Nothing Then
'先获取 Mod
For Each ModFileAnno In ModFileAnnos
Dim Name As String = If(ModFileAnno("name"), "")
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
FmlObject = ModFileAnno("values")
GoTo Got
End If
Next
End If
Next
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
End If
Catch ex As Exception
Log("获取 META-INF 中的版本信息失败（" & Path & "）", LogLevel.Developer)
Version = Nothing
End Try
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
#End Region
#Region "网络信息"
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
Public Property Comp As CompProject
Get
Return _Comp
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _Comp As CompProject
''' <summary>
''' 本地文件对应的联网文件信息。
''' </summary>
Public CompFile As CompFile
''' <summary>
''' 该 Mod 对应的联网最新版本。
''' </summary>
Public Property UpdateFile As CompFile
Get
Return _UpdateFile
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
''' <summary>
''' 该 Mod 的更新日志网址。
''' </summary>
Public ChangelogUrls As New List(Of String)
''' <summary>
''' 所有网络信息是否已成功加载。
''' </summary>
Public CompLoaded As Boolean = False
''' <summary>
''' 将网络信息保存为 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
Json.Add("CompLoaded", CompLoaded)
If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
Return Json
End Function
''' <summary>
''' 从 Json 中读取网络信息。
''' </summary>
Public Sub FromJson(Json As JObject)
CompLoaded = Json("CompLoaded")
If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
End Sub
''' <summary>
''' 该文件是否可以更新。
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get
End Property
''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值（MurmurHash2）。
''' </summary>
Public ReadOnly Property CurseForgeHash As UInteger
Get
If _CurseForgeHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
'计算 MurmurHash2
Dim length As Integer = data.Count
Dim h As UInteger = 1 Xor length '1 是种子
Dim i As Integer
For i = 0 To length - 4 Step 4
Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
k = (k * &H5BD1E995L) And &HFFFFFFFFL
k = k Xor (k >> 24)
k = (k * &H5BD1E995L) And &HFFFFFFFFL
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor k
Next
Select Case length - i
Case 3
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = h Xor (CUInt(data(i + 2)) << 16)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 2
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 1
h = h Xor data(i)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
End Select
h = h Xor (h >> 13)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15)
_CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If
Return _CurseForgeHash
End Get
End Property
Private _CurseForgeHash As UInteger?
''' <summary>
''' 获取用于 Modrinth 信息获取的 Hash 值（SHA1）。
''' </summary>
Public ReadOnly Property ModrinthHash As String
Get
If _ModrinthHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_ModrinthHash = Cached
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(Path)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
Return _ModrinthHash
End Get
End Property
Private _ModrinthHash As String
#End Region
#Region "API"
Public Overrides Function ToString() As String
Return $"{State} - {Path}"
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim target = TryCast(obj, McMod)
Return target IsNot Nothing AndAlso Path = target.Path
End Function
#End Region
''' <summary>
''' 是否可能为前置 Mod。目前非常不准确。
''' </summary>
Public Function IsPresetMod() As Boolean
Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
End Function
''' <summary>
''' 根据完整文件路径的文件扩展名判断是否为 Mod 文件。
''' </summary>
Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.Lower
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
Return False
End Function
End Class
'加载 Mod 列表
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input)
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsInterrupted Then Return
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For
End If
End If
If McMod.IsModFile(File.FullName) Then ModFileList.Add(File)
Next
End If
'获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息", LogLevel.Debug)
Cache = New JObject
End If
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败，已重置")
Cache = New JObject
End Try
Cache("version") = LocalModCacheVersion
'加载 Mod 列表
Dim ModList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
If Loader.IsInterrupted Then Return
Dim ModEntry As New McMod(ModFile.FullName)
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件，名称相同，但一个启用一个禁用
If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
Log($"[Mod] 重复的 Mod 文件：{DumpMod.FileName} 与 {ModEntry.FileName}，已忽略 {DisabledMod.FileName}", LogLevel.Debug)
If DisabledMod Is ModEntry Then
Continue For
Else
ModList.Remove(DisabledMod)
End If
End If
ModList.Add(ModEntry)
Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.OrderBy(Function(m) m.FileName).ToList
'回设
If Loader.IsInterrupted Then Return
Loader.Output = ModList
'开始联网加载
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
Throw
End Try
End Sub
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As New List(Of McMod)
Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存，获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息，{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支）
Return
End If
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders()
Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
Sub()
Try
'步骤 1：获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存，加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
Entry.CompFile = File
Else
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
'步骤 4：获取更新信息
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
If Not UpdateFile.Available Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息
RunInNewThread(
Sub()
Try
'步骤 1：获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存，加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(Project("file"), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
End If
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
Next
For Each FileId In NewestFileIds
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of McMod)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4：获取更新文件信息
If Not UpdateFileIds.Any() Then Return
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod)
If Not File.Available Then Continue For
For Each Entry As McMod In UpdateFileIds(File.Id)
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
UpdateFiles(Entry) = File
Next
Next
For Each Pair In UpdateFiles
Dim Entry As McMod = Pair.Key
Dim UpdateFile As CompFile = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息（上面有另一个分支）
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
If Loader.IsInterrupted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsInterrupted Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If
End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
End Module
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+57 -33
View File
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModModpack
Public Module ModModpack
'触发整合包安装的外部接口
''' <summary>
@@ -15,7 +13,7 @@ Public Module ModModpack
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
Log(ex, "手动安装整合包失败", NotifyLevel.MsgBox)
End Try
End Sub)
End Sub
@@ -251,8 +249,35 @@ Retry:
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
'如果文件已被删除，则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除，所以没法继续安装了，请向整合包作者反馈该问题")
If ModList.Count = Task.Output.Count Then Return
'如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
'获取缺失的 fileId 列表
Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList
Log("[Modpack] 缺失的 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("、"))
'尝试获取对应的工程信息
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, "获取缺失的工程信息失败")
End Try
Dim MissingDesc As New List(Of String)
For Each Missing In Missings
Dim Project = Projects.FirstOrDefault(Function(p) p.Id = Missing.ProjectId)
If Project Is Nothing Then
MissingDesc.Add($"未知 CurseForge 项目 (项目 ID {Missing.ProjectId}，文件 ID {Missing.FileId})")
Else
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
End If
Next
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
Task.Interrupt()
End If
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
@@ -269,23 +294,23 @@ Retry:
End If
End If
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String, Type As CompType
Dim TargetFolder As String, Type As ResourceTypes
If ModJson("modules").Any Then 'modules 可能返回 null（#1006）
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
TargetFolder = "mods" : Type = CompType.Mod
TargetFolder = "mods" : Type = ResourceTypes.Mod
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
TargetFolder = "resourcepacks" : Type = ResourceTypes.ResourcePack
Else
TargetFolder = "shaderpacks" : Type = CompType.Shader
TargetFolder = "shaderpacks" : Type = ResourceTypes.Shader
End If
Else
TargetFolder = "mods" : Type = CompType.Mod
TargetFolder = "mods" : Type = ResourceTypes.Mod
End If
'建立 CompFile
Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
If Not File.DownloadAvailable Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
@@ -330,7 +355,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
End If
@@ -425,11 +450,11 @@ Retry:
End Select
End If
'添加下载文件
Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
If Not Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
@@ -471,7 +496,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
End If
@@ -576,18 +601,18 @@ Retry:
Task, 0.4)
'读取 MMC 设置文件（#2655）
Try
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MMCSetupFile) Then
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MmcSetupFile) Then
'将其中的等号替换为冒号，以符合 ini 文件格式
Dim Lines As New List(Of String)
For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
For Each Line In ReadFile(MmcSetupFile).Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
FileUtils.Write(MmcSetupFile, Lines.Join(vbCrLf))
'读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
If ReadIni(MmcSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
Replace("$INST_JAVA", "{java}javaw.exe").
@@ -598,16 +623,16 @@ Retry:
Log("[ModPack] 迁移 MultiMC 版本独立设置：启动前执行命令：" & PreLaunchCommand)
End If
End If
If ReadIni(MMCSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MMCSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置：自动进入服务器：" & ServerAddress)
End If
If ReadIni(MMCSetupFile, "IgnoreJavaCompatibility", False) Then
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MMCSetupFile, "iconKey", "")
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
@@ -615,9 +640,9 @@ Retry:
Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs)
Else
@@ -770,6 +795,7 @@ Retry:
New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
OpenExplorer(TargetFolder)
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
@@ -779,7 +805,7 @@ Retry:
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器：{ExeFile}")
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
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
@@ -792,7 +818,6 @@ Retry:
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
@@ -801,10 +826,9 @@ Retry:
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
DirectoryUtils.Create(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+9 -9
View File
@@ -105,7 +105,7 @@
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
Log(ex, "Minecraft 日志监控主循环出错", NotifyLevel.MsgBoxAndFeedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
@@ -174,14 +174,14 @@
End If
End If
Catch ex As Exception
Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback)
Log(ex, "输出 Minecraft 日志失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public LatestLog As New Queue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Return
Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
Text = Text.ReplaceLineEndings(vbCrLf)
'If Text.Contains("�����") Then Hint("检测到错误的日志编码：" & Text)
'加入预存储
LatestLog.Enqueue(Text)
@@ -194,7 +194,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5：游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
ElseIf LogProgress < 3 AndAlso Text.ContainsIgnoreCase("lwjgl version") Then
WatcherLog("日志 3/5：LWJGL 版本已确认")
LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -265,7 +265,7 @@
MinecraftWindow = TryGetMinecraftWindow()
Catch ex As ComponentModel.Win32Exception
'拒绝访问（#1062）
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogLevel.Hint)
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", NotifyLevel.AllUsers)
IsWindowFinished = True
End Try
If MinecraftWindow Is Nothing Then Return
@@ -297,7 +297,7 @@
End If
IsWindowAppeared = True
Catch ex As Exception
Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback)
Log(ex, "检查 Minecraft 窗口失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -361,9 +361,9 @@
Analyzer.Prepare()
Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From
{Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
Log(ex, "崩溃分析失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub, "Crash Analyzer")
End Sub
@@ -376,7 +376,7 @@
If Not GameProcess.HasExited Then GameProcess.Kill()
WatcherLog("已强制结束 Minecraft 进程")
Catch ex As Exception
Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint)
Log(ex, "强制结束 Minecraft 进程失败", NotifyLevel.AllUsers)
End Try
End Sub