同步 2.3.4 代码

2022-09-25 20:53:23 +08:00
parent f1310f18fd
commit 47a2fe2315
41 changed files with 451 additions and 386 deletions
@@ -119,7 +119,7 @@
                Log("[Crash] 已解压导入的日志文件：" & FilePath)
            Else
                '解压失败
-                File.Copy(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
+                CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
                Log("[Crash] 已复制导入的日志文件：" & FilePath)
            End If
        Catch ex As Exception
@@ -363,7 +363,8 @@
            '来源崩溃日志的分析
            If LogCrash IsNot Nothing Then
                Log("[Crash] 开始进行崩溃日志堆栈分析")
-                Dim Keywords = AnalyzeStackKeyword(LogCrash.Replace("A detailed walkthrough of the error", "¨").Split("¨").First)
+                Dim StackLogs As String = LogCrash.Replace("System Details", "¨").Split("¨").First
+                Dim Keywords = AnalyzeStackKeyword(StackLogs)
                If Keywords.Count > 0 Then
                    Dim Names = AnalyzeModName(Keywords)
                    If Names Is Nothing Then
@@ -480,10 +481,11 @@ Done:
                AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类)
            End If
            'Mod 导致的崩溃
-            If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.InjectionError") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
+            If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
                Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
                If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
                If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
+                If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback )[^./ ]+(?=.mixins.json:)")
                AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
            End If
            If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
@@ -504,7 +506,6 @@ Done:
        '崩溃报告分析
        If LogCrash IsNot Nothing Then
            If LogCrash.Contains("maximum id range exceeded") Then AppendReason(CrashReason.Mod过多导致超出ID限制)
-            If LogCrash.Contains("Entity being rendered") AndAlso LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
            If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
            If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
            If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
@@ -555,7 +556,7 @@ Done:
            For Each IgnoreStack In {
                "java", "sun", "javax", "jdk",
                "org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
-                "com.electronwill.nightconfig",
+                "com.electronwill.nightconfig", "it.unimi.dsi",
                "MojangTricksIntelDriversForPerformance_javaw"}
                If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
            Next
@@ -576,12 +577,12 @@ NextStack:
            For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
                Dim Word As String = Splited(i)
                If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
-                If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api",
+                If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi",
                    "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base",
-                    "forge", "setup", "block", "model", "mixin", "event",
+                    "forge", "setup", "block", "model", "mixin", "event", "unimi",
                    "common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github",
-                    "preinit", "preload", "machine", "reflect", "channel", "general", "handler",
-                    "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
+                    "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
+                    "fastutil", "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
                   }.Contains(Word.ToLower) Then Continue For
                PossibleWords.Add(Word.Trim)
            Next
@@ -700,20 +701,16 @@ NextStack:
                    '复制文件
                    If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
                    For Each OutputFile In OutputFiles
-                        Try
-                            Dim FileName As String = GetFileNameFromPath(OutputFile)
-                            Select Case FileName
-                                Case "LatestLaunch.bat"
-                                    FileName = "启动脚本.bat"
-                                Case "Log1.txt"
-                                    FileName = "PCL2 启动器日志.txt"
-                                Case "RawOutput.log"
-                                    FileName = "游戏崩溃前的输出.txt"
-                            End Select
-                            File.Copy(OutputFile, TempFolder & "Report\" & FileName, True)
-                        Catch ex As Exception
-                            Log(ex, "复制错误报告文件失败（" & OutputFile & "）")
-                        End Try
+                        Dim FileName As String = GetFileNameFromPath(OutputFile)
+                        Select Case FileName
+                            Case "LatestLaunch.bat"
+                                FileName = "启动脚本.bat"
+                            Case "Log1.txt"
+                                FileName = "PCL2 启动器日志.txt"
+                            Case "RawOutput.log"
+                                FileName = "游戏崩溃前的输出.txt"
+                        End Select
+                        CopyFile(OutputFile, TempFolder & "Report\" & FileName)
                    Next
                    '导出报告
                    Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
@@ -117,13 +117,8 @@
                                                                                                    End Sub))
                LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
                LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
-                                                                                                      Try
-                                                                                                          File.Copy(TempAddress, RealAddress, True)
-                                                                                                          McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
-                                                                                                      Catch ex As Exception
-                                                                                                          Log(ex, "后台更新资源文件索引失败", LogLevel.Debug)
-                                                                                                          McLaunchLog("后台更新资源文件索引失败：" & TempAddress)
-                                                                                                      End Try
+                                                                                                      CopyFile(TempAddress, RealAddress)
+                                                                                                      McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
                                                                                                  End Sub))
                Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
                Log("[Download] 开始后台更新资源文件索引")
