2.8.5

2024-08-31 02:39:45 +08:00
parent a74b2d55c7
commit 007b51b314
21 changed files with 388 additions and 370 deletions
@@ -1077,7 +1077,7 @@ Retry:
        If String.IsNullOrEmpty(Task.Input.SearchText) Then
            '如果没有搜索文本，按下载量将结果排序
            For Each Result As CompProject In RealResults
-                Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30))
+                Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
            Next
        Else
            '如果有搜索文本，按关联度将结果排序
@@ -1085,7 +1085,7 @@ Retry:
            Dim Entry As New List(Of SearchEntry(Of CompProject))
            For Each Result As CompProject In RealResults
                Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
-                           Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9)
+                           Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
                Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
                          New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
                          New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -844,8 +844,11 @@ NextStack:
    Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
        '弹窗提示
        FrmMain.ShowWindowToTop()
-        Dim ShowLog As Action =
+        Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
+            "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
+            Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
            Sub()
+                '弹窗选择：查看日志
                If File.Exists(DirectFile.Value.Key) Then
                    ShellOnly("notepad", DirectFile.Value.Key)
                Else
@@ -853,11 +856,9 @@ NextStack:
                    WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
                    ShellOnly(FilePath)
                End If
-            End Sub
-        Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
-                             "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
-                             Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
+            End Sub))
            Case 3
+                '弹窗选择：导出错误报告
                Dim FileAddress As String = Nothing
                Try
                    '获取文件路径
@@ -881,7 +882,7 @@ NextStack:
                                FileName = "游戏崩溃前的输出.txt"
                        End Select
                        If File.Exists(OutputFile) Then
-                            Dim FileEncoding As Encoding = GetEncoding(OutputFile)
+                            Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile))
                            WriteFile(TempFolder & "Report\" & FileName,
                                      SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
                                      Encoding:=FileEncoding)
@@ -216,8 +216,8 @@

            '添加特定的 Java
            Dim JavaPreList As New Dictionary(Of String, Boolean)
-            If PathMcFolder.Split("\").Count > 3 Then
-                JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录的话）
+            If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
+                JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
            End If
            JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
            JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
@@ -1,5 +1,4 @@
 Imports System.IO.Compression
-Imports Newtonsoft.Json

 Public Module ModLaunch

@@ -671,6 +670,7 @@ LoginFinish:
            Url:=Data.Input.BaseUrl & "/validate",
            Method:="POST",
            Data:=RequestData.ToString(0),
+            Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
            ContentType:="application/json; charset=utf-8") '没有返回值的
        '将登录结果输出
        Data.Output.AccessToken = AccessToken
@@ -694,6 +694,7 @@ LoginFinish:
                   ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
               ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
               ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
+               Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
               ContentType:="application/json; charset=utf-8"))
        '将登录结果输出
        If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效！")
@@ -711,16 +712,6 @@ LoginFinish:
        Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
        McLaunchLog("刷新登录成功（Refresh, " & Data.Input.Token & "）")
    End Sub
-
-    Public Class AuthErrorResponse
-        Public Property [error] As String
-        Public Property errorMessage As String
-    End Class
-    Private Function ParseErrorResponse(ex As Exception) As AuthErrorResponse
-        Dim SplitEx As String = ex.ToString().Split(vbCrLf)(1).Split("-")(0).ToString().Trim()
-        Dim JsonEx As AuthErrorResponse = JsonConvert.DeserializeObject(Of AuthErrorResponse)(SplitEx)
-        Return JsonEx
-    End Function
    Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean
        Try
            Dim NeedRefresh As Boolean = False
@@ -730,13 +721,11 @@ LoginFinish:
                New JProperty("username", Data.Input.UserName),
                New JProperty("password", Data.Input.Password),
                New JProperty("requestUser", True))
-            Dim LHeaders As New Dictionary(Of String, String)
-            LHeaders.Add("Accept-Language", "zh_CN")
            Dim LoginJson As JObject = GetJson(NetRequestRetry(
                Url:=Data.Input.BaseUrl & "/authenticate",
                Method:="POST",
                Data:=RequestData.ToString(0),
-                Headers:=LHeaders,
+                Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
                ContentType:="application/json; charset=utf-8"))
            '检查登录结果
            If LoginJson("availableProfiles").Count = 0 Then
