2.10.7
This commit is contained in:
@@ -13,13 +13,13 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.10.6" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.10.6." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.10.7" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.10.7." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 367 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 366 'Snapshot
|
||||
Public Const VersionCode As Integer = 368 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
@@ -1283,7 +1283,7 @@ Re:
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查文件出错")
|
||||
Return GetExceptionSummary(ex)
|
||||
Return ex.GetBrief()
|
||||
End Try
|
||||
End Function
|
||||
End Class
|
||||
@@ -1329,6 +1329,14 @@ Re:
|
||||
''' </summary>
|
||||
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
|
||||
If Not Directory.Exists(Path) Then Return 0
|
||||
If Not Path.EndsWithF("\") Then Path &= "\"
|
||||
If Path.EndsWith(":\") OrElse
|
||||
Path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
|
||||
Path = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
|
||||
Path = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
|
||||
Throw New UnauthorizedAccessException("这是重要的系统文件夹,无法删除:" & Path)
|
||||
End If
|
||||
'实际删除
|
||||
Dim DeletedCount As Integer = 0
|
||||
Dim Files As String()
|
||||
Try
|
||||
@@ -1364,6 +1372,7 @@ RetryFile:
|
||||
RetryDir:
|
||||
Try
|
||||
Directory.Delete(Path, True)
|
||||
Catch ex As DirectoryNotFoundException
|
||||
Catch ex As Exception
|
||||
If Not RetriedDir AndAlso Not RunInUi() Then
|
||||
RetriedDir = True
|
||||
@@ -1420,10 +1429,10 @@ RetryDir:
|
||||
Public vbRQ As Char = Convert.ToChar(8221)
|
||||
|
||||
''' <summary>
|
||||
''' 提取 Exception 的具体描述与堆栈。
|
||||
''' 提取 Exception 与 Inner Exception 的详细描述与堆栈信息。返回内容总是多于一行。
|
||||
''' </summary>
|
||||
''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
|
||||
Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
|
||||
<Extension> Public Function GetDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
|
||||
If Ex Is Nothing Then Return "无可用错误信息!"
|
||||
|
||||
'获取最底层的异常
|
||||
@@ -1450,17 +1459,17 @@ RetryDir:
|
||||
Loop
|
||||
|
||||
'构造输出信息
|
||||
Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList)
|
||||
If CommonReason Is Nothing Then
|
||||
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList)
|
||||
If UsualReason Is Nothing Then
|
||||
Return DescList.Join(vbCrLf)
|
||||
Else
|
||||
Return CommonReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
|
||||
Return UsualReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
|
||||
End If
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 提取 Exception 描述,汇总到一行。
|
||||
''' 提取 Exception 与 Inner Exception 的描述,汇总到一行。
|
||||
''' </summary>
|
||||
Public Function GetExceptionSummary(Ex As Exception) As String
|
||||
<Extension> Public Function GetBrief(Ex As Exception) As String
|
||||
If Ex Is Nothing Then Return "无可用错误信息!"
|
||||
|
||||
'获取最底层的异常
|
||||
@@ -1479,28 +1488,27 @@ RetryDir:
|
||||
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
|
||||
|
||||
'构造输出信息
|
||||
Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList)
|
||||
If CommonReason IsNot Nothing Then
|
||||
Return CommonReason & "详细错误:" & DescList.First
|
||||
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList)
|
||||
If UsualReason IsNot Nothing Then
|
||||
Return UsualReason & "详细错误:" & DescList.First
|
||||
Else
|
||||
DescList.Reverse() '让最深层错误在最左边
|
||||
Return Join(DescList, " ← ")
|
||||
End If
|
||||
End Function
|
||||
Private Function AnalyzeCommonReason(InnerEx As Exception, DescList As List(Of String)) As String
|
||||
Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
|
||||
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
|
||||
Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
|
||||
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
|
||||
Return "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
|
||||
Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行,或将目标从 C 盘或桌面挪到其他硬盘。"
|
||||
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
|
||||
Return "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
|
||||
ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
|
||||
Return "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
|
||||
ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then
|
||||
Return "请尝试卸载中国移动云盘,然后再试。"
|
||||
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
|
||||
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then
|
||||
Return "你的网络环境不佳,导致难以连接到服务器。请稍后重试,或使用 VPN 以改善网络环境。"
|
||||
ElseIf OuterEx.IsNetworkRelated() Then
|
||||
Return "你的网络环境不佳,请稍后再试,或使用 VPN 改善网络环境。"
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
@@ -2981,10 +2989,10 @@ Retry:
|
||||
If TypeOf Ex Is ThreadInterruptedException Then Return
|
||||
|
||||
'获取错误信息
|
||||
Dim ExFull As String = Desc & ":" & GetExceptionDetail(Ex)
|
||||
Dim ExFull As String = $"{Desc}:{Ex.GetDetail()}"
|
||||
|
||||
'输出日志
|
||||
Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{GetExceptionDetail(Ex, True)}{vbCrLf}" '减轻同步锁占用
|
||||
Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
|
||||
If ModeDebug Then
|
||||
SyncLock LogListLock
|
||||
LogList.Append(AppendText)
|
||||
@@ -3002,19 +3010,19 @@ Retry:
|
||||
Case LogLevel.Normal
|
||||
#If DEBUG Then
|
||||
Case LogLevel.Developer
|
||||
Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
|
||||
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
|
||||
Hint("[开发者模式] " & ExLine, HintType.Info, False)
|
||||
Case LogLevel.Debug
|
||||
Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
|
||||
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
|
||||
Hint("[调试模式] " & ExLine, HintType.Info, False)
|
||||
#Else
|
||||
Case LogLevel.Developer
|
||||
Case LogLevel.Debug
|
||||
Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
|
||||
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
|
||||
If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
|
||||
#End If
|
||||
Case LogLevel.Hint
|
||||
Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
|
||||
Dim ExLine As String = Desc & ":" & Ex.GetBrief()
|
||||
Hint(ExLine, HintType.Critical, False)
|
||||
Case LogLevel.Msgbox
|
||||
MyMsgBox(ExFull, Title, IsWarn:=True)
|
||||
@@ -3093,8 +3101,8 @@ Retry:
|
||||
Url &= "&" & WebUtility.UrlEncode(Datas(i)) & "=" & WebUtility.UrlEncode(Datas(i + 1).Replace(vbCrLf, vbLf))
|
||||
Next
|
||||
NetRequestByClient(Url, MakeLog:=False)
|
||||
Catch
|
||||
Log("[System] 匿名数据上报失败", LogLevel.Debug)
|
||||
Catch ex As Exception
|
||||
Log(ex, "匿名数据上报失败")
|
||||
End Try
|
||||
End Sub, "Telemetry", ThreadPriority.Lowest)
|
||||
End Sub
|
||||
|
||||
@@ -290,11 +290,12 @@
|
||||
'检验输入以确定情况
|
||||
If IsForceRestart Then Return True '强制要求重启
|
||||
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
|
||||
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
|
||||
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
|
||||
Return False '则不重试
|
||||
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
|
||||
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
|
||||
LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
|
||||
Return False '…则不重试
|
||||
Else
|
||||
Return True '需要开始
|
||||
Return True '否则需要重启
|
||||
End If
|
||||
End Function
|
||||
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
|
||||
@@ -1,4 +1,7 @@
|
||||
Imports System.Net.Http.Headers
|
||||
Imports System.Net.Sockets
|
||||
Imports System.Runtime.CompilerServices
|
||||
Imports System.Security.Policy
|
||||
Imports System.Threading.Tasks
|
||||
Imports CacheCow.Client
|
||||
|
||||
@@ -11,15 +14,28 @@ Public Module ModNet
|
||||
''' </summary>
|
||||
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, Optional MakeLog As Boolean = True) As String
|
||||
Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False, Optional MakeLog As Boolean = True) As String
|
||||
If Method Is Nothing Then Method = HttpMethod.Get
|
||||
If MakeLog Then Log("[Net] 发起网络请求(" & Method.Method & "," & Url & "),最大超时 " & Timeout)
|
||||
Try
|
||||
Dim HeaderDictionary = If(Headers, {}).ToDictionary
|
||||
If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType
|
||||
If Accept IsNot Nothing Then HeaderDictionary("Accept") = Accept
|
||||
Return If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, UseBrowserUserAgent:=UseBrowserUserAgent))
|
||||
Dim Result = If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders))
|
||||
'检查结果是否为完整 JSON(在 #6683 中可能返回空,在被 GFW 截断时可能不完整)
|
||||
'在此处检查并报错,可以让 NetRequestByClientRetry 等方法进行重试
|
||||
If RequireJson Then
|
||||
Result = Result.Trim((vbCrLf & " ").ToCharArray) 'Authlib-Injector 的结果会在末尾附带一个空行
|
||||
If Not (Result.StartsWithF("{") AndAlso Result.EndsWithF("}")) AndAlso
|
||||
Not (Result.StartsWithF("[") AndAlso Result.EndsWithF("]")) Then
|
||||
Throw New FormatException("返回结果并非 JSON 格式:" &
|
||||
If(Result.Length > 2000, Result.Substring(0, 1000) & "..." & Result.Substring(Result.Length - 1000), Result))
|
||||
End If
|
||||
End If
|
||||
Return Result
|
||||
Catch ex As FormatException
|
||||
Throw
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
@@ -34,8 +50,8 @@ Public Module ModNet
|
||||
''' <param name="BackupUrl">如果第一次尝试失败,换用的备用 URL。</param>
|
||||
Public Function NetRequestByClientRetry(Url As String, Optional Method As HttpMethod = Nothing, Optional BackupUrl As String = Nothing,
|
||||
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
|
||||
Optional Headers As String(,) = Nothing,
|
||||
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim RetryCount As Integer = 0
|
||||
Dim RetryException As Exception = Nothing
|
||||
Dim StartTime As Long = GetTimeTick()
|
||||
@@ -43,15 +59,15 @@ Public Module ModNet
|
||||
Retry:
|
||||
Select Case RetryCount
|
||||
Case 0 '正常尝试
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 10000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 10000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Case 1 '慢速重试
|
||||
Thread.Sleep(500)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Case Else '快速重试
|
||||
If GetTimeTick() - StartTime > 5500 Then
|
||||
'若前两次加载耗费 5 秒以上,才进行重试
|
||||
Thread.Sleep(500)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, Encoding, UseBrowserUserAgent)
|
||||
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Else
|
||||
Throw RetryException
|
||||
End If
|
||||
@@ -78,8 +94,8 @@ Retry:
|
||||
''' </summary>
|
||||
Public Function NetRequestByClientMultiple(Url As String, Optional Method As HttpMethod = Nothing, Optional ThreadCount As Integer = 3,
|
||||
Optional Content As Object = Nothing, Optional ContentType As String = Nothing, Optional Accept As String = "*/*",
|
||||
Optional Headers As String(,) = Nothing, Optional Timeout As Integer = 25000,
|
||||
Optional Encoding As Encoding = Nothing, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False, Optional Timeout As Integer = 25000,
|
||||
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim Threads As New List(Of Thread)
|
||||
Dim RequestResult = Nothing
|
||||
Dim RequestEx As Exception = Nothing
|
||||
@@ -88,7 +104,7 @@ Retry:
|
||||
Dim th As New Thread(
|
||||
Sub()
|
||||
Try
|
||||
RequestResult = NetRequestByClient(Url, Method, Content, ContentType, Accept, Timeout, Headers, Encoding, UseBrowserUserAgent)
|
||||
RequestResult = NetRequestByClient(Url, Method, Content, ContentType, Accept, Timeout, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
|
||||
Catch ex As Exception
|
||||
FailCount += 1
|
||||
RequestEx = ex
|
||||
@@ -127,16 +143,16 @@ RequestFinished:
|
||||
''' 以多线程下载网页文件的方式获取内容。
|
||||
''' 不支持缓存协商;若需缓存协商,需要换用 NetRequestByClient。
|
||||
''' </summary>
|
||||
Public Function NetRequestByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Return NetRequestByLoader({Url}, Timeout, IsJson, UseBrowserUserAgent)
|
||||
Public Function NetRequestByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Return NetRequestByLoader({Url}, Timeout, IsJson, SimulateBrowserHeaders)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 以多线程下载网页文件的方式获取内容。
|
||||
''' 不支持缓存协商;若需缓存协商,需要换用 NetRequestByClient。
|
||||
''' </summary>
|
||||
Public Function NetRequestByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Public Function NetRequestByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional SimulateBrowserHeaders As Boolean = False) As String
|
||||
Dim Temp As String = RequestTaskTempFolder() & "download.txt"
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, SimulateBrowserHeaders)})
|
||||
Try
|
||||
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls.First & ")")
|
||||
NetRequestByLoader = ReadFile(Temp)
|
||||
@@ -154,7 +170,7 @@ RequestFinished:
|
||||
''' 通过网络请求直接下载小文件,若文件已存在将被覆盖。
|
||||
''' 不建议用于下载大文件。
|
||||
''' </summary>
|
||||
Public Sub NetDownloadByClient(Url As String, LocalPath As String)
|
||||
Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Log($"[Net] 通过网络请求直接下载小文件:{Url} → {LocalPath}")
|
||||
'初始化文件路径
|
||||
Try
|
||||
@@ -165,7 +181,7 @@ RequestFinished:
|
||||
End Try
|
||||
'下载
|
||||
Try
|
||||
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get))
|
||||
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
|
||||
Catch ex As Exception
|
||||
File.Delete(LocalPath)
|
||||
Throw New WebException($"通过网络请求直接下载小文件失败({LocalPath})", ex)
|
||||
@@ -175,16 +191,16 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 通过多线程下载引擎下载文件。
|
||||
''' </summary>
|
||||
Public Sub NetDownloadByLoader(Url As String, LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
NetDownloadByLoader({Url}, LocalPath, LoaderToSyncProgress, Check, UseBrowserUserAgent)
|
||||
Public Sub NetDownloadByLoader(Url As String, LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
NetDownloadByLoader({Url}, LocalPath, LoaderToSyncProgress, Check, SimulateBrowserHeaders)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 通过多线程下载引擎下载文件。
|
||||
''' </summary>
|
||||
''' <param name="Urls">文件的 Url 列表。</param>
|
||||
''' <param name="LocalPath">下载的本地地址。</param>
|
||||
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Dim NewTask As New LoaderDownload($"文件下载 {GetUuid()}#", New List(Of NetFile) From {New NetFile(Urls, LocalPath, Check, UseBrowserUserAgent)})
|
||||
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalPath As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Dim NewTask As New LoaderDownload($"文件下载 {GetUuid()}#", New List(Of NetFile) From {New NetFile(Urls, LocalPath, Check, SimulateBrowserHeaders)})
|
||||
Try
|
||||
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
|
||||
Catch ex As Exception
|
||||
@@ -201,36 +217,37 @@ RequestFinished:
|
||||
'基础请求函数
|
||||
Private Function SendRequest(Url As String, Method As HttpMethod,
|
||||
Optional Content As Object = Nothing, Optional Headers As Dictionary(Of String, String) = Nothing,
|
||||
Optional UseBrowserUserAgent As Boolean = False, Optional Timeout As Integer = 25000, Optional Encoding As Encoding = Nothing) As Byte()
|
||||
Optional SimulateBrowserHeaders As Boolean = False, Optional Timeout As Integer = 25000, Optional Encoding As Encoding = Nothing) As Byte()
|
||||
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
||||
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing, Response As HttpResponseMessage = Nothing
|
||||
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing,
|
||||
Response As HttpResponseMessage = Nothing, HostIp As String = Nothing
|
||||
Try
|
||||
Static Client As HttpClient = ClientExtensions.CreateClient(New FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None,
|
||||
.UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
|
||||
})
|
||||
Url = SecretCdnSign(Url)
|
||||
Request = New HttpRequestMessage(Method, Url)
|
||||
'写入 Content
|
||||
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then
|
||||
Dim Bytes As Byte() = If(TypeOf Content Is Byte(), Content, If(Encoding, Encoding.UTF8).GetBytes(Content.ToString))
|
||||
Request.Content = New ByteArrayContent(Bytes)
|
||||
Request.Content.Headers.ContentLength = Bytes.Length
|
||||
If TypeOf Content Is HttpContent Then
|
||||
Request.Content = DirectCast(Content, HttpContent)
|
||||
ElseIf TypeOf Content Is Byte() Then
|
||||
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
|
||||
ElseIf Content IsNot Nothing Then
|
||||
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
|
||||
End If
|
||||
End If
|
||||
'写入 Headers
|
||||
If Headers IsNot Nothing Then
|
||||
For Each Header In Headers
|
||||
If Header.Key.ToLower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.Add(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
|
||||
'发送请求
|
||||
For Each Header In If(Headers, New Dictionary(Of String, String))
|
||||
If Header.Key.ToLower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.Add(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
|
||||
'DNS 解析
|
||||
CancelToken = New CancellationTokenSource(Timeout)
|
||||
Response = Client.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
HostIp = DnsLookup(Request, CancelToken)
|
||||
'发送请求
|
||||
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
Dim ResponseBytes As Byte()
|
||||
Using Stream As New MemoryStream
|
||||
@@ -239,28 +256,111 @@ RequestFinished:
|
||||
End Using
|
||||
'输出
|
||||
If Response.IsSuccessStatusCode Then
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
Return ResponseBytes
|
||||
Else
|
||||
RecordIPReliability(HostIp, -0.7)
|
||||
Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes)
|
||||
Throw New ResponsedWebException(
|
||||
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Method},{Url}" &
|
||||
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Method},{Url},{HostIp}" &
|
||||
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage)
|
||||
End If
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As ResponsedWebException
|
||||
Throw
|
||||
Catch ex As TaskCanceledException 'CancellationTokenSource 超时
|
||||
Throw New WebException($"连接服务器超时,请检查你的网络环境是否良好({Method}, {Url})", WebExceptionStatus.Timeout)
|
||||
Catch ex As DnsLookupException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
Throw New Exception($"网络请求出现意外异常({Method}, {Url})", ex)
|
||||
RecordIPReliability(HostIp, -1)
|
||||
If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时
|
||||
Throw New WebException($"连接服务器超时,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},{HostIp})", WebExceptionStatus.Timeout)
|
||||
Else
|
||||
Throw New Exception($"网络请求出现意外异常({Method}, {Url},{HostIp})", ex)
|
||||
End If
|
||||
Finally
|
||||
Request?.Dispose()
|
||||
CancelToken?.Dispose()
|
||||
Response?.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
Private RequestClient As HttpClient = ClientExtensions.CreateClient(New FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None,
|
||||
.UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
|
||||
})
|
||||
|
||||
''' <summary>
|
||||
''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
|
||||
''' 返回请求时应使用的 IP;若为 IPv6,则加上了方括号。
|
||||
''' </summary>
|
||||
''' <exception cref="DnsLookupException"></exception>
|
||||
Private Function DnsLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
|
||||
Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0)
|
||||
'初步 DNS 解析
|
||||
Dim Host = Request.RequestUri.Host
|
||||
Dim DnsTask As Task(Of IPAddress()) = Nothing
|
||||
Try
|
||||
DnsTask = Dns.GetHostAddressesAsync(Host)
|
||||
DnsTask.Wait(CancelToken.Token)
|
||||
Catch ex As Exception
|
||||
Throw New DnsLookupException($"DNS 解析失败,请检查你的网络连接({Host})", ex)
|
||||
End Try
|
||||
Dim Candidates As IPAddress() = DnsTask.Result.ToArray
|
||||
If Not Candidates.Any Then Throw New DnsLookupException($"DNS 解析无结果,请检查你的网络连接({Host})")
|
||||
'若同时存在 IPv4 和 IPv6 地址,仅选择其中一类(因为 GFW 可能只屏蔽了 IPv4 或 IPv6)
|
||||
Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray
|
||||
Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray
|
||||
If IPv4Targets.Any AndAlso IPv6Targets.Any Then
|
||||
Dim IPv4Reliability = IPv4Targets.Average(Function(i) GetIPReliability(i))
|
||||
Dim IPv6Reliability = IPv6Targets.Average(Function(i) GetIPReliability(i))
|
||||
If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址(#6887)
|
||||
Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets)
|
||||
End If
|
||||
'选择可靠度最高的 IP
|
||||
Dim MaxReliability As Double = Candidates.Max(Function(i) GetIPReliability(i))
|
||||
Dim Target As IPAddress = Candidates.First(Function(i) GetIPReliability(i) = MaxReliability)
|
||||
Dim TargetIp As String = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString)
|
||||
If Target IsNot Candidates.First Then
|
||||
'优选结果与系统默认 IP 不一致,替换域名并设置 Host 头
|
||||
If ModeDebug Then Log($"[Net] DNS 结果:{Host} → {Target},所有可能的 IP 与可靠度:{DnsTask.Result.Select(Function(i) $"{i} → {GetIPReliability(i):0.000}").Join(";")}")
|
||||
Request.Headers.Host = Host
|
||||
Dim Builder As New UriBuilder(Request.RequestUri)
|
||||
Builder.Host = TargetIp
|
||||
Request.RequestUri = Builder.Uri
|
||||
End If
|
||||
If Not IPReliability.ContainsKey(TargetIp) Then IPReliability(TargetIp) = -0.01 '预先降低一点,这样快速的重复请求会使用不同的 IP 以提高成功率
|
||||
Return TargetIp
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 记录每个 IP 地址的请求可靠度。
|
||||
''' 通常取值 -1 ~ +0.5,越高越好。未尝试过的 IP 应视为 0。
|
||||
''' </summary>
|
||||
Private IPReliability As New Dictionary(Of String, Double)
|
||||
''' <summary>
|
||||
''' 根据请求结果,记录 IP 地址的可靠度。
|
||||
''' </summary>
|
||||
Private Sub RecordIPReliability(IP As String, Result As Double)
|
||||
If IP Is Nothing Then Return
|
||||
If Not IPReliability.ContainsKey(IP) Then IPReliability(IP) = 0
|
||||
IPReliability(IP) = (IPReliability(IP) + Result) / 2
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' DNS 解析失败引发的异常。
|
||||
''' </summary>
|
||||
Private Class DnsLookupException
|
||||
Inherits Exception
|
||||
Public Sub New(Message As String, Optional InnerException As Exception = Nothing)
|
||||
MyBase.New(Message, InnerException)
|
||||
End Sub
|
||||
Public Sub New(Message As String)
|
||||
MyBase.New(Message)
|
||||
End Sub
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 当网络请求失败时引发的异常。
|
||||
''' 附带 Response 属性,可用于获取远程服务器给予的回复。
|
||||
''' </summary>
|
||||
Public Class ResponsedWebException
|
||||
Inherits WebException
|
||||
''' <summary>
|
||||
@@ -277,6 +377,10 @@ RequestFinished:
|
||||
|
||||
#Region "多线程下载引擎"
|
||||
|
||||
Private ThreadClient As New HttpClient(New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
|
||||
})
|
||||
|
||||
''' <summary>
|
||||
''' 最大线程数。
|
||||
''' </summary>
|
||||
@@ -581,12 +685,12 @@ RequestFinished:
|
||||
End SyncLock
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 是否已经没有可用源了。
|
||||
''' 是否存在可用源。
|
||||
''' </summary>
|
||||
Public Function HasAvailableSource(Optional AllowOnceSource As Boolean = True) As Boolean
|
||||
SyncLock LockSource
|
||||
If AllowOnceSource AndAlso SourcesOnce.Any Then Return True
|
||||
If Sources.Any(Function(s) Not s.IsFailed) Then Return True
|
||||
If Sources.Any(Function(s) Not s.IsFailed) Then Return True '存在多线程可用源
|
||||
If AllowOnceSource AndAlso SourcesOnce.Any Then Return True '存在单线程可用源
|
||||
End SyncLock
|
||||
Return False
|
||||
End Function
|
||||
@@ -648,7 +752,7 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 下载时是否添加浏览器 UA。
|
||||
''' </summary>
|
||||
Public UseBrowserUserAgent As Boolean
|
||||
Public SimulateBrowserHeaders As Boolean
|
||||
|
||||
''' <summary>
|
||||
''' 上次记速时的时间。
|
||||
@@ -746,7 +850,7 @@ RequestFinished:
|
||||
''' 新建一个需要下载的文件。
|
||||
''' </summary>
|
||||
''' <param name="LocalPath">包含文件名的本地地址。</param>
|
||||
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
Dim Sources As New List(Of NetSource)
|
||||
Dim Count As Integer = 0
|
||||
Urls = Urls.Distinct.ToArray
|
||||
@@ -757,7 +861,7 @@ RequestFinished:
|
||||
Me.Sources = Sources
|
||||
Me.LocalPath = LocalPath
|
||||
Me.Check = Check
|
||||
Me.UseBrowserUserAgent = UseBrowserUserAgent
|
||||
Me.SimulateBrowserHeaders = SimulateBrowserHeaders
|
||||
Me.LocalName = GetFileNameFromPath(LocalPath)
|
||||
End Sub
|
||||
|
||||
@@ -768,17 +872,17 @@ RequestFinished:
|
||||
Public Function TryBeginThread() As NetThread
|
||||
Try
|
||||
|
||||
'条件检测
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
|
||||
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
|
||||
SyncLock LockState
|
||||
If State < NetState.Connect Then State = NetState.Connect
|
||||
End SyncLock
|
||||
'初始化参数
|
||||
Dim StartPosition As Long, StartSource As NetSource = Nothing
|
||||
Dim Th As Thread, ThreadInfo As NetThread
|
||||
SyncLock LockChain
|
||||
'条件检测
|
||||
SyncLock LockSource
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
|
||||
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
|
||||
SyncLock LockState
|
||||
If State < NetState.Connect Then State = NetState.Connect
|
||||
End SyncLock
|
||||
'初始化参数
|
||||
'获取线程起点与下载源
|
||||
'不分割
|
||||
If IsNoSplit Then GoTo StartSingleThreadDownload
|
||||
@@ -789,6 +893,8 @@ StartSingleThreadDownload:
|
||||
Reset()
|
||||
State = NetState.Get
|
||||
End If
|
||||
End SyncLock
|
||||
SyncLock LockChain
|
||||
'首个开始点
|
||||
If Threads Is Nothing Then
|
||||
StartPosition = 0
|
||||
@@ -805,7 +911,9 @@ StartSingleThreadDownload:
|
||||
End If
|
||||
Next
|
||||
'是否禁用多线程,以及规定碎片大小
|
||||
Dim TargetUrl As String = GetSource().Url
|
||||
Dim Source As NetSource = GetSource()
|
||||
If Source Is Nothing Then Return Nothing
|
||||
Dim TargetUrl As String = Source.Url
|
||||
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
|
||||
TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing
|
||||
'寻找最大碎片
|
||||
@@ -850,7 +958,7 @@ StartThread:
|
||||
Return ThreadInfo
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "尝试开始下载线程失败(" & If(LocalName, "Nothing") & ")", LogLevel.Hint)
|
||||
Fail(New Exception($"尝试开始下载线程失败({LocalName})", ex))
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
@@ -859,7 +967,9 @@ StartThread:
|
||||
''' </summary>
|
||||
Private Sub Thread(Th As NetThread)
|
||||
If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}:开始,起始点 {Th.DownloadStart},{Th.Source.Url}")
|
||||
Dim ResultStream As Stream = Nothing
|
||||
Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing,
|
||||
Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing,
|
||||
CancelToken As CancellationTokenSource = Nothing, HostIp As String = ""
|
||||
'部分下载源真的特别慢,并且只需要一个请求,例如 Ping 为 20s,如果增长太慢,就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
|
||||
'延迟过长会导致某些特别慢的链接迟迟不被掐死
|
||||
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Th.Source.FailCount), 30000)
|
||||
@@ -867,145 +977,140 @@ StartThread:
|
||||
Try
|
||||
Dim HttpDataCount As Integer = 0
|
||||
If SourcesOnce.Contains(Th.Source) AndAlso Th <> Th.Source.SingleThread Then GoTo SourceBreak
|
||||
Dim HttpRequest As New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
|
||||
SecretHeadersSign(Th.Source.Url, HttpRequest, UseBrowserUserAgent)
|
||||
HttpRequest = New HttpRequestMessage(HttpMethod.Get, Th.Source.Url)
|
||||
SecretHeadersSign(Th.Source.Url, HttpRequest, SimulateBrowserHeaders)
|
||||
CancelToken = New CancellationTokenSource(Timeout)
|
||||
HostIp = DnsLookup(HttpRequest, CancelToken) 'DNS 预解析
|
||||
If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing)
|
||||
Dim ContentLength As Long = 0
|
||||
Using CancelToken As New CancellationTokenSource(Timeout)
|
||||
Static Client As New HttpClient(New HttpClientHandler With {
|
||||
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
|
||||
})
|
||||
Using Response As HttpResponseMessage = Client.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}") '状态码检查
|
||||
If State = NetState.Error Then GoTo SourceBreak '快速中断
|
||||
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}:重定向至 {Response.RequestMessage.RequestUri}")
|
||||
'文件大小校验
|
||||
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
||||
If ContentLength = -1 Then
|
||||
If FileSize > 1 Then
|
||||
If Th.DownloadStart = 0 Then
|
||||
Log($"[Download] {LocalName}:文件大小未知,但已从其他下载源获取,不作处理")
|
||||
Else
|
||||
Log($"[Download] {LocalName}:ContentLength 返回了 -1,无法确定是否支持分段下载,视作不支持")
|
||||
GoTo NotSupportRange
|
||||
End If
|
||||
Else
|
||||
FileSize = -1 : IsUnknownSize = True
|
||||
Log($"[Download] {LocalName}:文件大小未知")
|
||||
End If
|
||||
ElseIf ContentLength < 0 Then
|
||||
Throw New Exception("获取片大小失败,结果为 " & ContentLength & "。")
|
||||
ElseIf Th.IsFirstThread Then
|
||||
If Check IsNot Nothing Then
|
||||
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
|
||||
Throw New Exception($"文件大小不足,获取结果为 {ContentLength},要求至少为 {Check.MinSize}。")
|
||||
End If
|
||||
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
|
||||
Throw New Exception($"文件大小不一致,获取结果为 {ContentLength},要求必须为 {Check.ActualSize}。")
|
||||
End If
|
||||
End If
|
||||
FileSize = ContentLength : IsUnknownSize = False
|
||||
Log($"[Download] {LocalName}:文件大小 {ContentLength}({GetString(ContentLength)})")
|
||||
'若文件大小大于 50 M,进行剩余磁盘空间校验
|
||||
If ContentLength > 50 * 1024 * 1024 Then
|
||||
For Each Drive As DriveInfo In DriveInfo.GetDrives
|
||||
Dim DriveName As String = Drive.Name.First.ToString
|
||||
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
|
||||
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
|
||||
If Drive.TotalFreeSpace < RequiredSpace Then
|
||||
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
|
||||
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
ElseIf FileSize < 0 Then
|
||||
Throw New Exception("非首线程运行时,尚未获取文件大小")
|
||||
ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
|
||||
NotSupportRange:
|
||||
SyncLock LockSource
|
||||
If SourcesOnce.Contains(Th.Source) Then
|
||||
GoTo SourceBreak
|
||||
Else
|
||||
SourcesOnce.Add(Th.Source)
|
||||
End If
|
||||
End SyncLock
|
||||
Throw New WebException($"该下载源不支持分段下载:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
|
||||
ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
|
||||
Throw New WebException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
|
||||
End If
|
||||
'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}")
|
||||
Th.State = NetState.Get
|
||||
SyncLock LockState
|
||||
If State < NetState.Get Then State = NetState.Get
|
||||
End SyncLock
|
||||
'创建缓存文件
|
||||
If IsNoSplit Then
|
||||
Th.Temp = Nothing
|
||||
Cache = New MemoryStream
|
||||
ResultStream = Cache
|
||||
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult()
|
||||
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}") '状态码检查
|
||||
If State = NetState.Error Then GoTo SourceBreak '快速中断
|
||||
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}:重定向至 {Response.RequestMessage.RequestUri}")
|
||||
'文件大小校验
|
||||
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
||||
If ContentLength = -1 Then
|
||||
If FileSize > 1 Then
|
||||
If Th.DownloadStart = 0 Then
|
||||
Log($"[Download] {LocalName}:文件大小未知,但已从其他下载源获取,不作处理")
|
||||
Else
|
||||
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
|
||||
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
|
||||
Log($"[Download] {LocalName}:ContentLength 返回了 -1,无法确定是否支持分段下载,视作不支持")
|
||||
GoTo NotSupportRange
|
||||
End If
|
||||
'开始下载
|
||||
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
|
||||
Dim ResponseBytes As Byte() = New Byte(16384) {}
|
||||
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetAwaiter().GetResult()
|
||||
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
|
||||
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
|
||||
'限速
|
||||
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
|
||||
Threading.Thread.Sleep(16)
|
||||
End While
|
||||
Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Th.DownloadUndone))
|
||||
SyncLock NetTaskSpeedLimitLeftLock
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
|
||||
End SyncLock
|
||||
Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime
|
||||
If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值
|
||||
If RealDataCount > 0 Then
|
||||
'有数据
|
||||
If Th.DownloadDone = 0 Then
|
||||
'第一次接受到数据
|
||||
Th.State = NetState.Download
|
||||
SyncLock LockState
|
||||
If State < NetState.Download Then State = NetState.Download
|
||||
End SyncLock
|
||||
SyncLock LockCount
|
||||
ConnectCount += 1
|
||||
ConnectTime += GetTimeTick() - Th.InitTime
|
||||
End SyncLock
|
||||
End If
|
||||
SyncLock LockCount
|
||||
Th.Source.FailCount = 0
|
||||
For Each Task In Tasks
|
||||
Task.FailCount = 0
|
||||
Next
|
||||
End SyncLock
|
||||
NetManager.DownloadDone += RealDataCount
|
||||
SyncLock LockDone
|
||||
DownloadDone += RealDataCount
|
||||
End SyncLock
|
||||
Th.DownloadDone += RealDataCount
|
||||
ResultStream.Write(ResponseBytes, 0, RealDataCount)
|
||||
'检查速度是否过慢
|
||||
If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 1.5s,且速度小于 1.5K/s
|
||||
Th.Source.SingleThread Is Nothing Then '并非单线程下载
|
||||
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
|
||||
End If
|
||||
Th.LastReceiveTime = GetTimeTick()
|
||||
'已完成
|
||||
If Th.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
|
||||
ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
|
||||
'无数据,且已超时
|
||||
Throw New TimeoutException("操作超时,无数据。")
|
||||
End If
|
||||
HttpDataCount = ResponseStream.Read(ResponseBytes, 0, 16384)
|
||||
End While
|
||||
End Using
|
||||
End Using
|
||||
End Using
|
||||
Else
|
||||
FileSize = -1 : IsUnknownSize = True
|
||||
Log($"[Download] {LocalName}:文件大小未知")
|
||||
End If
|
||||
ElseIf ContentLength < 0 Then
|
||||
Throw New Exception("获取片大小失败,结果为 " & ContentLength & "。")
|
||||
ElseIf Th.IsFirstThread Then
|
||||
If Check IsNot Nothing Then
|
||||
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
|
||||
Throw New Exception($"文件大小不足,获取结果为 {ContentLength},要求至少为 {Check.MinSize}。")
|
||||
End If
|
||||
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
|
||||
Throw New Exception($"文件大小不一致,获取结果为 {ContentLength},要求必须为 {Check.ActualSize}。")
|
||||
End If
|
||||
End If
|
||||
FileSize = ContentLength : IsUnknownSize = False
|
||||
Log($"[Download] {LocalName}:文件大小 {ContentLength}({GetString(ContentLength)})")
|
||||
'若文件大小大于 50 M,进行剩余磁盘空间校验
|
||||
If ContentLength > 50 * 1024 * 1024 Then
|
||||
For Each Drive As DriveInfo In DriveInfo.GetDrives
|
||||
Dim DriveName As String = Drive.Name.First.ToString
|
||||
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
|
||||
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
|
||||
If Drive.TotalFreeSpace < RequiredSpace Then
|
||||
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
|
||||
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
ElseIf FileSize < 0 Then
|
||||
Throw New Exception("非首线程运行时,尚未获取文件大小")
|
||||
ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
|
||||
NotSupportRange:
|
||||
SyncLock LockSource
|
||||
If SourcesOnce.Contains(Th.Source) Then
|
||||
GoTo SourceBreak
|
||||
Else
|
||||
SourcesOnce.Add(Th.Source)
|
||||
End If
|
||||
End SyncLock
|
||||
Throw New WebException($"该下载源不支持分段下载:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
|
||||
ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
|
||||
Throw New WebException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
|
||||
End If
|
||||
'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}")
|
||||
Th.State = NetState.Get
|
||||
SyncLock LockState
|
||||
If State < NetState.Get Then State = NetState.Get
|
||||
End SyncLock
|
||||
'创建缓存文件
|
||||
If IsNoSplit Then
|
||||
Th.Temp = Nothing
|
||||
Cache = New MemoryStream
|
||||
ResultStream = Cache
|
||||
Else
|
||||
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
|
||||
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
|
||||
End If
|
||||
'开始下载
|
||||
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
|
||||
If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
|
||||
Dim ResponseBytes As Byte() = New Byte(16384) {}
|
||||
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetAwaiter().GetResult()
|
||||
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
|
||||
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
|
||||
'限速
|
||||
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
|
||||
Threading.Thread.Sleep(16)
|
||||
End While
|
||||
Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Th.DownloadUndone))
|
||||
SyncLock NetTaskSpeedLimitLeftLock
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
|
||||
End SyncLock
|
||||
Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime
|
||||
If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
|
||||
If RealDataCount > 0 Then
|
||||
'有数据
|
||||
If Th.DownloadDone = 0 Then
|
||||
'第一次接受到数据
|
||||
Th.State = NetState.Download
|
||||
SyncLock LockState
|
||||
If State < NetState.Download Then State = NetState.Download
|
||||
End SyncLock
|
||||
SyncLock LockCount
|
||||
ConnectCount += 1
|
||||
ConnectTime += GetTimeTick() - Th.InitTime
|
||||
End SyncLock
|
||||
End If
|
||||
SyncLock LockCount
|
||||
Th.Source.FailCount = 0
|
||||
For Each Task In Tasks
|
||||
Task.FailCount = 0
|
||||
Next
|
||||
End SyncLock
|
||||
NetManager.DownloadDone += RealDataCount
|
||||
SyncLock LockDone
|
||||
DownloadDone += RealDataCount
|
||||
End SyncLock
|
||||
Th.DownloadDone += RealDataCount
|
||||
ResultStream.Write(ResponseBytes, 0, RealDataCount)
|
||||
'已完成
|
||||
If Th.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While
|
||||
'检查速度是否过慢
|
||||
If DeltaTime > 5000 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 5s,且速度小于 1K/s
|
||||
Th.Source.SingleThread Is Nothing Then '且并非单线程下载
|
||||
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
|
||||
End If
|
||||
Th.LastReceiveTime = GetTimeTick()
|
||||
ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
|
||||
'无数据,且已超时
|
||||
Throw New TimeoutException("操作超时,无数据。")
|
||||
End If
|
||||
HttpDataCount = ResponseStream.Read(ResponseBytes, 0, 16384)
|
||||
End While
|
||||
SourceBreak:
|
||||
If State = NetState.Error OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
|
||||
'被外部中断
|
||||
@@ -1018,16 +1123,24 @@ SourceBreak:
|
||||
'本线程完成
|
||||
Th.State = NetState.Finish
|
||||
If ModeDebug Then Log($"[Download] {LocalName}:完成,已下载 {Th.DownloadDone}({Th.DownloadStart}~{Th.DownloadEnd})")
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log($"[Download] {LocalName}:出错,{If(TypeOf ex Is TaskCanceledException, $"已超时({Timeout}ms)", GetExceptionDetail(ex))}")
|
||||
Log($"[Download] {LocalName}:出错,{If(TypeOf ex Is OperationCanceledException, $"已超时({Timeout}ms)", ex.GetDetail())},{HostIp}")
|
||||
RecordIPReliability(HostIp, -0.7)
|
||||
SourceFail(Th, ex, False)
|
||||
Finally
|
||||
'释放资源
|
||||
HttpRequest?.Dispose()
|
||||
Response?.Dispose()
|
||||
ResponseStream?.Dispose()
|
||||
CancelToken?.Dispose()
|
||||
If Not IsNoSplit Then ResultStream?.Dispose()
|
||||
'改变计数
|
||||
SyncLock NetTaskThreadCountLock
|
||||
NetTaskThreadCount -= 1
|
||||
End SyncLock
|
||||
'合并
|
||||
If Not IsNoSplit Then ResultStream?.Dispose()
|
||||
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
|
||||
State < NetState.Merge AndAlso Th.State <> NetState.Error Then Merge(Th)
|
||||
End Try
|
||||
@@ -1046,7 +1159,7 @@ SourceBreak:
|
||||
If IsMergeFailure OrElse
|
||||
ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
|
||||
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
|
||||
(ex.Message.Contains("(403)") AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
|
||||
((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429,所以不应因此禁用下载源
|
||||
(Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
|
||||
'当一个下载源有多个线程在下载时,只选择其中一个线程进行后续处理
|
||||
Dim IsThisFail As Boolean = False
|
||||
@@ -1140,10 +1253,10 @@ SourceBreak:
|
||||
Dim RetryCount As Integer = 0
|
||||
Try
|
||||
Retry:
|
||||
'创建文件夹
|
||||
If File.Exists(LocalPath) Then File.Delete(LocalPath)
|
||||
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
|
||||
SyncLock LockChain
|
||||
'创建文件夹
|
||||
If File.Exists(LocalPath) Then File.Delete(LocalPath)
|
||||
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
|
||||
'合并文件
|
||||
If IsNoSplit Then
|
||||
'仅有一个线程,从缓存中输出
|
||||
@@ -1386,13 +1499,13 @@ NextElement:
|
||||
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
|
||||
For Each Source As NetSource In File.Sources
|
||||
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
|
||||
Source.Ex = New ArgumentException("输入的下载链接不正确!")
|
||||
Source.Ex = New ArgumentException("输入的下载链接不正确:" & Source.Url)
|
||||
Source.IsFailed = True
|
||||
End If
|
||||
Next
|
||||
If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!")
|
||||
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
|
||||
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
|
||||
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath)
|
||||
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath)
|
||||
'文件夹检测
|
||||
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
|
||||
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
|
||||
@@ -1522,12 +1635,12 @@ Retry:
|
||||
If State > LoadState.Loading Then Return
|
||||
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
|
||||
'寻找有效的错误信息
|
||||
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot TaskCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
|
||||
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
|
||||
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
|
||||
'获取实际失败的文件
|
||||
For Each File In Files
|
||||
If File.State <> NetState.Error Then Continue For
|
||||
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex?.Message, "无错误信息。")}({s.Url})"), vbCrLf)
|
||||
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}({s.Url})"), vbCrLf)
|
||||
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf &
|
||||
"各下载源的错误如下:" & vbCrLf & Detail,
|
||||
[Error])
|
||||
@@ -1547,7 +1660,7 @@ Retry:
|
||||
'在退出同步锁后再进行日志输出
|
||||
Dim ErrOutput As New List(Of String)
|
||||
For Each Ex As Exception In ExList
|
||||
ErrOutput.Add(GetExceptionDetail(Ex))
|
||||
ErrOutput.Add(Ex.GetDetail())
|
||||
Next
|
||||
Log("[Download] " & Join(ErrOutput.Distinct.ToArray, vbCrLf))
|
||||
End Sub
|
||||
@@ -1697,7 +1810,7 @@ Retry:
|
||||
For Each File As NetFile In WaitingFiles
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
|
||||
Next
|
||||
'为进行中的文件追加线程
|
||||
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
|
||||
@@ -1717,7 +1830,7 @@ Retry:
|
||||
'新增线程
|
||||
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
|
||||
Next
|
||||
End While
|
||||
Catch ex As Exception
|
||||
@@ -1842,4 +1955,15 @@ Retry:
|
||||
End If
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 判断某个 Exception 是否为网络问题所导致。
|
||||
''' </summary>
|
||||
<Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
|
||||
If TypeOf Ex Is DnsLookupException Then Return True
|
||||
Dim Detail = Ex.GetDetail()
|
||||
If Detail.Contains("(403)") Then Return False
|
||||
Return {"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝"}.
|
||||
Any(Function(k) Detail.ContainsF(k, True))
|
||||
End Function
|
||||
|
||||
End Module
|
||||
|
||||
@@ -191,7 +191,7 @@ Public Class ValidateExceptSame
|
||||
Me.ErrorMessage = ErrorMessage
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
End Sub
|
||||
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
|
||||
Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
|
||||
Me.Excepts = New ObjectModel.Collection(Of String)
|
||||
For Each Data As String In Excepts
|
||||
Me.Excepts.Add(Data)
|
||||
@@ -199,6 +199,11 @@ Public Class ValidateExceptSame
|
||||
Me.ErrorMessage = ErrorMessage
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
End Sub
|
||||
Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
|
||||
Me.Excepts = New ObjectModel.Collection(Of String) From {Except}
|
||||
Me.ErrorMessage = ErrorMessage
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")
|
||||
For Each Ch As String In Excepts
|
||||
|
||||
@@ -347,7 +347,7 @@
|
||||
Case 4475 : Tags.Add("冒险")
|
||||
Case 4476 : Tags.Add("探索")
|
||||
Case 4477 : Tags.Add("小游戏")
|
||||
Case 4471 : Tags.Add("科幻")
|
||||
Case 4474 : Tags.Add("科幻")
|
||||
Case 4736 : Tags.Add("空岛")
|
||||
Case 5128 : Tags.Add("原版改良")
|
||||
Case 4487 : Tags.Add("FTB")
|
||||
@@ -1161,9 +1161,9 @@ Retry:
|
||||
ElseIf [Error] IsNot Nothing Then
|
||||
'有结果但是有错误
|
||||
If CurseForgeFailed Then
|
||||
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后重试,或使用 VPN 以改善网络环境。"
|
||||
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
|
||||
Else
|
||||
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后重试,或使用 VPN 以改善网络环境。"
|
||||
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -1354,7 +1354,7 @@ Retry:
|
||||
''' </summary>
|
||||
''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
|
||||
Public Function ToNetFile(LocalAddress As String) As NetFile
|
||||
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
|
||||
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), SimulateBrowserHeaders:=True)
|
||||
End Function
|
||||
|
||||
'实例化
|
||||
@@ -1395,10 +1395,9 @@ Retry:
|
||||
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
|
||||
Url = Url.Replace(FileName, WebUtility.UrlEncode(FileName)) '对文件名进行编码
|
||||
DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
|
||||
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
|
||||
DownloadUrls = HandleCurseForgeDownloadUrls(Url.Replace(FileName, WebUtility.UrlEncode(FileName))) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源;注意 MCIM 源不支持 URL 编码后的文件名,必须传入 URL 编码前的文件名
|
||||
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") Then
|
||||
|
||||
@@ -485,7 +485,7 @@ Done:
|
||||
'崩溃报告分析,高优先级
|
||||
If LogCrash IsNot Nothing Then
|
||||
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
|
||||
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
|
||||
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
|
||||
End If
|
||||
|
||||
'游戏日志分析
|
||||
@@ -542,8 +542,8 @@ Done:
|
||||
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
|
||||
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
|
||||
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
|
||||
If LogMc.Contains("Incompatible mods found!") Then '#5006
|
||||
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
|
||||
If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
|
||||
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息:").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
|
||||
End If
|
||||
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
|
||||
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
|
||||
@@ -581,6 +581,7 @@ Done:
|
||||
End If
|
||||
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@@ -658,7 +659,7 @@ Done:
|
||||
End If
|
||||
'Mod 解析错误(常见于 Fabric 前置校验失败)
|
||||
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
|
||||
'Mixin 失败可以导致大量 Mod 实例创建失败
|
||||
'Mixin 失败可以导致大量 Mod 实例创建失败,因此需要放到低优先级中
|
||||
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
|
||||
'注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报
|
||||
End If
|
||||
@@ -717,7 +718,7 @@ NextStack:
|
||||
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
|
||||
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
|
||||
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
|
||||
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill"
|
||||
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
|
||||
}.Contains(Word.ToLower) Then Continue For
|
||||
PossibleWords.Add(Word.Trim)
|
||||
Next
|
||||
@@ -949,7 +950,7 @@ NextStack:
|
||||
Dim Additional As List(Of String) = Reason.Value
|
||||
Select Case Reason.Key
|
||||
Case CrashReason.Java虚拟机参数有误
|
||||
Results.Add("由于 Java 虚拟机参数有误,导致游戏无法继续运行。\n请检查高级启动选项中设置的 Java 虚拟机参数是否有误。")
|
||||
Results.Add("由于 Java 参数有误,导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
|
||||
Case CrashReason.Mod文件被解压
|
||||
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
|
||||
Case CrashReason.内存不足
|
||||
@@ -1030,14 +1031,17 @@ NextStack:
|
||||
End If
|
||||
Case CrashReason.特定实体导致崩溃
|
||||
If Additional.Count = 1 Then
|
||||
Dim entityInfo As String = Additional.First
|
||||
If entityInfo.StartsWith("minecraft:player") Then
|
||||
Results.Add("游戏似乎因为玩家实体 " & entityInfo & " 出现了问题。\n\n这通常是因为玩家数据损坏或世界存档问题导致的。\n请尝试以下解决方案:\n - 创建一个新世界,观察游戏是否正常运行\n - 如果新世界正常,可能需要删除或修复当前世界的玩家数据文件\n - 也可能是某个 Mod 与玩家实体处理存在冲突,尝试逐个禁用近期安装的 Mod\n - 如果问题持续存在,建议备份重要数据后重新创建世界\h")
|
||||
If Additional.First.Contains("minecraft:player") Then
|
||||
If Additional.First.Contains(" ") Then
|
||||
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
|
||||
Else
|
||||
Results.Add($"游戏因为玩家实体导致了崩溃。\h")
|
||||
End If
|
||||
Else
|
||||
Results.Add("游戏似乎因为实体 " & entityInfo & " 出现了问题。\n\n请尝试以下解决方案:\n - 创建一个新世界,并尝试生成该类型的实体,观察游戏运行情况\n - 如果新世界中该实体正常,问题可能在于当前世界的数据损坏\n - 如果新世界中仍然崩溃,可能是某个 Mod 导致了实体处理异常\n - 尝试逐个禁用可能影响实体的 Mod(如生物类、AI 类 Mod)\n - 也可以尝试使用指令删除该坐标附近的实体\h")
|
||||
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
|
||||
End If
|
||||
Else
|
||||
Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n请尝试以下解决方案:\n - 创建一个新世界,观察游戏的运行情况\n - 如果新世界正常运行,则是当前世界的实体数据导致出错\n - 可以尝试使用指令清理异常实体\n - 如果问题持续存在,可能是某个处理实体的 Mod 存在问题\n - 建议逐个禁用近期安装的 Mod,特别是涉及生物、AI 或实体处理的 Mod\h")
|
||||
Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、")}\h")
|
||||
End If
|
||||
Case CrashReason.OptiFine与Forge不兼容
|
||||
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
|
||||
|
||||
@@ -198,7 +198,7 @@
|
||||
Private IsNewClientVersionHinted As Boolean = False
|
||||
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Dim StartTime As Long = GetTimeTick()
|
||||
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json"))
|
||||
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
|
||||
@@ -235,7 +235,7 @@
|
||||
''' </summary>
|
||||
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
|
||||
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json"))
|
||||
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
|
||||
@@ -413,7 +413,7 @@
|
||||
''' </summary>
|
||||
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
|
||||
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
|
||||
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList"))
|
||||
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
|
||||
Try
|
||||
Dim Versions As New List(Of DlOptiFineListEntry)
|
||||
For Each Token As JObject In Json
|
||||
@@ -483,7 +483,7 @@
|
||||
''' </summary>
|
||||
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
|
||||
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
|
||||
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", UseBrowserUserAgent:=True)
|
||||
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
|
||||
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
|
||||
'获取所有版本信息
|
||||
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
|
||||
@@ -631,9 +631,9 @@
|
||||
Try
|
||||
Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
|
||||
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
|
||||
".html", UseBrowserUserAgent:=True)
|
||||
".html", SimulateBrowserHeaders:=True)
|
||||
Catch ex As Exception
|
||||
If GetExceptionSummary(ex).Contains("(404)") Then
|
||||
If ex.GetBrief().Contains("(404)") Then
|
||||
Throw New Exception("不可用")
|
||||
Else
|
||||
Throw
|
||||
@@ -701,7 +701,7 @@
|
||||
''' </summary>
|
||||
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
|
||||
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
|
||||
Loader.Input.Replace("-", "_"))) '兼容 Forge 1.7.10-pre4,#4057
|
||||
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4,#4057
|
||||
Dim Versions As New List(Of DlForgeVersionEntry)
|
||||
Try
|
||||
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
|
||||
@@ -835,8 +835,8 @@
|
||||
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
|
||||
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
|
||||
'获取版本列表 JSON
|
||||
Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge")
|
||||
Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge")
|
||||
Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
|
||||
Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
|
||||
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
|
||||
'解析
|
||||
Try
|
||||
@@ -853,8 +853,8 @@
|
||||
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
|
||||
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
|
||||
'获取版本列表 JSON
|
||||
Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge")
|
||||
Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge")
|
||||
Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
|
||||
Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
|
||||
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
|
||||
'解析
|
||||
Try
|
||||
@@ -959,7 +959,7 @@
|
||||
''' </summary>
|
||||
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
|
||||
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json"))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
|
||||
Try
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
@@ -987,7 +987,7 @@
|
||||
''' </summary>
|
||||
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
|
||||
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json"))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
|
||||
Try
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
@@ -1058,7 +1058,7 @@
|
||||
''' </summary>
|
||||
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
|
||||
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions"))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
|
||||
Try
|
||||
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
|
||||
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
|
||||
@@ -1073,7 +1073,7 @@
|
||||
''' </summary>
|
||||
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
|
||||
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions"))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
|
||||
Try
|
||||
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
|
||||
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
|
||||
@@ -1130,7 +1130,7 @@
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8))
|
||||
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
|
||||
'路径
|
||||
''' <summary>
|
||||
''' Java.exe 文件的完整路径。
|
||||
''' java.exe 文件的完整路径。
|
||||
''' </summary>
|
||||
Public ReadOnly Property PathJava As String
|
||||
Get
|
||||
@@ -18,15 +18,7 @@
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' Javaw.exe 文件的完整路径。
|
||||
''' </summary>
|
||||
Public ReadOnly Property PathJavaw As String
|
||||
Get
|
||||
Return PathFolder & "javaw.exe"
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' Javaw.exe 文件所在文件夹的路径,以 \ 结尾。
|
||||
''' java.exe 文件所在文件夹的路径,以 \ 结尾。
|
||||
''' </summary>
|
||||
Public PathFolder As String
|
||||
''' <summary>
|
||||
@@ -102,20 +94,13 @@
|
||||
Dim Output As String = Nothing
|
||||
Try
|
||||
'确定文件存在
|
||||
If Not File.Exists(PathJavaw) Then
|
||||
Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw)
|
||||
End If
|
||||
If Not File.Exists(PathFolder & "java.exe") Then
|
||||
Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
|
||||
End If
|
||||
If File.Exists(PathFolder & "pdf-bookmark") Then
|
||||
Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
|
||||
End If
|
||||
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
|
||||
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
|
||||
IsJre = Not File.Exists(PathFolder & "javac.exe")
|
||||
'运行 -version
|
||||
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
|
||||
Output = ShellAndGetOutput(PathJava, "-version", 15000).ToLower
|
||||
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
|
||||
If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
|
||||
If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output)
|
||||
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
|
||||
If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java,该 Java 或系统存在问题")
|
||||
'获取详细信息
|
||||
@@ -136,17 +121,17 @@
|
||||
End If
|
||||
Is64Bit = Output.Contains("64-bit")
|
||||
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
|
||||
'基于 #3649,在 64 位系统上禁用 32 位 Java
|
||||
'#3649:在 64 位系统上禁用 32 位 Java
|
||||
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
|
||||
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
|
||||
'#2249:JRE 17 似乎会导致 Forge 安装失败,干脆禁用更多版本的 JRE
|
||||
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
|
||||
Catch ex As ApplicationException
|
||||
Throw ex
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw ex
|
||||
Catch ex As Exception
|
||||
Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
|
||||
Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex)
|
||||
Log("[Java] 检查失败的 Java 输出:" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
|
||||
Throw New Exception("检查 Java 失败(" & If(PathJava, "Nothing") & ")", ex)
|
||||
End Try
|
||||
IsChecked = True
|
||||
End Sub
|
||||
@@ -689,7 +674,7 @@ Wait:
|
||||
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
|
||||
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
|
||||
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
|
||||
"4297127d64ec6", "1.", "启动", "jbr-"}
|
||||
"4297127d64ec6", "1.", "启动", "jbr"}
|
||||
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
|
||||
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
|
||||
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
|
||||
|
||||
@@ -178,7 +178,7 @@ NextInner:
|
||||
GoTo NextInner
|
||||
Else
|
||||
'没有特殊处理过的错误信息
|
||||
McLaunchLog("错误:" & GetExceptionDetail(ex))
|
||||
McLaunchLog("错误:" & ex.GetDetail())
|
||||
Log(ex,
|
||||
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox,
|
||||
If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
|
||||
@@ -187,7 +187,7 @@ NextInner:
|
||||
Telemetry("Minecraft 启动失败",
|
||||
"Version", McVersionCurrent.Version.ToString,
|
||||
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
|
||||
"Exception", FilterUserName(FilterAccessToken(GetExceptionDetail(ex), "*"), "*"))
|
||||
"Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
|
||||
End If
|
||||
Throw
|
||||
End If
|
||||
@@ -609,12 +609,8 @@ SkipLogin:
|
||||
McLoginRequestValidate(Data)
|
||||
GoTo LoginFinish
|
||||
Catch ex As Exception
|
||||
Dim AllMessage = GetExceptionDetail(ex)
|
||||
McLaunchLog("验证登录失败:" & AllMessage)
|
||||
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
|
||||
McLaunchLog("已触发超时登录失败")
|
||||
Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后重试,或使用加速器或 VPN 以改善网络环境。")
|
||||
End If
|
||||
Log(ex, "验证登录失败")
|
||||
If IsNetworkRelated(ex) Then Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
|
||||
End Try
|
||||
Data.Progress = 0.25
|
||||
'尝试刷新登录
|
||||
@@ -624,7 +620,7 @@ Refresh:
|
||||
McLoginRequestRefresh(Data, NeedRefresh)
|
||||
GoTo LoginFinish
|
||||
Catch ex As Exception
|
||||
McLaunchLog("刷新登录失败:" & GetExceptionDetail(ex))
|
||||
McLaunchLog("刷新登录失败:" & ex.GetDetail())
|
||||
If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
|
||||
End Try
|
||||
Data.Progress = If(NeedRefresh, 0.85, 0.45)
|
||||
@@ -634,7 +630,7 @@ Refresh:
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
NeedRefresh = McLoginRequestLogin(Data)
|
||||
Catch ex As Exception
|
||||
McLaunchLog("登录失败:" & GetExceptionDetail(ex))
|
||||
McLaunchLog("登录失败:" & ex.GetDetail())
|
||||
Throw
|
||||
End Try
|
||||
If NeedRefresh Then
|
||||
@@ -699,7 +695,7 @@ LoginFinish:
|
||||
'发送登录请求
|
||||
Dim RequestData As New JObject(
|
||||
New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True))
|
||||
NetRequestByClientRetry(
|
||||
NetRequestByClient(
|
||||
Data.Input.BaseUrl & "/validate", HttpMethod.Post,
|
||||
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
|
||||
Headers:={{"Accept-Language", "zh-CN"}},
|
||||
@@ -726,7 +722,7 @@ LoginFinish:
|
||||
New JProperty("requestUser", True)
|
||||
).ToString(Newtonsoft.Json.Formatting.None),
|
||||
Headers:={{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8"))
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True))
|
||||
'将登录结果输出
|
||||
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
|
||||
Data.Output.AccessToken = LoginJson("accessToken").ToString
|
||||
@@ -756,7 +752,7 @@ LoginFinish:
|
||||
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
|
||||
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
|
||||
Headers:={{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8"))
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True))
|
||||
'检查登录结果
|
||||
If LoginJson("availableProfiles").Count = 0 Then
|
||||
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Critical)
|
||||
@@ -814,13 +810,14 @@ LoginFinish:
|
||||
McLaunchLog("登录成功(Login, " & Data.Input.Token & ")")
|
||||
Return NeedRefresh
|
||||
Catch ex As Exception
|
||||
Dim AllMessage As String = GetExceptionSummary(ex)
|
||||
Dim AllMessage As String = ex.GetBrief()
|
||||
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
|
||||
'读取服务器返回的错误
|
||||
If TypeOf ex Is ResponsedWebException Then
|
||||
Dim ErrorMessage As String = Nothing
|
||||
Try
|
||||
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
|
||||
Dim Response = DirectCast(ex, ResponsedWebException).Response
|
||||
If ErrorMessage.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage")
|
||||
Catch
|
||||
End Try
|
||||
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
|
||||
@@ -838,7 +835,7 @@ LoginFinish:
|
||||
End If
|
||||
End If
|
||||
'通用关键字检测
|
||||
If AllMessage.Contains("403") Then
|
||||
If AllMessage.Contains("(403)") Then
|
||||
Select Case Data.Input.Type
|
||||
Case McLoginType.Auth
|
||||
Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
|
||||
@@ -852,8 +849,8 @@ LoginFinish:
|
||||
If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
|
||||
" - 只注册了账号,但没有加入对应服务器。")
|
||||
End Select
|
||||
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") OrElse AllMessage.Contains("408") OrElse AllMessage.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应,连接尝试失败。") Then
|
||||
Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后重试,或使用加速器或 VPN 以改善网络环境。")
|
||||
ElseIf ex.IsNetworkRelated() Then
|
||||
Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
|
||||
ElseIf ex.Message.StartsWithF("$") Then
|
||||
Throw
|
||||
Else
|
||||
@@ -872,7 +869,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",
|
||||
ContentType:="application/x-www-form-urlencoded"))
|
||||
ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
|
||||
McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
|
||||
|
||||
'弹窗
|
||||
@@ -907,6 +904,7 @@ Retry:
|
||||
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
|
||||
ThreadCount:=2)
|
||||
Catch ex As ResponsedWebException
|
||||
'修改错误列表时,同时检查 MyMsgLogin.xaml.vb 中的对应代码
|
||||
Dim Response = ex.Response
|
||||
If Response.ContainsF("must sign in again", True) OrElse Response.ContainsF("password expired", True) OrElse
|
||||
(Response.Contains("refresh_token") AndAlso Response.Contains("is not valid")) Then '#269
|
||||
@@ -941,7 +939,7 @@ Retry:
|
||||
""TokenType"": ""JWT""
|
||||
}"
|
||||
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
|
||||
Content:=Request, ContentType:="application/json")
|
||||
Content:=Request, ContentType:="application/json", RequireJson:=True)
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim XBLToken As String = ResultJson("Token").ToString
|
||||
Return XBLToken
|
||||
@@ -963,7 +961,7 @@ Retry:
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
|
||||
Content:=Request, ContentType:="application/json")
|
||||
Content:=Request, ContentType:="application/json", RequireJson:=True)
|
||||
Catch ex As ResponsedWebException
|
||||
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
|
||||
If ex.Response.Contains("2148916227") Then
|
||||
@@ -975,7 +973,7 @@ Retry:
|
||||
End If
|
||||
Throw New Exception("$$")
|
||||
ElseIf ex.Response.Contains("2148916235") Then
|
||||
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN。", "登录失败", "我知道了")
|
||||
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN,然后再试。", "登录失败", "我知道了")
|
||||
Throw New Exception("$$")
|
||||
ElseIf ex.Response.Contains("2148916238") Then
|
||||
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
|
||||
@@ -994,15 +992,11 @@ Retry:
|
||||
End If
|
||||
End Try
|
||||
|
||||
Try '这个 Try 块仅为了追踪 #6683 而添加
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim XSTSToken As String = ResultJson("Token").ToString
|
||||
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
|
||||
Return {XSTSToken, UHS}
|
||||
Catch
|
||||
Log("[Launch] 返回内容:" & vbCrLf & Result)
|
||||
Throw
|
||||
End Try
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Return {
|
||||
ResultJson("Token"), 'XSTSToken
|
||||
ResultJson("DisplayClaims")("xui")(0)("uhs") 'UHS
|
||||
}
|
||||
End Function
|
||||
'微软登录步骤 4:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
|
||||
Private Function MsLoginStep4(Tokens As String()) As String
|
||||
@@ -1012,9 +1006,9 @@ Retry:
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestByClientRetry("https://api.minecraftservices.com/authentication/login_with_xbox", HttpMethod.Post,
|
||||
Content:=Request, ContentType:="application/json")
|
||||
Content:=Request, ContentType:="application/json", RequireJson:=True)
|
||||
Catch ex As Net.WebException
|
||||
Dim Message As String = GetExceptionSummary(ex)
|
||||
Dim Message As String = ex.GetBrief()
|
||||
If Message.Contains("(429)") Then
|
||||
Log(ex, "微软登录第 4 步汇报 429")
|
||||
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
|
||||
@@ -1026,16 +1020,14 @@ Retry:
|
||||
End If
|
||||
End Try
|
||||
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Return AccessToken
|
||||
Return GetJson(Result)("access_token").ToString
|
||||
End Function
|
||||
'微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
|
||||
Private Sub MsLoginStep5(AccessToken As String)
|
||||
McLaunchLog("开始微软登录步骤 5/6")
|
||||
|
||||
Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
|
||||
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
|
||||
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
|
||||
Try
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
|
||||
@@ -1057,9 +1049,9 @@ Retry:
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestByClientMultiple("https://api.minecraftservices.com/minecraft/profile",
|
||||
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}})
|
||||
Catch ex As Net.WebException
|
||||
Dim Message As String = GetExceptionSummary(ex)
|
||||
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
|
||||
Catch ex As WebException
|
||||
Dim Message As String = ex.GetBrief()
|
||||
If Message.Contains("(429)") Then
|
||||
Log(ex, "微软登录第 6 步汇报 429")
|
||||
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
|
||||
@@ -1130,7 +1122,7 @@ Retry:
|
||||
If Len(Uuid) = 32 Then Return Uuid
|
||||
'从官网获取
|
||||
Try
|
||||
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name))
|
||||
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
|
||||
If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在(" & Name & ")")
|
||||
Uuid = If(GotJson("id"), "")
|
||||
Catch ex As Exception
|
||||
@@ -1495,6 +1487,9 @@ Retry:
|
||||
DataList.Add(Version.JsonObject("mainClass"))
|
||||
End If
|
||||
|
||||
'处理 DataList 的换行符
|
||||
DataList = DataList.Select(Function(d) d.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim).ToList
|
||||
|
||||
Return Join(DataList, " ")
|
||||
End Function
|
||||
Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String
|
||||
@@ -1538,9 +1533,7 @@ NextVersion:
|
||||
'Authlib-Injector
|
||||
If McLoginLoader.Output.Type = "Auth" Then
|
||||
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
|
||||
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
|
||||
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
|
||||
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
|
||||
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
|
||||
Try
|
||||
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
|
||||
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
|
||||
@@ -1562,7 +1555,7 @@ NextVersion:
|
||||
'如果不合并,会导致 Forge 1.17 启动无效,它有两个 --add-exports,进一步导致其中一个在后面被去重
|
||||
Dim DeDuplicateDataList As New List(Of String)
|
||||
For i = 0 To DataList.Count - 1
|
||||
Dim CurrentEntry As String = DataList(i)
|
||||
Dim CurrentEntry As String = DataList(i).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ").Trim
|
||||
If DataList(i).StartsWithF("-") Then
|
||||
Do While i < DataList.Count - 1
|
||||
If DataList(i + 1).StartsWithF("-") Then
|
||||
@@ -1803,7 +1796,7 @@ NextVersion:
|
||||
File.Delete(FilePath)
|
||||
Catch ex As UnauthorizedAccessException
|
||||
McLaunchLog("删除原 dll 访问被拒绝,这通常代表有一个 MC 正在运行,跳过解压:" & FilePath)
|
||||
McLaunchLog("实际的错误信息:" & GetExceptionSummary(ex))
|
||||
McLaunchLog("实际的错误信息:" & ex.GetDetail())
|
||||
Exit For
|
||||
End Try
|
||||
End If
|
||||
@@ -1823,7 +1816,7 @@ NextVersion:
|
||||
File.Delete(FileName)
|
||||
Catch ex As UnauthorizedAccessException
|
||||
McLaunchLog("删除多余文件访问被拒绝,跳过删除步骤")
|
||||
McLaunchLog("实际的错误信息:" & GetExceptionSummary(ex))
|
||||
McLaunchLog("实际的错误信息:" & ex.GetDetail())
|
||||
Return
|
||||
End Try
|
||||
Next
|
||||
@@ -1849,7 +1842,7 @@ NextVersion:
|
||||
'要求 Java 使用高性能显卡
|
||||
If Setup.Get("LaunchAdvanceGraphicCard") Then
|
||||
Try
|
||||
SetGPUPreference(McLaunchJavaSelected.PathJavaw)
|
||||
SetGPUPreference(McLaunchJavaSelected.PathJava)
|
||||
SetGPUPreference(PathWithName)
|
||||
Catch ex As Exception
|
||||
If IsAdmin() Then
|
||||
@@ -1857,7 +1850,7 @@ NextVersion:
|
||||
Else
|
||||
Log(ex, "直接调整显卡设置失败,将以管理员权限重启 PCL 再次尝试")
|
||||
Try
|
||||
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJavaw}""") = ProcessReturnValues.TaskDone Then
|
||||
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
|
||||
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
|
||||
Else
|
||||
Throw New Exception("调整过程中出现异常")
|
||||
@@ -2218,7 +2211,7 @@ IgnoreCustomSkin:
|
||||
|
||||
'启动信息
|
||||
Dim GameProcess = New Process()
|
||||
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
|
||||
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
|
||||
|
||||
'设置环境变量
|
||||
Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
|
||||
@@ -2231,13 +2224,13 @@ IgnoreCustomSkin:
|
||||
StartInfo.UseShellExecute = False
|
||||
StartInfo.RedirectStandardOutput = True
|
||||
StartInfo.RedirectStandardError = True
|
||||
StartInfo.CreateNoWindow = False
|
||||
StartInfo.CreateNoWindow = True
|
||||
StartInfo.Arguments = McLaunchArgument
|
||||
GameProcess.StartInfo = StartInfo
|
||||
|
||||
'开始进程
|
||||
GameProcess.Start()
|
||||
McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.PathJavaw)
|
||||
McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.PathJava)
|
||||
If Loader.IsAborted Then
|
||||
McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631
|
||||
GameProcess.Kill()
|
||||
|
||||
@@ -86,7 +86,7 @@ Public Module ModMinecraft
|
||||
Next
|
||||
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
|
||||
Catch ex As Exception
|
||||
MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
|
||||
MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & Path & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
|
||||
Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
|
||||
End Try
|
||||
Next
|
||||
@@ -695,7 +695,7 @@ Recheck:
|
||||
Catch ex As Exception
|
||||
Log(ex, "依赖版本检查出错(" & Name & ")")
|
||||
State = McVersionState.Error
|
||||
Info = "未知错误:" & GetExceptionSummary(ex)
|
||||
Info = "未知错误:" & ex.GetBrief()
|
||||
Return False
|
||||
End Try
|
||||
|
||||
@@ -808,7 +808,7 @@ ExitDataLoad:
|
||||
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Info = "未知错误:" & GetExceptionSummary(ex)
|
||||
Info = "未知错误:" & ex.GetBrief()
|
||||
Logo = PathImage & "Blocks/RedstoneBlock.png"
|
||||
State = McVersionState.Error
|
||||
Log(ex, "加载版本失败(" & Name & ")", LogLevel.Feedback)
|
||||
@@ -1186,6 +1186,7 @@ OnLoaded:
|
||||
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
|
||||
Catch ex As ThreadInterruptedException
|
||||
Catch ex As Exception
|
||||
If Loader.IsAborted Then Return '#5617
|
||||
WriteIni(Path & "PCL.ini", "VersionCache", "") '要求下次重新加载
|
||||
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
|
||||
End Try
|
||||
@@ -1592,11 +1593,11 @@ OnLoaded:
|
||||
''' <summary>
|
||||
''' 获取 Uuid 对应的皮肤文件地址,失败将抛出异常。
|
||||
''' </summary>
|
||||
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
|
||||
If Uuid = "" Then Throw New Exception("Uuid 为空。")
|
||||
If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
|
||||
Public Function McSkinGetAddress(UUID As String, Type As String) As String
|
||||
If UUID = "" Then Throw New Exception("UUID 为空。")
|
||||
If UUID.StartsWithF("00000") AndAlso Type <> "Auth" Then Throw New Exception("离线 UUID 无正版皮肤文件:" & UUID)
|
||||
'尝试读取缓存
|
||||
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
|
||||
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID)
|
||||
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
|
||||
'获取皮肤地址
|
||||
Dim Url As String
|
||||
@@ -1610,7 +1611,7 @@ OnLoaded:
|
||||
Case Else
|
||||
Throw New ArgumentException("皮肤地址种类无效:" & If(Type, "null"))
|
||||
End Select
|
||||
Dim SkinString = NetRequestByClientRetry(Url & Uuid)
|
||||
Dim SkinString = NetRequestByClientRetry(Url & UUID, RequireJson:=True)
|
||||
If SkinString = "" Then Throw New Exception("皮肤返回值为空,可能是未设置自定义皮肤的用户")
|
||||
'处理皮肤地址
|
||||
Dim SkinValue As String
|
||||
@@ -1635,8 +1636,8 @@ OnLoaded:
|
||||
SkinValue = If(SkinUrl.Contains("minecraft.net/"), SkinUrl.Replace("http://", "https://"), SkinUrl)
|
||||
End If
|
||||
'保存缓存
|
||||
WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid, SkinValue)
|
||||
Log("[Skin] UUID " & Uuid & " 对应的皮肤文件为 " & SkinValue)
|
||||
WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", UUID, SkinValue)
|
||||
Log("[Skin] UUID " & UUID & " 对应的皮肤文件为 " & SkinValue)
|
||||
Return SkinValue
|
||||
End Function
|
||||
|
||||
@@ -1966,7 +1967,7 @@ OnLoaded:
|
||||
Try
|
||||
Log("[Minecraft] 开始获取统一通行证下载信息")
|
||||
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
|
||||
DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)))
|
||||
DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version), RequireJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取统一通行证下载信息失败")
|
||||
End Try
|
||||
@@ -1983,16 +1984,20 @@ OnLoaded:
|
||||
|
||||
'Authlib-Injector 文件
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
|
||||
Dim TargetFile = PathPure & "\authlib-injector.jar"
|
||||
Dim TargetFile = PathPure & "authlib-injector.jar"
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
|
||||
DownloadInfo = GetJson(NetRequestByClientRetry(
|
||||
"https://authlib-injector.yushi.moe/artifact/latest.json",
|
||||
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"))
|
||||
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
If File.Exists(TargetFile) Then
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
Else
|
||||
Throw New Exception("获取 Authlib-Injector 下载信息失败", ex)
|
||||
End If
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
@@ -2415,7 +2420,12 @@ NextEntry:
|
||||
Public Function FilterUserName(Raw As String, FilterChar As Char) As String
|
||||
If Raw.Contains(":\Users\") Then
|
||||
For Each Token In RegexSearch(Raw, "(?<=:\\Users\\)[^\\]+")
|
||||
Raw = Raw.Replace("\" & Token, "\" & New String(FilterChar, Token.Count))
|
||||
Raw = Raw.Replace("\Users\" & Token, "\Users\" & New String(FilterChar, Token.Count))
|
||||
Next
|
||||
End If
|
||||
If Raw.Contains(":/Users/") Then
|
||||
For Each Token In RegexSearch(Raw, "(?<=:/Users/)[^/]+")
|
||||
Raw = Raw.Replace("/Users/" & Token, "/Users/" & New String(FilterChar, Token.Count))
|
||||
Next
|
||||
End If
|
||||
Return Raw
|
||||
|
||||
@@ -1113,8 +1113,8 @@ Finished:
|
||||
End Sub, "Mod List Detail Loader CurseForge")
|
||||
'等待线程结束
|
||||
Do Until EndedThreadCount = 2
|
||||
If Loader.IsAborted Then Return
|
||||
Thread.Sleep(10)
|
||||
If Loader.IsAborted Then Return
|
||||
Loop
|
||||
'保存缓存
|
||||
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
|
||||
@@ -1126,6 +1126,7 @@ Finished:
|
||||
Next
|
||||
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
'刷新边栏
|
||||
If Loader.IsAborted Then Return
|
||||
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
|
||||
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
|
||||
Else
|
||||
@@ -1212,7 +1213,7 @@ Finished:
|
||||
If ReqVersionHead = ReqVersionTail Then
|
||||
VersionRequire = "应为 " & ReqVersionHead
|
||||
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
|
||||
VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
|
||||
VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
|
||||
ElseIf ReqVersionHead.Contains(".") Then
|
||||
If ReqVersionHeadCanEqual Then
|
||||
VersionRequire = "最低应为 " & ReqVersionHead
|
||||
@@ -1230,7 +1231,7 @@ Finished:
|
||||
End If
|
||||
'检查前置 Mod 是否存在,并获取其版本
|
||||
If Not CurrentDependencies.ContainsKey(ReqId) Then
|
||||
Result.Add("缺少前置 Mod:" & ReqId & If(VersionRequire = "", "", ",其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
|
||||
Result.Add($"缺少前置 Mod:{ReqId}{If(VersionRequire = "", "", ",其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
|
||||
Continue For
|
||||
End If
|
||||
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
|
||||
@@ -1239,7 +1240,7 @@ Finished:
|
||||
If ReqVersionHead.Contains(".") Then
|
||||
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
|
||||
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
|
||||
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
|
||||
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
@@ -1247,26 +1248,26 @@ Finished:
|
||||
If ReqVersionTail.Contains(".") Then
|
||||
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
|
||||
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
|
||||
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
|
||||
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
|
||||
Result.Add("缺少前置 Mod:" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
|
||||
Result.Add($"缺少前置 Mod:{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Catch ex As Exception
|
||||
Result.Add("检查 Mod 时出错:" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
|
||||
Result.Add($"检查 Mod 时出错:{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
|
||||
Log(ex, "检查 Mod 时出错")
|
||||
End Try
|
||||
Next
|
||||
If Not Result.Any() Then
|
||||
Log("[Minecraft] Mod 检查未发现异常")
|
||||
Else
|
||||
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
|
||||
Log($"[Minecraft] Mod 检查异常结果:{vbCrLf}{Join(Result, vbCrLf)}")
|
||||
End If
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
@@ -72,7 +72,7 @@ Public Module ModModpack
|
||||
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
|
||||
Next
|
||||
Catch ex As Exception
|
||||
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
|
||||
If ex.GetDetail(True).Contains("Error.WinIOError") Then
|
||||
Throw New Exception("打开整合包文件失败", ex)
|
||||
ElseIf File.EndsWithF(".rar", True) Then
|
||||
Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
|
||||
@@ -166,6 +166,15 @@ Retry:
|
||||
End If
|
||||
IniClearCache(VersionIni) '重置缓存,避免被安装过程中写入的 ini 覆盖
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 弹窗提示整合包中存在不兼容的加载器。
|
||||
''' 如果取消,则抛出 CancelledException。
|
||||
''' </summary>
|
||||
''' <exception cref="CancelledException" />
|
||||
Private Sub NotifyIncompatibleLoader(LoaderName As String)
|
||||
If MyMsgBox($"整合包中存在不兼容的加载器:{LoaderName}{vbCrLf}如果你知道如何手动安装它,可以先选择跳过,然后在整合包下载结束后手动安装。",
|
||||
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
|
||||
End Sub
|
||||
|
||||
#Region "不同类型整合包的安装方法"
|
||||
|
||||
@@ -211,7 +220,8 @@ Retry:
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & Id)
|
||||
FabricVersion = Id.Replace("fabric-", "")
|
||||
Else
|
||||
Log("[ModPack] 未知 Mod 加载器:" & Id)
|
||||
'ElseIf Id.StartsWithF("quilt-") Then
|
||||
NotifyIncompatibleLoader(Id)
|
||||
End If
|
||||
Next
|
||||
'解压
|
||||
@@ -376,12 +386,9 @@ Retry:
|
||||
Case "fabric-loader" 'eg. 0.14.14
|
||||
FabricVersion = Entry.Value.ToString
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
|
||||
Case "quilt-loader" 'eg. 1.0.0
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
Case Else
|
||||
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
'Case "quilt-loader" 'eg. 1.0.0
|
||||
NotifyIncompatibleLoader(Entry.Name)
|
||||
End Select
|
||||
Next
|
||||
'获取版本名
|
||||
@@ -633,7 +640,8 @@ Retry:
|
||||
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
|
||||
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
|
||||
For Each Component In PackJson("components")
|
||||
Select Case If(Component("uid"), "").ToString
|
||||
If Not Component.Contains("uid") Then Continue For
|
||||
Select Case Component("uid").ToString
|
||||
Case "org.lwjgl"
|
||||
Log("[ModPack] 已跳过 LWJGL 项")
|
||||
Case "net.minecraft"
|
||||
@@ -644,9 +652,9 @@ Retry:
|
||||
Request.NeoForgeVersion = Component("version")
|
||||
Case "net.fabricmc.fabric-loader"
|
||||
Request.FabricVersion = Component("version")
|
||||
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
Case Else
|
||||
'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
|
||||
NotifyIncompatibleLoader(Component("uid"))
|
||||
End Select
|
||||
Next
|
||||
'构造加载器
|
||||
|
||||
@@ -397,12 +397,6 @@ EndHint:
|
||||
'下载页面声明
|
||||
Public FrmDownloadLeft As PageDownloadLeft
|
||||
Public FrmDownloadInstall As PageDownloadInstall
|
||||
Public FrmDownloadClient As PageDownloadClient
|
||||
Public FrmDownloadOptiFine As PageDownloadOptiFine
|
||||
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
|
||||
Public FrmDownloadForge As PageDownloadForge
|
||||
Public FrmDownloadNeoForge As PageDownloadNeoForge
|
||||
Public FrmDownloadFabric As PageDownloadFabric
|
||||
Public FrmDownloadMod As PageDownloadMod
|
||||
Public FrmDownloadPack As PageDownloadPack
|
||||
Public FrmDownloadDataPack As PageDownloadDataPack
|
||||
|
||||
@@ -80,15 +80,16 @@ Friend Module ModSecret
|
||||
''' <summary>
|
||||
''' 设置 Headers 的 UA、Referer。
|
||||
''' </summary>
|
||||
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
If Req.Headers.UserAgent.Any Then Return
|
||||
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
|
||||
Req.Headers.Add("User-Agent", "LogStatistic") '#4951
|
||||
ElseIf UseBrowserUserAgent Then
|
||||
ElseIf SimulateBrowserHeaders Then
|
||||
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
|
||||
Else
|
||||
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
|
||||
End If
|
||||
Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
|
||||
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
|
||||
If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
|
||||
End Sub
|
||||
|
||||
|
||||
Reference in New Issue
Block a user