@@ -944,7 +939,7 @@

 #Region "DlCfProject | CurseForge 工程"

-    Private DlCfProjectDb As JObject = Nothing
+    Private DlCfProjectDb As Dictionary(Of String, String) = Nothing
    Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)

    ''' <summary>
@@ -1008,9 +1003,7 @@
        Private _MCBBS As String
        Public Property MCBBS As String
            Get
-                If DlCfProjectDb Is Nothing Then
-                    DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
-                End If
+                ReleaseCfDatabase()
                If _MCBBS Is Nothing Then
                    If Website IsNot Nothing Then
                        Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
@@ -1029,9 +1022,7 @@
        Private _ChineseName As String
        Public Property ChineseName As String
            Get
-                If DlCfProjectDb Is Nothing Then
-                    DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
-                End If
+                ReleaseCfDatabase()
                If _ChineseName Is Nothing Then
                    _ChineseName = Name
                    If Website IsNot Nothing Then
@@ -1040,7 +1031,7 @@
                            Dim Result As String = DlCfProjectDb(Keyword)
                            McWikiId = Result.Split("|")(0)
                            If Not Result.Split("|")(1) = "~" Then '使用原名
-                                _ChineseName = Result.Split("|")(1) '& " (" & Name & ")"
+                                _ChineseName = Result.Split("|")(1)
                            End If
                        End If
                    End If
@@ -1233,10 +1224,7 @@
        Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
        If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then
            If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文")
-            '释放资料库文件
-            If DlCfProjectDb Is Nothing Then
-                DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
-            End If
+            ReleaseCfDatabase()
            '构造搜索请求
            Dim SearchEntries As New List(Of SearchEntry(Of String))
            For Each Entry In DlCfProjectDb
@@ -1338,6 +1326,22 @@
        Return New DlCfProject(Json)
    End Function

+    ''' <summary>
+    ''' 读取 Mod 数据库。
+    ''' </summary>
+    Private Sub ReleaseCfDatabase()
+        If DlCfProjectDb IsNot Nothing Then Exit Sub
+        DlCfProjectDb = New Dictionary(Of String, String)
+        For Each Entry In CType(GetJson(DecodeBytes(GetResources("ModData"))), JObject)
+            Dim Result As String = Entry.Value.ToString
+            If Not Result.Split("|")(1) = "~" Then '处理 *
+                Result = Result.Replace("*", " (" &
+                        String.Join(" ", Entry.Key.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
+            End If
+            DlCfProjectDb.Add(Entry.Key, Result)
+        Next
+    End Sub
+
 #End Region

 #Region "DlCfFile | CurseForge Files"
@@ -106,14 +106,22 @@ NextInner:
        '检查路径
        If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）")
        If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
-        '检查输入信息
-        Dim CheckResult As String = Nothing
-        RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput))
-        If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
        '检查版本
        If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
        McVersionCurrent.Load()
        If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
+        '检查输入信息
+        Dim CheckResult As String = ""
+        RunInUiWait(Sub()
+                        Dim LoginInput As McLoginData = McLoginInput()
+                        CheckResult = McLoginAble(LoginInput)
+                        If LoginInput.Type = McLoginType.Legacy AndAlso '离线登录
+                            Not RegexCheck(CType(LoginInput, McLoginLegacy).UserName, "^[0-9A-Za-z_]+$") AndAlso
+                            McVersionCurrent.Version.McCodeMain >= 18 Then 'MC 1.18 以上
+                            CheckResult = "用户名中不可包含除数字、英文、下划线以外的特殊字符！"
+                        End If
+                    End Sub)
+        If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
        '求赞助
        If ThemeCheckGold() Then Exit Sub
        RunInNewThread(Sub()
@@ -757,10 +765,11 @@ LoginFinish:
    '微软登录步骤 1：打开网页认证，获取 OAuth Code
    Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
        McLaunchLog("开始微软登录步骤 1")
-        If OsVersion <= New Version(10, 0, 17763, 0) Then 'TODO: 添加设置以强制使用网页中继登录
+        If OsVersion <= New Version(10, 0, 17763, 0) Then
+SystemBrowser:
            'Windows 7 或老版 Windows 10 登录
            MyMsgBox("PCL2 即将打开登录网页。登录后会转到一个空白页面（这代表登录成功了），请将该空白页面的网址复制到 PCL2。" & vbCrLf &
-                     "如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或代理服务器，然后再试。", "登录说明", "开始", ForceWait:=True)
+                     "如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或加速器，然后再试。", "登录说明", "开始", ForceWait:=True)
            OpenWebsite(FormLoginOAuth.LoginUrl1)
            Dim Result As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, "https://login.live.com/oauth20_desktop.srf?code=XXXXXX", "输入登录返回码", "确定", "取消")
            If Result Is Nothing Then
