InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.12.8.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+11 -10
View File
@@ -12,7 +12,7 @@ Public Module ModAnimation
''' </summary>
Public ReadOnly Property AniSpeed As Double
Get
Dim Setting As Integer = Settings.Get("SystemDebugAnim")
Dim Setting As Integer = Settings.Get(Of Integer)("SystemDebugAnim")
Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3))
End Get
End Property
@@ -114,7 +114,7 @@ Public Module ModAnimation
Public ValueLast As Object
Public Overrides Function ToString() As String
Return GetStringFromEnum(TypeMain) & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
Return TypeMain.ToString() & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
End Function
End Structure
@@ -521,13 +521,14 @@ Public Module ModAnimation
''' </summary>
''' <remarks></remarks>
Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData)
AaStack = New List(Of AniData)
Dim Result = New List(Of AniData)
Dim AniDelay As Integer = 0
For Each Item In Stack.Children
Item.Opacity = 0
AaStack.Add(AaOpacity(Item, 1, Time, AniDelay))
Result.Add(AaOpacity(Item, 1, Time, AniDelay))
AniDelay += Delay
Next
Return Result
End Function
#End Region
@@ -810,7 +811,7 @@ Public Module ModAnimation
RunInNewThread(
Sub()
Try
Log("[Animation] 动画线程开始")
Logger.Info("动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
@@ -831,7 +832,7 @@ Public Module ModAnimation
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & FormatFileSize(NetManager.Speed) & "/s）")
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{FormatFileSize(NetManager.Speed)}/s）")
End If
End Sub)
Sleeper:
@@ -839,7 +840,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", NotifyLevel.Critical)
Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
@@ -850,7 +851,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer)
Try
If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", NotifyLevel.DevelopOnly)
If DeltaTick / AniSpeed > 100 Then Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
Dim i As Integer = -1
'循环每个动画组
Do While i + 1 < AniGroups.Count
@@ -915,7 +916,7 @@ NextAni:
Loop
Catch ex As Exception
Log(ex, "动画刻执行失败", NotifyLevel.AllUsers)
Logger.Error(ex, "动画刻执行失败", LogBehavior.Toast)
End Try
End Sub
@@ -1052,7 +1053,7 @@ NextAni:
End Select
Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
Catch ex As Exception
Log(ex, "执行动画失败：" & Ani.ToString, NotifyLevel.AllUsers)
Logger.Error(ex, $"执行动画失败：{Ani}", LogBehavior.Toast)
End Try
Return Ani
End Function
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+150 -1207
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+27 -28
View File
@@ -38,7 +38,7 @@
RealParent = RealParent.Parent
End While
Catch ex As Exception
Log(ex, "获取父加载器失败（" & Name & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"获取父加载器失败（{Name}）")
Return Nothing
End Try
End Get
@@ -88,9 +88,9 @@
Set(value As LoadState)
If _State = value Then Return
Dim OldState = _State
If value = LoadState.Finished AndAlso Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value
If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变：{GetStringFromEnum(value)}")
If Not LogBlackList.Contains(Name) Then Logger.Info($"加载器 {Name} 状态改变：{value}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(
Sub()
@@ -229,13 +229,13 @@
''' <summary>
''' 用于异步执行并监控单一函数的加载器。
''' </summary>
Public Class LoaderTask(Of InputType, OutputType)
Public Class LoaderTask(Of TIn, TOut)
Inherits LoaderBase
'线程设定
Protected Friend ThreadPriority As ThreadPriority
'执行事件
Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType))
Protected Friend LoadDelegate As Action(Of LoaderTask(Of TIn, TOut))
Protected Friend InputDelegate As Func(Of Object)
'状态指示
''' <summary>
@@ -265,25 +265,25 @@
''' </summary>
Public LastRunningThread As Thread = Nothing
'输入输出
Public Input As InputType = Nothing
Public Output As OutputType = Nothing
Public Input As TIn = Nothing
Public Output As TOut = Nothing
'获取输入
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用
Public Function StartGetInput(Optional Input As TIn = Nothing, Optional InputDelegate As Func(Of TIn) = Nothing) As TIn 'InputDelegate 参数存在匿名调用
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断
Dim NewInput As TIn = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断
If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
RunInUiWait(Sub() Input = InputDelegate())
End If
Return Input
End Function
'代码执行
Public Function ShouldStart(ByRef Input As Object, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
Public Function ShouldStart(ByRef Input As TIn, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
'获取输入
Try
Input = StartGetInput(Input)
Catch ex As Exception
Log(ex, "加载输入获取失败（" & Name & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"加载输入获取失败（{Name}）", LogBehavior.Toast)
[Error] = ex
SyncLock LockState
State = LoadState.Failed
@@ -319,21 +319,21 @@
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
If Not LogBlackList.Contains(Name) Then Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsInterrupted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）", NotifyLevel.DevelopOnly)
Logger.Warn($"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
Return
End If
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
If Not LogBlackList.Contains(Name) Then Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeMs() '未中断，本次输出有效
Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsInterrupted 而提前中止，则代表已有新线程被重启，此时不应当改为 Interrupted
'如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted
If Not IsInterrupted Then State = LoadState.Interrupted
@@ -354,7 +354,7 @@
If IsInterrupted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%")
TriggerThreadInterrupt()
End Sub
Public Overrides Sub Interrupt()
@@ -368,7 +368,7 @@
If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt()
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
End If
LastRunningThread = Nothing
End Sub
@@ -376,7 +376,7 @@
Public Sub New()
'仅仅是为了避免一些智障报错（继承类必须重写 New 的情况）
End Sub
Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)), Optional InputDelegate As Func(Of InputType) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of TIn, TOut)), Optional InputDelegate As Func(Of TIn) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
Me.Name = Name
Me.LoadDelegate = LoadDelegate
Me.InputDelegate = InputDelegate
@@ -515,7 +515,7 @@
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name)
Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
GoTo Restart
End If
'更新下一个加载器的输入
@@ -527,7 +527,7 @@
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, NotifyLevel.DevelopOnly)
Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
GoTo Restart
End If
End If
@@ -598,7 +598,7 @@ Restart:
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
Logger.Info($"{Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
@@ -610,7 +610,7 @@ Restart:
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
Logger.Info($"{Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
@@ -635,7 +635,7 @@ Restart:
FrmMain.BtnExtraDownload.ShowRefresh()
End If
Catch ex As Exception
Log(ex, "刷新任务栏进度显示失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新任务栏进度显示失败")
End Try
End Sub
Public Function LoaderTaskbarProgressGet() As Double
@@ -643,7 +643,7 @@ Restart:
If Not LoaderTaskbar.Any Then Return 1
Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取任务栏进度出错")
Return 0.5
End Try
End Function
@@ -671,11 +671,10 @@ Restart:
''' </summary>
''' <param name="ExtraPath">用于检查文件夹修改的额外路径。该路径不会传入加载器。</param>
Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean
Dim FolderInfo As DirectoryInfo
Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing}
Try
'获取数据
FolderInfo = New DirectoryInfo(FolderPath & ExtraPath)
Dim FolderInfo = DirectoryUtils.GetInfo(FolderPath & ExtraPath)
Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
'如果已经检查过，则跳过
If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
@@ -687,7 +686,7 @@ Restart:
End If
End If
Catch ex As Exception
Log(ex, "文件夹加载器启动检测出错")
Logger.Warn(ex, "文件夹加载器启动检测出错")
End Try
'写入检查数据
LoaderFolderDictionary(Loader) = Value
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+113 -179
View File
@@ -1,5 +1,4 @@
Imports System.Net.Sockets
Imports System.Runtime.CompilerServices
Imports System.Threading.Tasks
Public Module ModNet
@@ -14,12 +13,12 @@ Public Module ModNet
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)
If MakeLog Then Logger.Info($"发起网络请求（{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
Dim Result = If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Dim Result = SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders).GetString(Encoding)
'检查结果是否为完整 JSON（在 #6683 中可能返回空，在被 GFW 截断时可能不完整）
'在此处检查并报错，可以让 NetRequestByClientRetry 等方法进行重试
If RequireJson Then
@@ -36,7 +35,7 @@ Public Module ModNet
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If MakeLog Then Log(ex, "网络请求失败", NotifyLevel.DevelopOnly)
If MakeLog Then Logger.Warn(ex, "网络请求失败")
Throw
End Try
End Function
@@ -72,9 +71,10 @@ Retry:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If TypeOf ex Is ResponsedWebException Then
If CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, ResponsedWebException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
If TypeOf ex Is HttpRequestCodeException Then
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
End If
'重试
Select Case RetryCount
@@ -157,8 +157,9 @@ RequestFinished:
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)
File.Delete(Temp)
Dim Result = FileUtils.ReadAsString(Temp)
FileUtils.Delete(Temp)
Return Result
Finally
NewTask.Interrupt()
End Try
@@ -173,29 +174,21 @@ RequestFinished:
''' 不建议用于下载大文件。
''' </summary>
Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False)
Log($"[Net] 通过网络请求直接下载小文件：{Url} → {LocalPath}")
'初始化文件路径
Try
DirectoryUtils.Create(LocalPath, isFilePath:=True)
File.Delete(LocalPath)
Catch ex As Exception
Throw New Exception($"预处理下载文件路径失败（{LocalPath}）", ex)
End Try
'下载
Logger.Info($"通过网络请求直接下载小文件：{Url} → {LocalPath}")
Dim RetryCount As Integer = 0
Retry:
Try
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Catch ex As ThreadInterruptedException
File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
Throw
Catch ex As Exception
File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
If RetryCount < 2 Then
RetryCount += 1
GoTo Retry
End If
Throw New WebException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
Throw New HttpRequestException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
End Try
End Sub
@@ -259,6 +252,7 @@ Retry:
HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
'发送请求
Directory.CreateDirectory(PathTemp & "Cache\Http\")
SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
@@ -283,14 +277,14 @@ Retry:
Return ResponseBytes
Else
RecordIPReliability(HostIp, -0.7)
Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes)
Throw New ResponsedWebException(
Dim ResponseMessage = ResponseBytes.GetString(Encoding)
Throw New HttpRequestCodeException(
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
End If
Catch ex As ThreadInterruptedException
Throw
Catch ex As ResponsedWebException
Catch ex As HttpRequestException
Throw
Catch ex As FileNotFoundException
'由于 CacheCow 读取缓存失败，然后系统调用不存在的 System.Net.Http.Formatting.resources 抛出（#8150）
@@ -299,7 +293,7 @@ Retry:
RecordIPReliability(HostIp, -1)
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
ElseIf ex.IsNetworkRelated Then
ElseIf ex.IsBadNetwork Then
Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
Else
Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex)
@@ -337,12 +331,12 @@ Retry:
If WaitHandle.WaitAny(New WaitHandle() {AsyncResult.AsyncWaitHandle, CancelToken.WaitHandle}) Then Throw New TimeoutException("DNS 解析超时")
Candidates = Dns.EndGetHostAddresses(AsyncResult).Distinct.ToArray
Catch ex As Exception
Log(ex, $"DNS 解析失败（{Host}）")
Logger.Warn(ex, $"DNS 解析失败（{Host}）")
DNSFailureRecord(Host) = Date.Now
Return Nothing
End Try
If Not Candidates.Any Then
Log($"[Net] DNS 解析无结果（{Host}）")
Logger.Info($"DNS 解析无结果（{Host}）")
Return Nothing
End If
'若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6）
@@ -353,7 +347,7 @@ Retry:
Dim IPv4Reliability = IPv4Targets.Max(Function(i) Reliabilities(i))
Dim IPv6Reliability = IPv6Targets.Max(Function(i) Reliabilities(i))
If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址（#6887）
If ModeDebug Then Log($"[Net] DNS IPv4/IPv6 选择（{Host}），IPv4 {IPv4Reliability:0.000}，IPv6 {IPv6Reliability:0.000}")
Logger.Trace(Function() $"DNS IPv4/IPv6 选择（{Host}），IPv4 {IPv4Reliability:0.000}，IPv6 {IPv6Reliability:0.000}")
Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets)
End If
'选择可靠度最高的 IP
@@ -379,27 +373,6 @@ Retry:
)
End Sub
''' <summary>
''' 当 HTTP 状态码不指示成功时引发的异常。
''' 附带额外属性，可用于获取远程服务器给予的回复以及 HTTP 状态码。
''' </summary>
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' HTTP 状态码。
''' </summary>
Public StatusCode As HttpStatusCode
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
Public Overloads Property Response As String
Public Sub New(Message As String, StatusCode As HttpStatusCode, Response As String)
MyBase.New(Message)
Me.StatusCode = StatusCode
Me.Response = Response
End Sub
End Class
#End Region
#Region "多线程下载引擎"
@@ -413,7 +386,7 @@ Retry:
''' </summary>
Public ReadOnly Property NetTaskThreadLimit As Integer
Get
Return Settings.Get("ToolDownloadThread") + 1
Return Settings.Get(Of Integer)("ToolDownloadThread") + 1
End Get
End Property
''' <summary>
@@ -426,7 +399,7 @@ Retry:
Public ReadOnly Property NetTaskSpeedLimitHigh As Long
Get
If _NetTaskSpeedLimitHigh Is Nothing Then
Dim Setting As Integer = Settings.Get("ToolDownloadSpeed")
Dim Setting As Integer = Settings.Get(Of Integer)("ToolDownloadSpeed")
If Setting <= 14 Then
_NetTaskSpeedLimitHigh = (Setting + 1) * 0.1 * 1024 * 1024L
ElseIf Setting <= 31 Then
@@ -822,7 +795,7 @@ Retry:
Private _Speed As Long = 0
''' <summary>
''' 该文件是否由本地文件直接拷贝完成。
''' 该文件是否由本地文件直接复制完成。
''' </summary>
Public IsCopy As Boolean = False
''' <summary>
@@ -901,7 +874,7 @@ Retry:
Me.LocalPath = LocalPath
Me.Check = Checker
Me.SimulateBrowserHeaders = SimulateBrowserHeaders
Me.LocalName = GetFileNameFromPath(LocalPath)
Me.LocalName = PathUtils.GetLastPart(LocalPath)
End Sub
''' <summary>
@@ -1003,7 +976,7 @@ StartThread:
''' 每个下载线程执行的代码。
''' </summary>
Private Sub Thread(Th As NetThread)
If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}")
Logger.Log($"{LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}", If(Th.DownloadStart = 0, LogLevel.Info, LogLevel.Trace))
Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing,
Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing,
CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
@@ -1021,22 +994,24 @@ StartThread:
If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New Headers.RangeHeaderValue(Th.DownloadStart, Nothing)
Dim ContentLength As Long = 0
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}") '状态码检查
If Not Response.IsSuccessStatusCode Then '状态码检查
Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}", Response.StatusCode, Nothing)
End If
If State = NetState.Interrupted Then GoTo SourceBreak '快速中断
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
If Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Logger.Trace(Function() $"{LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
'文件大小校验
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
If ContentLength < 0 Then
If FileSize > 1 Then
If Th.DownloadStart = 0 Then
Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
Logger.Info($"{LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
Else
Log($"[Download] {LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
Logger.Info($"{LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
GoTo NotSupportRange
End If
Else
FileSize = -1 : IsUnknownSize = True
Log($"[Download] {LocalName}：文件大小未知")
Logger.Info($"{LocalName}：文件大小未知")
End If
ElseIf Th.IsFirstThread Then
If Check IsNot Nothing Then
@@ -1048,7 +1023,7 @@ StartThread:
End If
End If
FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
'若文件大小大于 50 M，进行剩余磁盘空间校验
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
@@ -1084,17 +1059,16 @@ NotSupportRange:
ResultStream = Cache
Else
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
DirectoryUtils.Create(Th.Temp, isFilePath:=True)
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
ResultStream = FileUtils.CreateAsStream(Th.Temp)
End If
'开始下载
CancelToken.Dispose() : CancelToken = New CancellationTokenSource() '重置超时，不再让 CancellationToken 在固定时间后触发（#8488）
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
If Settings.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merging AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
HttpDataCount > 0 AndAlso Not IsProgramEnding AndAlso State < NetState.Merging AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
'限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16)
@@ -1140,19 +1114,22 @@ SourceBreak:
If State = NetState.Interrupted OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断
Th.State = NetState.Interrupted
Log($"[Download] {LocalName}：中断")
Logger.Info($"{LocalName}：中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Th.DownloadDone}（全文件总数据量 {DownloadDone}）")
Else
'本线程完成
Th.State = NetState.Finished
If ModeDebug Then Log($"[Download] {LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）")
Logger.Trace(Function() $"{LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）")
RecordIPReliability(HostIp, 0.5)
End If
Catch ex As Exception
Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException,
$"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}")
If ex.IsBadNetwork OrElse TypeOf ex Is TaskCanceledException Then
Logger.Info(New TimeoutException($"{LocalName}：超时（{Timeout}ms），{ex.Message}，IP：{If(String.IsNullOrEmpty(HostIp), "自动", "")}"))
Else
Logger.Info(ex, $"{LocalName}：出错，IP：{HostIp}")
End If
RecordIPReliability(HostIp, -0.7)
SourceFail(Th, ex, False)
Finally
@@ -1194,9 +1171,8 @@ SourceBreak:
End SyncLock
'……后续处理
If IsThisFail Then
Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用",
If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), NotifyLevel.DevelopOnly, NotifyLevel.DebugModeOnly))
Logger.Info($"{LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
Logger.Warn(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用")
SyncLock LockSource
SourcesOnce.Remove(Th.Source)
End SyncLock
@@ -1208,7 +1184,7 @@ SourceBreak:
ElseIf Not Retried Then
'合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载
'若所有源均不支持 Range，也会走到这里重试
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}：文件下载失败，正在自动重试……", NotifyLevel.DebugModeOnly)
If Not IsRangeNotSupported Then Logger.Warn($"{LocalName}：文件下载失败，正在自动重试……")
Retried = True
SyncLock LockSource
SourcesOnce.Clear()
@@ -1229,14 +1205,14 @@ SourceBreak:
End SyncLock
Else
'失败
Log($"[Download] {LocalName}：已无可用下载源，下载失败")
Logger.Info($"{LocalName}：已无可用下载源，下载失败")
Dim ExampleEx As Exception = Nothing
SyncLock LockSource
For Each Source As NetSource In Sources
Log("[Download] 已禁用的下载源：" & Source.Url)
Logger.Info($"已禁用的下载源：{Source.Url}")
If Source.Ex IsNot Nothing Then
ExampleEx = Source.Ex
Log(Source.Ex, "下载源禁用原因", NotifyLevel.DevelopOnly)
Logger.Warn(Source.Ex, "下载源禁用原因")
End If
Next
End SyncLock
@@ -1276,26 +1252,26 @@ SourceBreak:
Try
Retry:
'创建文件夹
DirectoryUtils.Create(LocalPath, isFilePath:=True)
If File.Exists(LocalPath) Then File.Delete(LocalPath)
DirectoryUtils.Create(PathUtils.RemoveLastPart(LocalPath))
FileUtils.Delete(LocalPath)
SyncLock LockChain
'合并文件
If IsNoSplit Then
'仅有一个线程，从内存中输出
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从内存输出文件")
Logger.Trace(Function() $"{LocalName}：下载结束，从内存输出文件")
FileUtils.Write(LocalPath, Cache)
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件，直接复制
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，仅有一个文件，无需合并")
CopyFile(Threads.Temp, LocalPath)
Logger.Trace(Function() $"{LocalName}：下载结束，仅有一个文件，无需合并")
FileUtils.Copy(Threads.Temp, LocalPath)
Else
'有多个线程，合并
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，开始合并文件")
Using MergeFile As New FileStream(LocalPath, FileMode.Create)
Logger.Trace(Function() $"{LocalName}：下载结束，开始合并文件")
Using MergeFile = FileUtils.CreateAsStream(LocalPath)
Using AddWriter As New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
Using fs = FileUtils.ReadAsStream(Thread.Temp)
Using TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
End Using
@@ -1314,16 +1290,16 @@ Retry:
End If
End If
If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 文件校验失败，下载线程细节：")
Logger.Info($"{LocalName} 文件校验失败，下载线程细节：")
For Each T As NetThread In Threads
Log($"[Download] - {T.Uuid}#，状态 {GetStringFromEnum(T.State)}，范围 {T.DownloadStart}~{T.DownloadEnd}，已下载 {T.DownloadDone}，未下载 {T.DownloadUndone}")
Logger.Info($"- {T.Uuid}#，状态 {T.State}，范围 {T.DownloadStart}~{T.DownloadEnd}，已下载 {T.DownloadDone}，未下载 {T.DownloadUndone}")
Next
Throw New Exception(CheckResult)
End If
'后处理
If Not IsNoSplit Then
For Each Thread As NetThread In Threads
If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp)
If Thread.Temp IsNot Nothing Then FileUtils.Delete(Thread.Temp)
Next
End If
Finish()
@@ -1331,7 +1307,7 @@ Retry:
Catch ex As Exception
RetryCount += 1
If State > NetState.Merging Then Return '通常是因为在合并时被中断了
Log(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
Logger.Warn(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
'重新尝试合并
If RetryCount < 3 Then
Threading.Thread.Sleep(500 * RetryCount)
@@ -1339,9 +1315,9 @@ Retry:
End If
'失败，禁用当前下载源并重启下载
Try
If File.Exists(LocalPath) Then File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
Catch exx As Exception
Log(ex, $"删除合并失败的文件出错（{LocalPath}）")
Logger.Warn(ex, $"删除合并失败的文件出错（{LocalPath}）")
End Try
SourceFail(Th, ex, True)
Finally
@@ -1356,7 +1332,7 @@ Retry:
If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
Log($"[Download] {LocalName}：已失败，当前状态 {State}")
Logger.Info($"{LocalName}：已失败，当前状态 {State}")
State = NetState.Interrupted
End SyncLock
InterruptInternal()
@@ -1374,7 +1350,7 @@ Retry:
'确认中断
SyncLock LockState
If State >= NetState.Finished Then Return
Log($"[Download] {LocalName}：已中断，当前状态 {State}")
Logger.Info($"{LocalName}：已中断，当前状态 {State}")
State = NetState.Interrupted
End SyncLock
InterruptInternal()
@@ -1395,7 +1371,7 @@ Retry:
State = NetState.Finished
End SyncLock
Interlocked.Decrement(NetManager.FileRemain)
If PrintLog Then Log($"[Download] {LocalName}：已完成")
If PrintLog Then Logger.Info($"{LocalName}：已完成")
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
@@ -1403,7 +1379,7 @@ Retry:
End Class
Private Class RangeNotSupportedException
Inherits WebException
Inherits HttpRequestException
Public Sub New(Message As String)
MyBase.New(Message)
End Sub
@@ -1451,7 +1427,7 @@ Retry:
Set(value As Integer)
_FailCount = value
If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
Log("[Download] 由于同加载器中失败次数过多引发强制失败：连续失败了 " & value & " 次", NotifyLevel.DebugModeOnly)
Logger.Warn($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次")
On Error Resume Next
Dim ExList As New List(Of Exception)
For Each File In Files
@@ -1492,7 +1468,7 @@ FinishExCatch:
_Progress = NewProgress
End Sub
Public Sub New(Name As String, FileTasks As List(Of NetFile))
Public Sub New(Name As String, FileTasks As IEnumerable(Of NetFile))
Me.Name = Name
Files = New ConcurrentList(Of NetFile)(FileTasks)
End Sub
@@ -1526,7 +1502,7 @@ FinishExCatch:
File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.Lower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确：" & File.LocalPath)
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath)
DirectoryUtils.Create(File.LocalPath, isFilePath:=True) '创建目标文件夹
DirectoryUtils.Create(PathUtils.RemoveLastPart(File.LocalPath)) '创建目标文件夹
Next
'接入下载管理器，获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me)
@@ -1552,7 +1528,7 @@ FinishExCatch:
Dim Folders As New List(Of String)
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
Folders.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) Directory.Exists(f)).ToList
Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList
'平均分配到多个检查线程
Dim ThreadCount As Integer = (FilesToCheck.Count \ 40).Clamp(1, 8) '每个线程至少 40 个文件，最多 8 线程
If ThreadCount = 1 Then '只有一个线程，直接执行
@@ -1575,43 +1551,27 @@ FinishExCatch:
End Sub
Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log($"[Download] 文件检查开始，本线程负责的文件数：{Files.Count}")
Logger.Trace(Function() $"文件检查开始，本线程负责 {Files.Count} 个文件，首个文件为 {Files.FirstOrDefault?.LocalName}")
'列出 MC 文件夹中的各个版本文件夹
Dim VersionFolders As New List(Of String)
For Each McFolder In FolderList
Dim VersionsFolder As New DirectoryInfo(McFolder & "versions\")
If VersionsFolder.Exists() Then
For Each VersionFolder In VersionsFolder.GetDirectories
VersionFolders.Add(VersionFolder.FullName & "\")
Next
End If
For Each VersionFolder In DirectoryUtils.GetDirectories(McFolder & "versions\", True)
VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
Next
Next
'处理每个文件
For Each File As NetFile In Files
Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
If ModeDebug Then Log($"[Download] 文件检查结果：{File.LocalName} → {Target}，当前状态 {File.State}")
Logger.Trace(Function() $"本地文件匹配：{File.LocalName} → {If(Target, "无匹配")}，当前状态 {File.State}")
If File.State >= NetState.WaitingToDownload Then Continue For '中断
'已找到相同文件
If Target IsNot Nothing Then
File.IsCopy = True
Dim RetryCount As Integer = 0
Retry:
Try
If Target <> File.LocalPath Then
Log($"[Download] 复制已存在的文件：{Target} → {File.LocalPath}")
CopyFile(Target, File.LocalPath)
Else
If ModeDebug Then Log($"[Download] 需要下载的文件已存在，并通过校验：{Target}")
End If
FileUtils.Copy(Target, File.LocalPath)
File.Finish(False)
Continue For
Catch ex As Exception
RetryCount += 1
Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
If RetryCount < 3 Then
Thread.Sleep(2000)
GoTo Retry
End If
Catch
End Try
End If
'回退到下载
@@ -1628,7 +1588,7 @@ Retry:
'目标文件已存在
If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath
'在设置中禁用了复制
If Settings.Get("SystemDebugSkipCopy") Then Return Nothing
If Settings.Get(Of Boolean)("SystemDebugSkipCopy") Then Return Nothing
'没有可用的检查规则，只能开始下载
If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing
'大致判断文件类别
@@ -1646,37 +1606,35 @@ Retry:
Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找
Static Sizes As New ConcurrentDictionary(Of String, Long)
Static CheckCandidate As Func(Of String, FileChecker, Boolean) =
Function(Candidate, Checker)
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) If(FileUtils.Exists(c), FileUtils.GetInfo(c).Length, -1))
If Checker.ActualSize <> Length Then Return False
'进一步进行 Hash 校验
Return Checker.Check(Candidate) Is Nothing
End Function
Select Case Type
Case "assets\", "libraries\"
'assets/libraries：查找 MC 文件夹下的相同路径
For Each Folder In FolderList
Dim Candidate = Folder & Type & File.LocalPath.AfterFirst(Type)
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Return Nothing
Case "versions\"
'版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").Lower, SearchOption.TopDirectoryOnly)
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
For Each Candidate In DirectoryUtils.GetFiles(VersionFolder, True, "*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
Case Else
'社区资源
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
For Each Folder In FolderList.Concat(VersionFolders)
Dim TargetFolder = Folder & Type
If Not Directory.Exists(TargetFolder) Then Continue For
For Each Candidate In Directory.GetFiles(TargetFolder)
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
For Each Candidate In DirectoryUtils.GetFiles(Folder & Type, True)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
End Select
@@ -1719,7 +1677,7 @@ Retry:
For Each File In Files
If File.State <> NetState.Interrupted Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}（{s.Url}）").Join(vbCrLf)
Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetDisplay(False))}（{s.Url}）").Join(vbCrLf)
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf &
"各下载源的错误如下：" & vbCrLf & Detail, [Error])
'上报
@@ -1736,18 +1694,14 @@ Retry:
TaskFile.Interrupt(Me)
Next
'在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList
ErrOutput.Add(Ex.GetDetail())
Next
Log("[Download] " & ErrOutput.Distinct.Join(vbCrLf))
Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
End Sub
Public Overrides Sub Interrupt()
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Interrupted
End SyncLock
Log("[Download] " & Name & " 已取消！")
Logger.Info($"{Name} 已取消！")
'中断所有文件
For Each TaskFile In Files
TaskFile.Interrupt(Me)
@@ -1823,7 +1777,7 @@ Retry:
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & FormatFileSize(Limit))
Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}")
End If
#End Region
#Region "刷新下载任务属性"
@@ -1832,7 +1786,7 @@ Retry:
Next
#End Region
Catch ex As Exception
Log(ex, "刷新下载公开属性失败")
Logger.Warn(ex, "刷新下载公开属性失败")
End Try
End Sub
Private RefreshStatLast As Long
@@ -1889,7 +1843,7 @@ Retry:
Next
End While
Catch ex As Exception
Log(ex, $"下载管理启动线程 {Id} 出错", NotifyLevel.Critical)
Logger.Error(ex, $"下载管理启动线程 {Id} 出错", LogBehavior.AlertThenCrash)
End Try
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
@@ -1913,7 +1867,7 @@ Retry:
End If
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", NotifyLevel.Critical)
Logger.Error(ex, "下载管理刷新线程出错", LogBehavior.AlertThenCrash)
End Try
End Sub, "NetManager StatRefresher")
End Sub
@@ -1929,11 +1883,11 @@ Retry:
SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
If Not IsDownloadCacheCleared Then
Try
Log("[Net] 开始清理下载缓存")
DeleteDirectory(PathTemp & "Download")
Log("[Net] 下载缓存已清理")
Logger.Info("开始清理下载缓存")
DirectoryUtils.Delete(PathTemp & "Download")
Logger.Info("下载缓存已清理")
Catch ex As Exception
Log(ex, "清理下载缓存失败")
Logger.Warn(ex, "清理下载缓存失败")
End Try
IsDownloadCacheCleared = True
End If
@@ -1945,12 +1899,12 @@ Retry:
Dim OngoingFile As NetFile = Nothing
If AllFiles.TryGetValue(File.LocalPath, OngoingFile) AndAlso OngoingFile.State < NetState.Finished Then
'该文件正在被另一个任务下载
If ModeDebug Then Log($"[Download] {File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
Logger.Trace(Function() $"{File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
File = OngoingFile '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象
Task.Files(i) = File
Else
'常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
If ModeDebug Then Log($"[Download] {File.LocalName}：开始，目标 {File.LocalPath}")
Logger.Trace(Function() $"{File.LocalName}：开始，目标 {File.LocalPath}")
AllFiles(File.LocalPath) = File
NewFiles.Add(File)
Interlocked.Increment(FileRemain)
@@ -2021,38 +1975,18 @@ Retry:
Try
PingResult = (New NetworkInformation.Ping).Send(Ip)
Catch ex As Exception
If MakeLog Then Log("[Net] Ping " & Ip & " 失败：" & ex.Message)
If MakeLog Then Logger.Info($"Ping {Ip} 失败：{ex.Message}")
Return -1
End Try
If PingResult.Status = NetworkInformation.IPStatus.Success Then
If MakeLog Then Log("[Net] Ping " & Ip & " 结束：" & PingResult.RoundtripTime & "ms")
If MakeLog Then Logger.Info($"Ping {Ip} 结束：{PingResult.RoundtripTime}ms")
Return PingResult.RoundtripTime
Else
If MakeLog Then Log("[Net] Ping " & Ip & " 失败")
If MakeLog Then Logger.Info($"Ping {Ip} 失败")
Return -1
End If
End Function
''' <summary>
''' 判断某个 Exception 是否为网络问题所导致。
''' </summary>
<Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
'提取 Message（不能用 GetDetail，因为堆栈的方法参数中就有 timeout 字样）
Dim Detail As String = ""
Dim InnerEx As Exception = Ex
Detail += InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Detail += InnerEx.Message
Loop
'判断
If Detail.Contains("(403)") Then Return False
Return {
"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
"由于目标计算机积极拒绝", "基础连接已经关闭"
}.Any(Function(k) Detail.ContainsIgnoreCase(k))
End Function
''' <summary>
''' 设置是否应当在正版登录时校验 SSL 证书。
''' </summary>
@@ -2062,7 +1996,7 @@ Retry:
Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest)
If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证
'基于 #3018 和 #5879，只在访问正版登录 API 时跳过证书验证
Log($"[System] 未通过 SSL 证书验证（{Failure}），提供的证书为 {Certificate?.Subject}，URL：{Request?.Address}", NotifyLevel.DebugModeOnly)
Logger.Warn($"未通过 SSL 证书验证（{Failure}），提供的证书为 {Certificate?.Subject}，URL：{Request?.Address}")
If Request Is Nothing Then
Return Not Enabled
ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+16 -15
View File
@@ -80,7 +80,7 @@ Public Class ValidateRegex
Me.ErrorDescription = ErrorDescription
End Sub
Public Overrides Function Validate(Str As String) As String
If Not RegexCheck(Str, Regex) Then Return ErrorDescription
If Not Str.RegexCheck(Regex) Then Return ErrorDescription
Return ""
End Function
End Class
@@ -94,7 +94,7 @@ Public Class ValidateHttp
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效！"
If Not Str.RegexCheck("^(http[s]?)\://") Then Return "输入的网址无效！"
Return ""
End Function
End Class
@@ -247,7 +247,7 @@ Public Class ValidateFolderName
Public Property Folder As String
Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
Private ReadOnly PathIgnore As IEnumerable(Of String)
Public Sub New()
End Sub
Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
@@ -255,7 +255,7 @@ Public Class ValidateFolderName
Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next
PathIgnore = New DirectoryInfo(Folder).EnumerateDirectories
PathIgnore = DirectoryUtils.GetDirectories(Folder, True)
End Sub
Public Overrides Function Validate(Str As String) As String
Try
@@ -277,19 +277,19 @@ Public Class ValidateFolderName
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str)
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
'检查文件夹重名
Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then
For Each Folder As DirectoryInfo In PathIgnore
Arr.Add(Folder.Name)
For Each FolderPath In PathIgnore
Arr.Add(PathUtils.GetLastPart(FolderPath))
Next
End If
Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
If Not SameNameCheck = "" Then Return SameNameCheck
Return ""
Catch ex As Exception
Log(ex, "检查文件夹名出错")
Logger.Warn(ex, "检查文件夹名出错")
Return "错误：" & ex.Message
End Try
End Function
@@ -332,10 +332,10 @@ Public Class ValidateFileName
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %！", True).Validate(Str)
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
If Str.RegexCheck(".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
Dim DirInfo = DirectoryUtils.GetInfo(ParentFolder)
If DirInfo.Exists Then
Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
"不可与现有文件重名！", IgnoreCase).Validate(Str)
@@ -346,7 +346,7 @@ Public Class ValidateFileName
End If
Return ""
Catch ex As Exception
Log(ex, "检查文件名出错")
Logger.Warn(ex, "检查文件名出错")
Return "错误：" & ex.Message
End Try
End Function
@@ -375,9 +375,10 @@ Public Class ValidateFolderPath
If LengthCheck <> "" Then Return LengthCheck
'检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.Upper = Drive.Name Then Return ""
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
Dim DriveName As String = Drive.Upper.First & ":\"
If Str.Upper = DriveName Then Return ""
If Str.StartsWithF(DriveName, True) Then GoTo Fin
Next
Return "文件夹路径头存在错误！"
Fin:
@@ -399,7 +400,7 @@ Fin:
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
Next
Return ""
End Function
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+3 -3
View File
@@ -72,7 +72,7 @@ Public Class MyBitmap
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
Using InputStream = FileUtils.ReadAsStream(FilePathOrResourceName)
'判断是否为 WebP 文件头
Dim Header(1) As Byte
InputStream.Read(Header, 0, 2)
@@ -97,7 +97,7 @@ Public Class MyBitmap
Throw New Exception($"加载 MyBitmap 意外失败（{FilePathOrResourceName}）", ex)
End If
Else
Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）")
Exit Try
End If
End Try
@@ -162,7 +162,7 @@ Public Class MyBitmap
Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream As New FileStream(FilePath, FileMode.Create)
Using fileStream = FileUtils.CreateAsStream(FilePath)
encoder.Save(fileStream)
End Using
End Sub
Plain Craft Launcher 2/Modules/Base/PclLogger.vb
+54
View File
@@ -0,0 +1,54 @@
Public Class PclLogger
Inherits FileLogger
''' <inheritdoc/>
Public Overrides Function Format(Text As String, Level As LogLevel, FilePath As String, Ex As Exception) As String
Text = MyBase.Format(Text, Level, FilePath, Ex)
Text = FilterUserName(FilterAccessToken(Text, "*"c), "*"c)
Return Text
End Function
''' <inheritdoc/>
Public Overrides Sub HandleBehavior(RawMessage As String, FormattedMessage As String, Behavior As LogBehavior, Ex As Exception)
If IsProgramEnding Then Return
MyBase.HandleBehavior(RawMessage, FormattedMessage, Behavior, Ex)
Dim BriefText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(False))
BriefText = FilterUserName(FilterAccessToken(BriefText, "*"c), "*"c)
Dim DetailText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(True))
DetailText = FilterUserName(FilterAccessToken(DetailText, "*"c), "*"c)
Select Case Behavior
Case LogBehavior.None
'啥也不干
Case LogBehavior.ToastIfDebug
If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & BriefText, HintType.Blue, False)
Case LogBehavior.Toast
Hint(BriefText, HintType.Red, False)
Case LogBehavior.Alert
MyMsgBox(DetailText, "错误", IsWarn:=True)
Case LogBehavior.AlertThenFeedback
If PageSetupSystem.IsLauncherNewest Then
If MyMsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", "错误", "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
Else
MyMsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", "错误", IsWarn:=True)
End If
Case LogBehavior.AlertThenCrash
Static FirstTrigger As Boolean = True
If FirstTrigger Then
'首次触发
FirstTrigger = False
If PageSetupSystem.IsLauncherNewest Then
If MsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, "错误") = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, "错误")
End If
Else
'多次触发，直接使程序崩溃（这通常代表着在其他线程循环触发严重异常）
Thread.Sleep(2000)
End If
FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Select
'遥测
If Behavior >= LogBehavior.Toast Then Telemetry("错误日志", "Exception", DetailText)
End Sub
End Class