Merge branch 'main' into main

2024-09-24 13:11:20 +08:00
parent 8e0368180c 778e5636ce
commit 2dfa810431
19 changed files with 217 additions and 127 deletions
@@ -11,13 +11,13 @@ Public Module ModBase
 #Region "声明"

    '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.5" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.5." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号
    Public Const CommitHash As String = "" 'Commit Hash
 #If BETA Then
-    Public Const VersionCode As Integer = 332 'Release
+    Public Const VersionCode As Integer = 336 'Release
 #Else
-    Public Const VersionCode As Integer = 334 'Snapshot
+    Public Const VersionCode As Integer = 335 'Snapshot
 #End If
    '自动生成的版本信息
    Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -506,6 +506,7 @@ NextInner:
        End If
        '尝试登录
        Dim OAuthTokens As String()
+        Dim ClientId As String = ""
        If Input.OAuthRefreshToken = "" Then
            '无 RefreshToken
 Relogin:
@@ -513,10 +514,10 @@ Relogin:
            If OAuthCode = "Cancel" Then Exit Sub
            If Data.IsAborted Then Throw New ThreadInterruptedException
            Data.Progress = 0.2
-            OAuthTokens = MsLoginStep2(OAuthCode, False)
+            OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
        Else
            '有 RefreshToken
-            OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True)
+            OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True, ClientId)
        End If
        '要求重新打开登录网页认证
        If OAuthTokens(0) = "Cancel" Then Exit Sub
@@ -837,39 +838,59 @@ LoginFinish:
            Return RegexSeek(Result, "(?<=code\=)[^&]+")
        End If
    End Function
+
    '微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
-    Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String()
+    Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, ClientId As String, Optional ExpiresIn As String = "900") As String()
        McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）")

        Dim Request As String
        If IsRefresh Then
-            Request = "client_id=00000000402b5328" & "&" &
+            Request = "grant_type=refresh_token" & "&" &
+                      "client_id=" & ClientId & "&" &
+                      "device_code=" & Code & "&" &
                      "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
-                      "grant_type=refresh_token" & "&" &
-                      "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
-                      "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
+                      "scope=XboxLive.signin%20offline_access"
        Else
-            Request = "client_id=00000000402b5328" & "&" &
-                      "code=" & Uri.EscapeDataString(Code) & "&" &
-                      "grant_type=authorization_code" & "&" &
-                      "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
-                      "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
+            Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
+                      "client_id=" & ClientId & "&" &
+                      "device_code=" & Code & "&" &
+                      "scope=XboxLive.signin%20offline_access"
        End If
        Dim Result As String
-        Try
-            Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2)
-        Catch ex As Exception
-            If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
-                Return {"Relogin", ""}
-            Else
-                Throw
+        Dim stopwatch As Stopwatch = Stopwatch.StartNew()
+
+        While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
+            Try
+                Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
+            Catch ex As Exception
+                If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
+                    Return {"Relogin", ""}
+                ElseIf ex.Message.Contains("authorization_declined") Then
+                    Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
+                    Return {"Cancel", ""}
+                ElseIf ex.Message.Contains("expired_token") Then
+                    Hint("Token 已过期，请尝试重新验证！")
+                    Exit While
+                ElseIf ex.Message.Contains("AADSTS70016") Then
+                    Continue While
+                Else
+                    Throw
+                End If
+            End Try
+
+            If Result IsNot Nothing Then
+                Dim ResultJson As JObject = GetJson(Result)
+                Dim AccessToken As String = ResultJson("access_token").ToString
+                Dim RefreshToken As String = ResultJson("refresh_token").ToString
+                Return {AccessToken, RefreshToken}
            End If
-        End Try
+
+            Thread.Sleep(1000)
+        End While
+
+        Hint("验证超时，请尝试重新验证！")
+        Return {"Cancel", ""}

-        Dim ResultJson As JObject = GetJson(Result)
-        Dim AccessToken As String = ResultJson("access_token").ToString
-        Dim RefreshToken As String = ResultJson("refresh_token").ToString
-        Return {AccessToken, RefreshToken}
    End Function

    ''微软登录步骤 1：获取 DeviceCode 并显示验证提示
@@ -260,7 +260,7 @@ Retry:
            '获取 Mod 下载信息
            ModDownloadLoaders.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(ModList, ",") & "]}", "application/json"))("data")
+                Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
                '如果文件已被删除，则 API 会跳过那一项
                If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
            End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -18,9 +18,6 @@
                    '网络图片
                    If File.Exists(FileAddress) Then
                        PathLogo.Source = New MyBitmap(FileAddress)
-                    ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
-                        Log($"[Comp] 发现不支持的 WebP 格式图标，已更改为默认图标：{_Logo}")
-                        PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
                    Else
                        PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
                        RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
@@ -58,6 +55,12 @@ RetryStart:
            End If
            '下载图片
            NetDownload(Url, LocalFileAddress & DownloadEnd, True)
+            If Url.EndsWithF("webp") Then
+                Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
+                Dim dec = New Imazen.WebP.SimpleDecoder()
+                Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
+                dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
+            End If
            Dim LoadError As Exception = Nothing
            RunInUiWait(
            Sub()
@@ -20,9 +20,6 @@ Public Class MyLocalModItem
                    '网络图片
                    If File.Exists(FileAddress) Then
                        PathLogo.Source = New MyBitmap(FileAddress)
-                    ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
-                        Log($"[LocalModItem] 发现不支持的 WebP 格式图标，已更改为默认图标：{_Logo}")
-                        PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
                    Else
                        PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
                        RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
@@ -60,6 +57,12 @@ RetryStart:
            End If
            '下载图片
            NetDownload(Url, LocalFileAddress & DownloadEnd, True)
+            If Url.EndsWithF("webp") Then
+                Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
+                Dim dec = New Imazen.WebP.SimpleDecoder()
+                Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
+                dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
+            End If
            Dim LoadError As Exception = Nothing
            RunInUiWait(
            Sub()
@@ -798,6 +798,8 @@ NextFile:
    Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean

+    Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
+
 #End Region

    Public DragControl = Nothing