This commit is contained in:
龙腾猫跃
2025-07-22 23:49:12 +08:00
parent add4153067
commit 28ef67ee0f
7 changed files with 57 additions and 42 deletions
+6
View File
@@ -83,6 +83,12 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 364 Then 'Snapshot 2.10.5
If LastVersion >= 363 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法添加新的正版账号"))
BugCount += 1
End If
End If
If LastVersion < 363 Then 'Snapshot 2.10.4 If LastVersion < 363 Then 'Snapshot 2.10.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:下载资源时,会单独记忆每种资源上次下载到的文件夹,以防混淆")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:下载资源时,会单独记忆每种资源上次下载到的文件夹,以防混淆"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络底层框架与下载稳定性")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络底层框架与下载稳定性"))
@@ -13,13 +13,13 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.10.4" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.10.5" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.4." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.10.5." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换 Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 361 'Release Public Const VersionCode As Integer = 361 'Release
#Else #Else
Public Const VersionCode As Integer = 363 'Snapshot Public Const VersionCode As Integer = 364 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -12,9 +12,9 @@ Public Module ModNet
Public Function NetRequestByClient(Url As String, Optional Method As HttpMethod = Nothing, Public Function NetRequestByClient(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*", Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing, Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing,
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False) As String Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False, Optional MakeLog As Boolean = True) As String
If Method Is Nothing Then Method = HttpMethod.Get If Method Is Nothing Then Method = HttpMethod.Get
Log("[Net] 发起网络请求(" & Method.Method & "," & Url & "),最大超时 " & Timeout) If MakeLog Then Log("[Net] 发起网络请求(" & Method.Method & "," & Url & "),最大超时 " & Timeout)
Try Try
Dim HeaderDictionary = If(Headers, {}).ToDictionary Dim HeaderDictionary = If(Headers, {}).ToDictionary
If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType
@@ -22,8 +22,11 @@ Public Module ModNet
Return If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, UseBrowserUserAgent:=UseBrowserUserAgent)) Return If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, UseBrowserUserAgent:=UseBrowserUserAgent))
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As ResponsedWebException
If MakeLog Then Log(ex, "网络请求失败,返回内容为:" & vbCrLf & ex.Response, LogLevel.Developer)
Throw
Catch ex As Exception Catch ex As Exception
Log(ex, "网络请求失败", LogLevel.Developer) If MakeLog Then Log(ex, "网络请求失败", LogLevel.Developer)
Throw Throw
End Try End Try
End Function End Function
@@ -1106,24 +1106,24 @@
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing, Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) '至少 10s,要不然有时候远端服务器来不及完成
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
'Dim McimUrl As String = DlSourceModGet(Url) 'Dim McimUrl As String = DlSourceModGet(Url)
'If McimUrl <> Url Then 'If McimUrl <> Url Then
' Select Case Setup.Get("ToolDownloadMod") ' Select Case Setup.Get("ToolDownloadMod")
' Case 0 ' Case 0
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Case 1 ' Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' Case Else ' Case Else
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15)) ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' End Select ' End Select
'End If 'End If
Dim Exs As String = "" Dim Exs As String = ""
@@ -857,7 +857,7 @@ Retry:
McLaunchLog("开始微软登录步骤 1/6(原始登录)") McLaunchLog("开始微软登录步骤 1/6(原始登录)")
Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post, Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
Accept:="application/x-www-form-urlencoded")) ContentType:="application/x-www-form-urlencoded"))
McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString) McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
'弹窗 '弹窗
@@ -994,10 +994,10 @@ Retry:
Catch ex As Net.WebException Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex) Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then If Message.Contains("(429)") Then
Log(ex, "微软登录第 5 步汇报 429") Log(ex, "微软登录第 4 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!") Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(403)") Then ElseIf Message.Contains("(403)") Then
Log(ex, "微软登录第 5 步汇报 403") Log(ex, "微软登录第 4 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!") Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!")
Else Else
Throw Throw
@@ -1024,7 +1024,7 @@ Retry:
Throw New Exception("$$") Throw New Exception("$$")
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "微软登录第 6 步异常:" & Result) Log(ex, "微软登录第 5 步异常:" & Result)
Throw Throw
End Try End Try
End Sub End Sub
@@ -1039,10 +1039,10 @@ Retry:
Catch ex As Net.WebException Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex) Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then If Message.Contains("(429)") Then
Log(ex, "微软登录第 7 步汇报 429") Log(ex, "微软登录第 6 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!") Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(404)") Then ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 7 步汇报 404") Log(ex, "微软登录第 6 步汇报 404")
RunInNewThread( RunInNewThread(
Sub() Sub()
Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消") Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.10.4.0")> <Assembly: AssemblyVersion("2.10.5.0")>
<Assembly: AssemblyFileVersion("2.10.4.0")> <Assembly: AssemblyFileVersion("2.10.5.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -113,7 +113,8 @@
"device_code=" & DeviceCode & "&" & "device_code=" & DeviceCode & "&" &
"scope=XboxLive.signin%20offline_access", "scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded", ContentType:="application/x-www-form-urlencoded",
Timeout:=5000 + UnknownFailureCount * 5000) Timeout:=5000 + UnknownFailureCount * 5000,
MakeLog:=False)
'获取结果 '获取结果
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = GetJson(Result)
McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒") McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒")
@@ -121,24 +122,29 @@
Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString}) Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString})
Return Return
Catch ex As Exception Catch ex As Exception
If ex.Message.Contains("authorization_declined") Then If TypeOf ex Is ResponsedWebException Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……")) Dim Response = CType(ex, ResponsedWebException).Response
Return If Response.Contains("authorization_declined") Then
ElseIf ex.Message.Contains("expired_token") Then Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Finished(New Exception("$登录用时太长啦,重新试试吧!")) Return
Return ElseIf Response.Contains("expired_token") Then
ElseIf ex.Message.Contains("Account security interrupt") Then Finished(New Exception("$登录用时太长啦,重新试试吧!"))
Finished(New Exception("$该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。")) Return
Return ElseIf Response.Contains("Account security interrupt") Then
ElseIf ex.Message.Contains("service abuse") Then Finished(New Exception("$该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。"))
Finished(New Exception("$非常抱歉,该账号已被微软封禁,无法登录。")) Return
Return ElseIf Response.Contains("service abuse") Then
ElseIf ex.Message.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”,见 #269 Finished(New Exception("$非常抱歉,该账号已被微软封禁,无法登录。"))
Finished(New RestartException) Return
Return ElseIf Response.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”,见 #269
ElseIf ex.Message.Contains("authorization_pending") Then Finished(New RestartException)
Thread.Sleep(2000) Return
ElseIf UnknownFailureCount <= 2 Then ElseIf Response.Contains("authorization_pending") Then
Thread.Sleep(2000)
Continue Do
End If
End If
If UnknownFailureCount <= 2 Then
UnknownFailureCount += 1 UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败") Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000) Thread.Sleep(2000)