@@ -769,12 +778,14 @@ LoginFinish:
            Else
                Return RegexSeek(Result, "(?<=code\=)[^&]+")
            End If
+            Hint("网页登录已完成，你现在可以关闭浏览器上的那个网页了", HintType.Finish)
        Else
            'Windows 10 登录
            Dim ReturnCode As String = Nothing
            Dim ReturnEx As Exception = Nothing
            Dim IsFinished As LoadState = LoadState.Loading
            Dim LoginForm As FormLoginOAuth = Nothing
+            Dim IsSwitchToSystemBrowser As Boolean = False
            RunInUi(Sub()
                        Try
                            LoginForm = New FormLoginOAuth
@@ -783,7 +794,10 @@ LoginFinish:
                                                                     ReturnCode = Code
                                                                     IsFinished = LoadState.Finished
                                                                 End Sub
-                            AddHandler LoginForm.OnLoginCanceled, Sub() IsFinished = LoadState.Aborted
+                            AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
+                                                                      IsFinished = LoadState.Aborted
+                                                                      IsSwitchToSystemBrowser = IsSwitch
+                                                                  End Sub
                        Catch ex As Exception
                            ReturnEx = ex
                            IsFinished = LoadState.Failed
@@ -797,6 +811,9 @@ LoginFinish:
                Return ReturnCode
            ElseIf IsFinished = LoadState.Failed Then
                Throw ReturnEx
+            ElseIf IsSwitchToSystemBrowser Then
+                McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
+                GoTo SystemBrowser
            Else
                McLaunchLog("微软登录已在步骤 1 被取消")
                Throw New ThreadInterruptedException("$$")
@@ -982,7 +999,7 @@ LoginFinish:
 #Region "Java 处理"

    Private McLaunchJavaSelected As JavaEntry = Nothing
-    Private Sub McLaunchJavaValidate()
+    Private Sub McLaunchJavaValidate(Task As LoaderTask(Of Integer, List(Of NetFile)))
        Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)

        'MC 大版本检测
@@ -1028,6 +1045,7 @@ LoginFinish:
        '选择 Java
        McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
        McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent)
+        If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
        If McLaunchJavaSelected IsNot Nothing Then
            McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
            Exit Sub
@@ -1151,6 +1169,14 @@ LoginFinish:
                              " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
        End If