@@ -796,13 +785,19 @@ LoginFinish:
        Catch ex As Exception
            Dim AllMessage As String = GetExceptionSummary(ex)
            Log(ex, "登录失败原始错误信息", LogLevel.Normal)
+            '读取服务器返回的错误
+            If TypeOf ex Is ResponsedWebException Then
+                Dim ErrorMessage As String = Nothing
+                Try
+                    ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
+                Catch
+                End Try
+                If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败：" & ErrorMessage)
+            End If
+            '通用关键字检测
            If AllMessage.Contains("403") Then
                Select Case Data.Input.Type
                    Case McLoginType.Auth
-                        Dim ErrorResponse As AuthErrorResponse = ParseErrorResponse(ex)
-                        If (ErrorResponse.errorMessage <> "") Then
-                            Throw New Exception("$登录失败，以下为认证服务器提供的信息：" & vbCrLf & $" - {ErrorResponse.errorMessage}")
-                        End If
                        Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf &
                                            " - 输入的账号或密码错误。" & vbCrLf &
                                            " - 登录尝试过于频繁，导致被暂时屏蔽。请不要操作，等待 10 分钟后再试。" & vbCrLf &
@@ -1349,20 +1344,28 @@ LoginFinish:
        Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
        Log("[Java] 选定的 Java Wrapper 路径：" & WrapperPath)
        SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
-            Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper"))
-            If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then
-                '以下为 #4243 的修复，因为未知原因 Java Wrapper 可能变为只读文件
-                Log("[Java] Java Wrapper 文件释放失败，但文件已存在，将在删除后尝试重新生成", LogLevel.Debug)
-                Try
-                    File.Delete(WrapperPath)
-                    IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
-                Catch ex As Exception
-                    Log(ex, "Java Wrapper 文件重新释放失败，将尝试更换文件名重新生成")
-                    WrapperPath = BaseDir & "\JavaWrapper2.jar"
-                    IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
-                End Try
-            End If
-            If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败，请查看 PCL 日志查找详细信息")
+            Try
+                WriteFile(WrapperPath, GetResources("JavaWrapper"))
+            Catch ex As Exception
+                If File.Exists(WrapperPath) Then
+                    '因为未知原因 Java Wrapper 可能变为只读文件（#4243）
+                    Log(ex, "Java Wrapper 文件释放失败，但文件已存在，将在删除后尝试重新生成", LogLevel.Developer)
+                    Try
+                        File.Delete(WrapperPath)
+                        WriteFile(WrapperPath, GetResources("JavaWrapper"))
+                    Catch ex2 As Exception
+                        Log(ex2, "Java Wrapper 文件重新释放失败，将尝试更换文件名重新生成", LogLevel.Developer)
+                        WrapperPath = BaseDir & "\JavaWrapper2.jar"
+                        Try
+                            WriteFile(WrapperPath, GetResources("JavaWrapper"))
+                        Catch ex3 As Exception
+                            Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
+                        End Try
+                    End Try
+                Else
+                    Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
+                End If
+            End Try
        End SyncLock
        Return WrapperPath
    End Function
@@ -707,7 +707,7 @@ Finished:
                    End If
                    '读取文件
                    Dim data As New List(Of Byte)
-                    For Each b As Byte In File.ReadAllBytes(Path)
+                    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
@@ -1130,13 +1130,13 @@ Finished:
        Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
        Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
        If Not Mods.Any() Then Exit Sub
-        For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
+        For Each Entry In Mods
            Entry.CompLoaded = SucceedThreadCount = 2
            Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
        Next
        WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
-        '刷新下边栏（#4377）
-        RunInUi(Sub() FrmVersionMod?.RefreshBottomBar())
+        '刷新边栏
+        RunInUi(Sub() FrmVersionMod?.RefreshBars())
    End Sub
    Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
        Dim ModLoaders As New List(Of CompModLoaderType)