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
@@ -13,13 +13,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.10.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.4." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.10.5" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.5." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 361 'Release
#Else
Public Const VersionCode As Integer = 363 'Snapshot
Public Const VersionCode As Integer = 364 'Snapshot
#End If
'自动生成的版本信息
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,
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 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
Log("[Net] 发起网络请求(" & Method.Method & "," & Url & "),最大超时 " & Timeout)
If MakeLog Then Log("[Net] 发起网络请求(" & Method.Method & "," & Url & "),最大超时 " & Timeout)
Try
Dim HeaderDictionary = If(Headers, {}).ToDictionary
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))
Catch ex As ThreadInterruptedException
Throw
Catch ex As ResponsedWebException
If MakeLog Then Log(ex, "网络请求失败,返回内容为:" & vbCrLf & ex.Response, LogLevel.Developer)
Throw
Catch ex As Exception
Log(ex, "网络请求失败", LogLevel.Developer)
If MakeLog Then Log(ex, "网络请求失败", LogLevel.Developer)
Throw
End Try
End Function
@@ -1106,24 +1106,24 @@
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
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))
'Dim McimUrl As String = DlSourceModGet(Url)
'If McimUrl <> Url Then
' Select Case Setup.Get("ToolDownloadMod")
' 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)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' 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)(Url, 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
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 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)(Url, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' End Select
'End If
Dim Exs As String = ""
@@ -857,7 +857,7 @@ Retry:
McLaunchLog("开始微软登录步骤 1/6(原始登录)")
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",
Accept:="application/x-www-form-urlencoded"))
ContentType:="application/x-www-form-urlencoded"))
McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
'弹窗
@@ -994,10 +994,10 @@ Retry:
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 5 步汇报 429")
Log(ex, "微软登录第 4 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(403)") Then
Log(ex, "微软登录第 5 步汇报 403")
Log(ex, "微软登录第 4 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!")
Else
Throw
@@ -1024,7 +1024,7 @@ Retry:
Throw New Exception("$$")
End If
Catch ex As Exception
Log(ex, "微软登录第 6 步异常:" & Result)
Log(ex, "微软登录第 5 步异常:" & Result)
Throw
End Try
End Sub
@@ -1039,10 +1039,10 @@ Retry:
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 7 步汇报 429")
Log(ex, "微软登录第 6 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 7 步汇报 404")
Log(ex, "微软登录第 6 步汇报 404")
RunInNewThread(
Sub()
Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")