+        '添加 Java Wrapper 作为主 Jar
+        Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
+        If Not File.Exists(WrapperPath) Then
+            WriteFile(WrapperPath, GetResources("JavaWrapper"))
+            McLaunchLog("已自动释放 Java Wrapper")
+        End If
+        DataList.Add("-jar """ & WrapperPath & """")
+
        '添加 MainClass
        If Version.JsonObject("mainClass") Is Nothing Then
            Throw New Exception("版本 Json 中没有 mainClass 项！")
@@ -1232,6 +1258,14 @@ NextVersion:
        '去重
        Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ")

+        '添加 Java Wrapper 作为主 Jar
+        Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
+        If Not File.Exists(WrapperPath) Then
+            WriteFile(WrapperPath, GetResources("JavaWrapper"))
+            McLaunchLog("已自动释放 Java Wrapper")
+        End If
+        Result += " -jar """ & WrapperPath & """"
+
        '添加 MainClass
        If Version.JsonObject("mainClass") Is Nothing Then
            Throw New Exception("版本 Json 中没有 mainClass 项！")
@@ -1251,18 +1285,21 @@ NextVersion:
        If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
        DataList.Add(BasicString)

-        McLaunchArgumentsGameOld = Join(DataList, " ")
+        '添加 Wrapper 导出参数
+        DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
+
+        Dim Result As String = Join(DataList, " ")

        '特别改变 OptiFineTweaker
        If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
            '把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！
-            If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
-                Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld)
-                McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
+            If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
+                Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & Result)
+                Result = Result.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
            End If
-            If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineTweaker") Then
-                Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld)
-                McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
+            If Result.Contains("--tweakClass optifine.OptiFineTweaker") Then
+                Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & Result)
+                Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
                Try
                    WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
                Catch ex As Exception
@@ -1270,6 +1307,8 @@ NextVersion:
                End Try
            End If
        End If
+
+        Return Result
    End Function
    Private Function McLaunchArgumentsGameNew(Version As McVersion) As String
        Dim DataList As New List(Of String)
@@ -1302,6 +1341,9 @@ NextVersion:
            GoTo NextVersion
        End If

+        '添加 Wrapper 导出参数
+        DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
+
        '将 "-XXX" 与后面 "XXX" 合并到一起
        '如果不进行合并 Impact 会启动无效，它有两个 --tweakclass
        Dim DeDuplicateDataList As New List(Of String)
@@ -225,7 +225,7 @@ Public Module ModMinecraft
                JavaSearchFolder(Disk.Name, JavaPreList, False)
            Next
            '查找 APPDATA 文件夹中的 Java
-            JavaSearchFolder(PathAppdata, JavaPreList, False)
+            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), JavaPreList, False)
            '查找启动器目录中的 Java
            JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
            '查找所选 Minecraft 文件夹中的 Java
@@ -404,7 +404,7 @@ Wait:
            Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）")
        End Try
    End Sub
-    Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\"
+    Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"

    '获取

@@ -1075,7 +1075,7 @@ VersionSearchFinish:
        Public Property JsonText As String
            Get
                If _JsonText Is Nothing Then
-                    If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 Json 文件")
+                    If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 Json 文件：" & Path & Name & ".json")
                    _JsonText = ReadFile(Path & Name & ".json")
                    '如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试
                    If _JsonText.Length = 0 Then
@@ -1264,7 +1264,7 @@ Recheck:
            Try
                Dim JsonObjCheck = JsonObject
            Catch ex As Exception
-                Log(ex, "版本 Json 可用性检查失败（" & Name & "）")
+                Log(ex, "版本 Json 可用性检查失败（" & Path & "）")
                JsonText = ""
                JsonObject = Nothing
                Info = ex.Message
@@ -20,7 +20,7 @@
            '获取整合包种类与关键 Json
            Dim PackType As Integer = -1
            Try
-                Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open))
+                Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
                '从根目录判断整合包类型
                If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
                If Archive.GetEntry("manifest.json") IsNot Nothing Then
@@ -54,7 +54,10 @@
                    If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
                Next
            Catch ex As Exception
-                If File.ToLower.EndsWith(".rar") Then
+                If GetString(ex, False, True).Contains("Error.WinIOError") Then
+                    Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
+                    Return False
+                ElseIf File.ToLower.EndsWith(".rar") Then
                    Log(ex, "PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
                    Return False
                Else
@@ -198,20 +201,20 @@ Retry:
        Dim OverrideHome As String = If(Json("overrides"), "")
        If OverrideHome <> "" Then
            InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
-                                                                  Sub(Task As LoaderTask(Of String, Integer))
-                                                                      UnpackFiles(InstallTemp, FileAddress)
-                                                                      Task.Progress = 0.5
-                                                                      '复制结果
-                                                                      If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
-                                                                          My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
-                                                                      Else
-                                                                          Log("[ModPack] 整合包中未找到 override 目录，已跳过")
-                                                                      End If
-                                                                      Task.Progress = 0.9
-                                                                      '开启版本隔离
-                                                                      WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
-                                                                  End Sub) With {
-                                                                  .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
+            Sub(Task As LoaderTask(Of String, Integer))
+                UnpackFiles(InstallTemp, FileAddress)
+                Task.Progress = 0.5
+                '复制结果
+                If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
+                    My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
+                Else
+                    Log("[ModPack] 整合包中未找到 override 目录，已跳过")
+                End If
+                Task.Progress = 0.9
+                '开启版本隔离
+                WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+            End Sub) With {
+            .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
        End If
        '获取 Mod 列表
        Dim ModFileList As New List(Of Integer)
@@ -225,26 +228,25 @@ Retry:
        Next
        If ModFileList.Count > 0 Then
            '获取 Mod 下载信息
-            InstallLoaders.Add(New LoaderTask(Of Integer, JArray)(
-                               "获取 Mod 下载信息",
-                               Sub(Task As LoaderTask(Of Integer, JArray))
-                                   Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
-                                   '如果文件已被删除，则 API 会跳过那一项
-                                   If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
-                               End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
+            InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
+            Sub(Task As LoaderTask(Of Integer, JArray))
+                Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
+                '如果文件已被删除，则 API 会跳过那一项
+                If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
+            End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
            '构造 NetFile
            InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
-                                                                   Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
-                                                                       Dim FileList As New Dictionary(Of Integer, NetFile)
-                                                                       For Each ModJson In Task.Input
-                                                                           '跳过重复的 Mod（疑似 CurseForge Bug）
-                                                                           If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
-                                                                           '实际的添加
-                                                                           FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
-                                                                           Task.Progress += 1 / (1 + ModFileList.Count)
-                                                                       Next
-                                                                       Task.Output = FileList.Values.ToList
-                                                                   End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
+            Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
+                Dim FileList As New Dictionary(Of Integer, NetFile)
+                For Each ModJson In Task.Input
+                    '跳过重复的 Mod（疑似 CurseForge Bug）
+                    If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
+                    '实际的添加
+                    FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
+                    Task.Progress += 1 / (1 + ModFileList.Count)
+                Next
+                Task.Output = FileList.Values.ToList
+            End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
            '下载 Mod 文件
            InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
        End If
@@ -342,19 +344,19 @@ Retry:
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
-                                                              Sub(Task As LoaderTask(Of String, Integer))
-                                                                  UnpackFiles(InstallTemp, FileAddress)
-                                                                  Task.Progress = 0.5
-                                                                  '复制结果
-                                                                  If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
-                                                                      My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
-                                                                  Else
-                                                                      Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
-                                                                  End If
-                                                                  Task.Progress = 0.9
-                                                                  '开启版本隔离
-                                                                  WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
-                                                              End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
+        Sub(Task As LoaderTask(Of String, Integer))
+            UnpackFiles(InstallTemp, FileAddress)
+            Task.Progress = 0.5
+            '复制结果
+            If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
+                My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
+            Else
+                Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
+            End If
+            Task.Progress = 0.9
+            '开启版本隔离
+            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+        End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
        '构造加载器
        If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
        Dim Request As New McInstallRequest With {
@@ -374,19 +376,19 @@ Retry:
        '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
        Dim LoadersLib As New List(Of LoaderBase)
        LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
-                                                         Sub()
-                                                             Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
-                                                             Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
-                                                             If File.Exists(OldFileName) Then
-                                                                 '修改 id
-                                                                 Dim FileJson = GetJson(ReadFile(OldFileName))
-                                                                 FileJson("id") = VersionName
-                                                                 '替换文件
-                                                                 File.Delete(OldFileName)
-                                                                 WriteFile(RealFileName, FileJson.ToString)
-                                                                 Log("[ModPack] 已重命名版本 Json：" & RealFileName)
-                                                             End If
-                                                         End Sub) With {.ProgressWeight = 0.1, .Show = False})
+        Sub()
+            Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
+            Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
+            If File.Exists(OldFileName) Then
+                '修改 id
+                Dim FileJson = GetJson(ReadFile(OldFileName))
+                FileJson("id") = VersionName
+                '替换文件
+                File.Delete(OldFileName)
+                WriteFile(RealFileName, FileJson.ToString)
+                Log("[ModPack] 已重命名版本 Json：" & RealFileName)
+            End If
+        End Sub) With {.ProgressWeight = 0.1, .Show = False})
        LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
        LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
        '构造总加载器
@@ -438,19 +440,19 @@ Retry:
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
-                                                              Sub(Task As LoaderTask(Of String, Integer))
-                                                                  UnpackFiles(InstallTemp, FileAddress)
-                                                                  Task.Progress = 0.5
-                                                                  '复制结果
-                                                                  If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
-                                                                      My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
-                                                                  Else
-                                                                      Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
-                                                                  End If
-                                                                  Task.Progress = 0.9
-                                                                  '开启版本隔离
-                                                                  WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
-                                                              End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
+        Sub(Task As LoaderTask(Of String, Integer))
+            UnpackFiles(InstallTemp, FileAddress)
+            Task.Progress = 0.5
+            '复制结果
+            If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
+                My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
+            Else
+                Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
+            End If
+            Task.Progress = 0.9
+            '开启版本隔离
+            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+        End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
        '构造版本安装请求
        If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
        Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
@@ -526,19 +528,19 @@ Retry:
        Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
        Dim InstallLoaders As New List(Of LoaderBase)
        InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
-                                                              Sub(Task As LoaderTask(Of String, Integer))
-                                                                  UnpackFiles(InstallTemp, FileAddress)
-                                                                  Task.Progress = 0.5
-                                                                  '复制结果
-                                                                  If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
-                                                                      My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
-                                                                  Else
-                                                                      Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
-                                                                  End If
-                                                                  Task.Progress = 0.9
-                                                                  '开启版本隔离
-                                                                  WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
-                                                              End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
+        Sub(Task As LoaderTask(Of String, Integer))
+            UnpackFiles(InstallTemp, FileAddress)
+            Task.Progress = 0.5
+            '复制结果
+            If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
+                My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
+            Else
+                Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
+            End If
+            Task.Progress = 0.9
+            '开启版本隔离
+            WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
+        End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
        '构造加载器
        If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
        Dim Addons As New Dictionary(Of String, String)