2.6.15
This commit is contained in:
龙腾猫跃
@@ -10,6 +10,17 @@ Public Class FormMain
|
||||
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
|
||||
'统计更新日志条目
|
||||
#If BETA Then
|
||||
If LastVersion < 317 Then 'Release 2.6.15
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
|
||||
FeatureCount += 2
|
||||
BugCount += 2
|
||||
End If
|
||||
If LastVersion < 315 Then 'Release 2.6.14
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载，尝试解决各种导致 MC 下载失败的问题"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容"))
|
||||
FeatureCount += 17
|
||||
BugCount += 16
|
||||
End If
|
||||
If LastVersion < 313 Then 'Release 2.6.13
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
|
||||
FeatureCount += 6
|
||||
@@ -129,6 +140,11 @@ Public Class FormMain
|
||||
'3：BUG+ IMP* FEAT-
|
||||
'2：BUG* IMP-
|
||||
'1：BUG-
|
||||
If LastVersion < 316 Then 'Snapshot 2.6.15
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
|
||||
FeatureCount += 2
|
||||
BugCount += 2
|
||||
End If
|
||||
If LastVersion < 314 Then 'Snapshot 2.6.14
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载，尝试解决各种导致 MC 下载失败的问题"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容"))
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 715 B |
@@ -11,12 +11,12 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.6.14" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.6.14." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 313 'Release
|
||||
Public Const VersionCode As Integer = 317 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 314 'Snapshot
|
||||
Public Const VersionCode As Integer = 316 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
|
||||
@@ -28,7 +28,7 @@ Public Module ModNet
|
||||
''' </summary>
|
||||
''' <param name="Url">网页的 Url。</param>
|
||||
''' <param name="Encoding">网页的编码，通常为 UTF-8。</param>
|
||||
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01") As String
|
||||
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01", Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Dim RetryCount As Integer = 0
|
||||
Dim RetryException As Exception = Nothing
|
||||
Dim StartTime As Long = GetTimeTick()
|
||||
@@ -36,15 +36,15 @@ Public Module ModNet
|
||||
Retry:
|
||||
Select Case RetryCount
|
||||
Case 0 '正常尝试
|
||||
Return NetGetCodeByClient(Url, Encoding, 10000, Accept)
|
||||
Return NetGetCodeByClient(Url, Encoding, 10000, Accept, UseBrowserUserAgent)
|
||||
Case 1 '慢速重试
|
||||
Thread.Sleep(500)
|
||||
Return NetGetCodeByClient(Url, Encoding, 30000, Accept)
|
||||
Return NetGetCodeByClient(Url, Encoding, 30000, Accept, UseBrowserUserAgent)
|
||||
Case Else '快速重试
|
||||
If GetTimeTick() - StartTime > 5500 Then
|
||||
'若前两次加载耗费 5 秒以上，才进行重试
|
||||
Thread.Sleep(500)
|
||||
Return NetGetCodeByClient(Url, Encoding, 4000, Accept)
|
||||
Return NetGetCodeByClient(Url, Encoding, 4000, Accept, UseBrowserUserAgent)
|
||||
Else
|
||||
Throw RetryException
|
||||
End If
|
||||
@@ -63,7 +63,7 @@ Retry:
|
||||
End Select
|
||||
End Try
|
||||
End Function
|
||||
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String) As String
|
||||
Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Url = SecretCdnSign(Url)
|
||||
Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout)
|
||||
Dim Request As CookieWebClient
|
||||
@@ -77,7 +77,7 @@ Retry:
|
||||
Request.Headers("Accept") = Accept
|
||||
Request.Headers("Accept-Language") = "en-US,en;q=0.5"
|
||||
Request.Headers("X-Requested-With") = "XMLHttpRequest"
|
||||
SecretHeadersSign(Url, Request)
|
||||
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
|
||||
Return Request.DownloadString(Url)
|
||||
Catch ex As Exception
|
||||
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
|
||||
@@ -98,7 +98,7 @@ Retry:
|
||||
''' <param name="Encode">网页的编码，通常为 UTF-8。</param>
|
||||
''' <param name="BackupUrl">如果第一次尝试失败，换用的备用 URL。</param>
|
||||
Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "",
|
||||
Optional IsJson As Boolean = False, Optional BackupUrl As String = Nothing)
|
||||
Optional IsJson As Boolean = False, Optional BackupUrl As String = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Dim RetryCount As Integer = 0
|
||||
Dim RetryException As Exception = Nothing
|
||||
Dim StartTime As Long = GetTimeTick()
|
||||
@@ -106,15 +106,15 @@ Retry:
|
||||
Retry:
|
||||
Select Case RetryCount
|
||||
Case 0 '正常尝试
|
||||
Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept)
|
||||
Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept, UseBrowserUserAgent)
|
||||
Case 1 '慢速重试
|
||||
Thread.Sleep(500)
|
||||
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
|
||||
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept, UseBrowserUserAgent)
|
||||
Case Else '快速重试
|
||||
If GetTimeTick() - StartTime > 5500 Then
|
||||
'若前两次加载耗费 5 秒以上，才进行重试
|
||||
Thread.Sleep(500)
|
||||
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
|
||||
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept, UseBrowserUserAgent)
|
||||
Else
|
||||
Throw RetryException
|
||||
End If
|
||||
@@ -140,7 +140,7 @@ Retry:
|
||||
''' </summary>
|
||||
''' <param name="Url">网页的 Url。</param>
|
||||
''' <param name="Encode">网页的编码，通常为 UTF-8。</param>
|
||||
Public Function NetGetCodeByRequestMuity(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
|
||||
Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
|
||||
Dim Threads As New List(Of Thread)
|
||||
Dim RequestResult = Nothing
|
||||
Dim RequestEx As Exception = Nothing
|
||||
@@ -182,7 +182,7 @@ RequestFinished:
|
||||
Loop
|
||||
Throw New Exception("未知错误")
|
||||
End Function
|
||||
Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "")
|
||||
Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "", Optional UseBrowserUserAgent As Boolean = False)
|
||||
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
||||
Url = SecretCdnSign(Url)
|
||||
Log($"[Net] 获取网络结果：{Url}，超时 {Timeout}ms{If(IsJson, "，要求 json", "")}")
|
||||
@@ -192,7 +192,7 @@ RequestFinished:
|
||||
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
|
||||
Request.Timeout = Timeout
|
||||
Request.Accept = Accept
|
||||
SecretHeadersSign(Url, Request)
|
||||
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
|
||||
Using res As HttpWebResponse = Request.GetResponse()
|
||||
Using HttpStream As Stream = res.GetResponseStream()
|
||||
HttpStream.ReadTimeout = Timeout
|
||||
@@ -220,9 +220,9 @@ RequestFinished:
|
||||
''' 以多线程下载网页文件的方式获取网页源代码。
|
||||
''' </summary>
|
||||
''' <param name="Url">网页的 Url。</param>
|
||||
Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
|
||||
Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson})})
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
|
||||
Try
|
||||
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）")
|
||||
NetGetCodeByDownload = ReadFile(Temp)
|
||||
@@ -235,9 +235,9 @@ RequestFinished:
|
||||
''' 以多线程下载网页文件的方式获取网页源代码。
|
||||
''' </summary>
|
||||
''' <param name="Urls">网页的 Url 列表。</param>
|
||||
Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
|
||||
Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson})})
|
||||
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
|
||||
Try
|
||||
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls(0) & "）")
|
||||
NetGetCodeByDownload = ReadFile(Temp)
|
||||
@@ -252,7 +252,7 @@ RequestFinished:
|
||||
''' </summary>
|
||||
''' <param name="Url">网络 Url。</param>
|
||||
''' <param name="LocalFile">下载的本地地址。</param>
|
||||
Public Sub NetDownload(Url As String, LocalFile As String)
|
||||
Public Sub NetDownload(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Log("[Net] 直接下载文件：" & Url)
|
||||
|
||||
'初始化
|
||||
@@ -268,7 +268,11 @@ RequestFinished:
|
||||
'下载
|
||||
Using Client As New WebClient
|
||||
Try
|
||||
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
|
||||
If UseBrowserUserAgent Then
|
||||
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
|
||||
Else
|
||||
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode
|
||||
End If
|
||||
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
|
||||
Client.DownloadFile(Url, LocalFile)
|
||||
Catch ex As Exception
|
||||
@@ -369,7 +373,7 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 发送一次网络请求并获取返回内容。
|
||||
''' </summary>
|
||||
Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) As String
|
||||
Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True, Optional UseBrowserUserAgent As Boolean = False) As String
|
||||
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
|
||||
Url = SecretCdnSign(Url)
|
||||
If MakeLog Then Log("[Net] 发起网络请求（" & Method & "，" & Url & "），最大超时 " & Timeout)
|
||||
@@ -392,7 +396,7 @@ RequestFinished:
|
||||
End If
|
||||
Req.ContentType = ContentType
|
||||
Req.Timeout = Timeout
|
||||
SecretHeadersSign(Url, Req)
|
||||
SecretHeadersSign(Url, Req, UseBrowserUserAgent)
|
||||
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
|
||||
If Method = "POST" OrElse Method = "PUT" Then
|
||||
Req.ContentLength = SendData.Length
|
||||
@@ -790,6 +794,10 @@ RequestFinished:
|
||||
''' 文件的校验规则。
|
||||
''' </summary>
|
||||
Public Check As FileChecker
|
||||
''' <summary>
|
||||
''' 下载时是否添加浏览器 UA。
|
||||
''' </summary>
|
||||
Public UseBrowserUserAgent As Boolean
|
||||
|
||||
''' <summary>
|
||||
''' 上次记速时的时间。
|
||||
@@ -889,7 +897,7 @@ RequestFinished:
|
||||
''' 新建一个需要下载的文件。
|
||||
''' </summary>
|
||||
''' <param name="LocalPath">包含文件名的本地地址。</param>
|
||||
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing)
|
||||
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
|
||||
Dim Sources As New List(Of NetSource)
|
||||
Dim Count As Integer = 0
|
||||
Urls = Urls.Distinct.ToArray
|
||||
@@ -900,6 +908,7 @@ RequestFinished:
|
||||
Me.Sources = Sources.ToArray
|
||||
Me.LocalPath = LocalPath
|
||||
Me.Check = Check
|
||||
Me.UseBrowserUserAgent = UseBrowserUserAgent
|
||||
Me.LocalName = GetFileNameFromPath(LocalPath)
|
||||
End Sub
|
||||
|
||||
@@ -1030,7 +1039,7 @@ StartThread:
|
||||
'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
|
||||
HttpRequest.Timeout = Timeout
|
||||
HttpRequest.AddRange(Info.DownloadStart)
|
||||
SecretHeadersSign(Info.Source.Url, HttpRequest)
|
||||
SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
|
||||
Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
|
||||
'文件大小校验
|
||||
Dim ThreadFileSize = HttpResponse.ContentLength
|
||||
@@ -1909,84 +1918,86 @@ Retry:
|
||||
Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "NetManager ThreadStarter Single")
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Dim LastLoopTime As Long
|
||||
While True
|
||||
LastLoopTime = GetTimeTick()
|
||||
'开启新线程
|
||||
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
|
||||
'速度小于下限或剩余文件还贼多，尝试开启线程
|
||||
Dim IsSuccess As Boolean = False
|
||||
Dim NewThreadCount As Integer
|
||||
'确定最大线程追加数
|
||||
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
|
||||
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
|
||||
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
|
||||
'循环追加
|
||||
Do
|
||||
IsSuccess = False
|
||||
'启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去……
|
||||
'此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始
|
||||
Dim FilesWaiting As New List(Of NetFile)
|
||||
Dim FilesLoading As New List(Of NetFile)
|
||||
SyncLock LockFiles
|
||||
For Each File As NetFile In Files.Values
|
||||
If File.RandomCode Mod 2 = 1 Then Continue For
|
||||
If File.State = NetState.WaitForDownload Then
|
||||
FilesWaiting.Add(File)
|
||||
ElseIf File.State < NetState.Merge Then
|
||||
FilesLoading.Add(File)
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
'为文件列表中的文件开始线程
|
||||
For Each File As NetFile In FilesWaiting
|
||||
If NewThreadCount = 0 Then Exit For
|
||||
If File.TryBeginThread() Then
|
||||
IsSuccess = True
|
||||
NewThreadCount -= 1
|
||||
End If
|
||||
Next
|
||||
For Each File As NetFile In FilesLoading
|
||||
If NewThreadCount = 0 Then Exit For
|
||||
If File.TryBeginThread() Then
|
||||
IsSuccess = True
|
||||
NewThreadCount -= 1
|
||||
End If
|
||||
Next
|
||||
Loop While NewThreadCount > 0 AndAlso IsSuccess
|
||||
End If
|
||||
'等待直至 120 ms
|
||||
Do While GetTimeTick() - LastLoopTime < 120
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
End While
|
||||
Catch ex As Exception
|
||||
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "NetManager ThreadStarter Odd")
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Dim LastLoopTime As Long
|
||||
NetTaskSpeedLimitLeftLast = GetTimeTick()
|
||||
While True
|
||||
Dim TimeNow = GetTimeTick()
|
||||
LastLoopTime = TimeNow
|
||||
'增加限速余量
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
|
||||
NetTaskSpeedLimitLeftLast = TimeNow
|
||||
'刷新公开属性
|
||||
RefreshStat()
|
||||
'等待直至 170 ms
|
||||
Do While GetTimeTick() - LastLoopTime < 170
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
End While
|
||||
Catch ex As Exception
|
||||
Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "NetManager StatRefresher")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim LastLoopTime As Long
|
||||
While True
|
||||
LastLoopTime = GetTimeTick()
|
||||
'开启新线程
|
||||
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
|
||||
'速度小于下限或剩余文件还贼多，尝试开启线程
|
||||
Dim IsSuccess As Boolean = False
|
||||
Dim NewThreadCount As Integer
|
||||
'确定最大线程追加数
|
||||
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
|
||||
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
|
||||
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
|
||||
'循环追加
|
||||
Do
|
||||
IsSuccess = False
|
||||
'启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去……
|
||||
'此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始
|
||||
Dim FilesWaiting As New List(Of NetFile)
|
||||
Dim FilesLoading As New List(Of NetFile)
|
||||
SyncLock LockFiles
|
||||
For Each File As NetFile In Files.Values
|
||||
If File.RandomCode Mod 2 = 1 Then Continue For
|
||||
If File.State = NetState.WaitForDownload Then
|
||||
FilesWaiting.Add(File)
|
||||
ElseIf File.State < NetState.Merge Then
|
||||
FilesLoading.Add(File)
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
'为文件列表中的文件开始线程
|
||||
For Each File As NetFile In FilesWaiting
|
||||
If NewThreadCount = 0 Then Exit For
|
||||
If File.TryBeginThread() Then
|
||||
IsSuccess = True
|
||||
NewThreadCount -= 1
|
||||
End If
|
||||
Next
|
||||
For Each File As NetFile In FilesLoading
|
||||
If NewThreadCount = 0 Then Exit For
|
||||
If File.TryBeginThread() Then
|
||||
IsSuccess = True
|
||||
NewThreadCount -= 1
|
||||
End If
|
||||
Next
|
||||
'等待 40 ms：BMCLAPI 部分时候有 20QPS 的限制
|
||||
Thread.Sleep(40)
|
||||
Loop While NewThreadCount > 0 AndAlso IsSuccess
|
||||
End If
|
||||
'等待 40 ms
|
||||
Thread.Sleep(40)
|
||||
End While
|
||||
Catch ex As Exception
|
||||
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "NetManager ThreadStarter Odd")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim LastLoopTime As Long
|
||||
NetTaskSpeedLimitLeftLast = GetTimeTick()
|
||||
While True
|
||||
Dim TimeNow = GetTimeTick()
|
||||
LastLoopTime = TimeNow
|
||||
'增加限速余量
|
||||
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
|
||||
NetTaskSpeedLimitLeftLast = TimeNow
|
||||
'刷新公开属性
|
||||
RefreshStat()
|
||||
'等待直至 170 ms
|
||||
Do While GetTimeTick() - LastLoopTime < 170
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
End While
|
||||
Catch ex As Exception
|
||||
Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "NetManager StatRefresher")
|
||||
End Sub
|
||||
Private IsManagerStarted As Boolean = False
|
||||
|
||||
|
||||
@@ -1196,7 +1196,7 @@ Retry:
|
||||
''' </summary>
|
||||
''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
|
||||
Public Function ToNetFile(LocalAddress As String) As NetFile
|
||||
Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""))
|
||||
Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""), UseBrowserUserAgent:=True)
|
||||
End Function
|
||||
|
||||
'实例化
|
||||
|
||||
@@ -452,7 +452,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 = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
|
||||
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=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)")
|
||||
@@ -589,7 +589,7 @@
|
||||
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
|
||||
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
|
||||
Catch ex As Exception
|
||||
If GetExceptionSummary(ex).Contains("(404)") Then
|
||||
Throw New Exception("没有可用版本")
|
||||
|
||||
@@ -439,7 +439,7 @@ Retry:
|
||||
'添加下载文件
|
||||
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
|
||||
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString)))
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
|
||||
Next
|
||||
If FileList.Count > 0 Then
|
||||
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
|
||||
@@ -57,7 +57,7 @@ RetryStart:
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd)
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
|
||||
@@ -59,7 +59,7 @@ RetryStart:
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd)
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
|
||||
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
|
||||
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
|
||||
' 方法是按如下所示使用“*”
|
||||
|
||||
<Assembly: AssemblyVersion("2.6.14.0")>
|
||||
<Assembly: AssemblyFileVersion("2.6.14.0")>
|
||||
<Assembly: AssemblyVersion("2.6.15.0")>
|
||||
<Assembly: AssemblyFileVersion("2.6.15.0")>
|
||||
<Assembly: NeutralResourcesLanguage("")>
|
||||
|
||||
@@ -526,7 +526,7 @@ Public Module ModDownloadLib
|
||||
'官方源
|
||||
Dim PageData As String
|
||||
Try
|
||||
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
|
||||
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
|
||||
Task.Progress = 0.8
|
||||
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
|
||||
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
|
||||
@@ -691,7 +691,7 @@ Retry:
|
||||
'官方源
|
||||
Dim PageData As String
|
||||
Try
|
||||
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
|
||||
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
|
||||
Task.Progress = 0.8
|
||||
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
|
||||
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
|
||||
@@ -1317,206 +1317,207 @@ Retry:
|
||||
If Version.Split(".")(0) >= 20 Then
|
||||
Log("[Download] 检测为新版 Forge：" & Version)
|
||||
Dim Libs As List(Of McLibToken) = Nothing
|
||||
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = New List(Of NetFile)
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
'解压并获取、合并两个 Json 的信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Task.Progress = 0.2
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
|
||||
Json.Merge(Json2)
|
||||
'获取 Lib 下载信息
|
||||
Libs = McLibListGetWithJson(Json, True)
|
||||
'添加 Mappings 下载信息
|
||||
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
|
||||
'下载原版 Json 文件
|
||||
Task.Progress = 0.4
|
||||
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
|
||||
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
|
||||
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
|
||||
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
|
||||
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
|
||||
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = New List(Of NetFile)
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
'解压并获取、合并两个 Json 的信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Task.Progress = 0.2
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
|
||||
Json.Merge(Json2)
|
||||
'获取 Lib 下载信息
|
||||
Libs = McLibListGetWithJson(Json, True)
|
||||
'添加 Mappings 下载信息
|
||||
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
|
||||
'下载原版 Json 文件
|
||||
Task.Progress = 0.4
|
||||
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
|
||||
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
|
||||
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
|
||||
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
|
||||
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
|
||||
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
|
||||
Log("[Download] 需要下载 Mappings：" & Address)
|
||||
End If
|
||||
Task.Progress = 0.8
|
||||
'去除其中的原始 Forge 项
|
||||
For i = 0 To Libs.Count - 1
|
||||
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
|
||||
Log("[Download] 需要下载 Mappings：" & Address)
|
||||
End If
|
||||
Task.Progress = 0.8
|
||||
'去除其中的原始 Forge 项
|
||||
For i = 0 To Libs.Count - 1
|
||||
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
|
||||
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
|
||||
Log("[Download] 已从待下载 Forge 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug)
|
||||
Libs.RemoveAt(i)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
|
||||
Catch ex As Exception
|
||||
Throw New Exception("获取新版 Forge 支持库列表失败", ex)
|
||||
Finally
|
||||
'释放文件
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 2})
|
||||
Log("[Download] 已从待下载 Forge 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug)
|
||||
Libs.RemoveAt(i)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
|
||||
Catch ex As Exception
|
||||
Throw New Exception("获取新版 Forge 支持库列表失败", ex)
|
||||
Finally
|
||||
'释放文件
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 2})
|
||||
Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12})
|
||||
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("获取 Mod 下载器支持库文件",
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
|
||||
#Region "Forge 文件"
|
||||
If IsCustomFolder Then
|
||||
For Each LibFile As McLibToken In Libs
|
||||
Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
|
||||
If Not File.Exists(RealPath) Then
|
||||
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
|
||||
CopyFile(LibFile.LocalPath, RealPath)
|
||||
End If
|
||||
If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath)
|
||||
Next
|
||||
End If
|
||||
If IsCustomFolder Then
|
||||
For Each LibFile As McLibToken In Libs
|
||||
Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
|
||||
If Not File.Exists(RealPath) Then
|
||||
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
|
||||
CopyFile(LibFile.LocalPath, RealPath)
|
||||
End If
|
||||
If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath)
|
||||
Next
|
||||
End If
|
||||
#End Region
|
||||
#Region "原版文件"
|
||||
'等待原版文件下载完成
|
||||
If ClientDownloadLoader Is Nothing Then Exit Sub
|
||||
Dim TargetLoaders As List(Of LoaderBase) =
|
||||
'等待原版文件下载完成
|
||||
If ClientDownloadLoader Is Nothing Then Exit Sub
|
||||
Dim TargetLoaders As List(Of LoaderBase) =
|
||||
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
|
||||
Where(Function(l) l.State <> LoadState.Finished).ToList
|
||||
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
|
||||
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
|
||||
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
|
||||
Thread.Sleep(50)
|
||||
Loop
|
||||
If Task.IsAborted Then Exit Sub
|
||||
'拷贝原版文件
|
||||
If Not IsCustomFolder Then Exit Sub
|
||||
SyncLock VanillaSyncLock
|
||||
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
|
||||
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
|
||||
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
|
||||
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
|
||||
End If
|
||||
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
|
||||
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
|
||||
End If
|
||||
End SyncLock
|
||||
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
|
||||
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
|
||||
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
|
||||
Thread.Sleep(50)
|
||||
Loop
|
||||
If Task.IsAborted Then Exit Sub
|
||||
'拷贝原版文件
|
||||
If Not IsCustomFolder Then Exit Sub
|
||||
SyncLock VanillaSyncLock
|
||||
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
|
||||
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
|
||||
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
|
||||
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
|
||||
End If
|
||||
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
|
||||
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
|
||||
End If
|
||||
End SyncLock
|
||||
#End Region
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
Loaders.Add(New LoaderTask(Of Boolean, Boolean)("安装 Mod 加载器（方式 A）",
|
||||
Sub(Task As LoaderTask(Of Boolean, Boolean))
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress)
|
||||
'记录当前文件夹列表（在新建目标文件夹之前）
|
||||
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
|
||||
Sub(Task As LoaderTask(Of Boolean, Boolean))
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress)
|
||||
'记录当前文件夹列表（在新建目标文件夹之前）
|
||||
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
|
||||
Select(Function(i) i.FullName).ToList()
|
||||
'解压并获取信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
'新建目标版本文件夹
|
||||
Directory.CreateDirectory(VersionFolder)
|
||||
Task.Progress = 0.04
|
||||
'释放 launcher_installer.json
|
||||
McFolderLauncherProfilesJsonCreate(McFolder)
|
||||
Task.Progress = 0.05
|
||||
'运行 Forge 安装器
|
||||
Dim UseJavaWrapper As Boolean = True
|
||||
'解压并获取信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
'新建目标版本文件夹
|
||||
Directory.CreateDirectory(VersionFolder)
|
||||
Task.Progress = 0.04
|
||||
'释放 launcher_installer.json
|
||||
McFolderLauncherProfilesJsonCreate(McFolder)
|
||||
Task.Progress = 0.05
|
||||
'运行 Forge 安装器
|
||||
Dim UseJavaWrapper As Boolean = True
|
||||
Retry:
|
||||
Try
|
||||
'释放 Forge 注入器
|
||||
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
|
||||
Task.Progress = 0.06
|
||||
'运行注入器
|
||||
ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
|
||||
Task.Progress = 0.97
|
||||
Catch ex As Exception
|
||||
If UseJavaWrapper Then
|
||||
Log(ex, "使用 JavaWrapper 安装 Forge 失败，将不使用 JavaWrapper 并重试")
|
||||
UseJavaWrapper = False
|
||||
GoTo Retry
|
||||
Else
|
||||
Throw New Exception("运行 Forge 安装器失败", ex)
|
||||
End If
|
||||
End Try
|
||||
'拷贝新增的版本 Json
|
||||
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
|
||||
Try
|
||||
'释放 Forge 注入器
|
||||
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
|
||||
Task.Progress = 0.06
|
||||
'运行注入器
|
||||
ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
|
||||
Task.Progress = 0.97
|
||||
Catch ex As Exception
|
||||
If UseJavaWrapper Then
|
||||
Log(ex, "使用 JavaWrapper 安装 Forge 失败，将不使用 JavaWrapper 并重试")
|
||||
UseJavaWrapper = False
|
||||
GoTo Retry
|
||||
Else
|
||||
Throw New Exception("运行 Forge 安装器失败", ex)
|
||||
End If
|
||||
End Try
|
||||
'拷贝新增的版本 Json
|
||||
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
|
||||
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
|
||||
If DeltaList.Count > 1 Then
|
||||
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
|
||||
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
|
||||
DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
|
||||
End If
|
||||
If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的
|
||||
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
|
||||
WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
|
||||
End If
|
||||
'新建 mods 文件夹
|
||||
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("安装新 Forge 版本失败", ex)
|
||||
Finally
|
||||
'清理文件
|
||||
Try
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
|
||||
Catch ex As Exception
|
||||
Log(ex, "安装 Forge 清理文件时出错")
|
||||
End Try
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 10})
|
||||
If DeltaList.Count > 1 Then
|
||||
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
|
||||
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
|
||||
DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
|
||||
End If
|
||||
If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的
|
||||
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
|
||||
WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
|
||||
End If
|
||||
'新建 mods 文件夹
|
||||
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("安装新 Forge 版本失败", ex)
|
||||
Finally
|
||||
'清理文件
|
||||
Try
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
|
||||
Catch ex As Exception
|
||||
Log(ex, "安装 Forge 清理文件时出错")
|
||||
End Try
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 10})
|
||||
Else
|
||||
Log("[Download] 检测为非新版 Forge：" & Version)
|
||||
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器（方式 B）",
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
'解压并获取信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Task.Progress = 0.2
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
Task.Progress = 0.4
|
||||
'新建版本文件夹
|
||||
Directory.CreateDirectory(VersionFolder)
|
||||
Task.Progress = 0.5
|
||||
If Json("install") Is Nothing Then
|
||||
'中版格式
|
||||
Log("[Download] 进行中版方式安装：" & InstallerAddress)
|
||||
'建立 Json 文件
|
||||
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
|
||||
JsonVersion("id") = Id
|
||||
WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
|
||||
Task.Progress = 0.6
|
||||
'解压支持库文件
|
||||
Installer.Dispose()
|
||||
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
|
||||
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
|
||||
DeleteDirectory(InstallerAddress & "_unrar\")
|
||||
Else
|
||||
'旧版格式
|
||||
Log("[Download] 进行旧版方式安装：" & InstallerAddress)
|
||||
'解压 Jar 文件
|
||||
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
|
||||
If File.Exists(JarAddress) Then File.Delete(JarAddress)
|
||||
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
|
||||
Task.Progress = 0.9
|
||||
'建立 Json 文件
|
||||
Json("versionInfo")("id") = Id
|
||||
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
|
||||
WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
|
||||
End If
|
||||
'新建 mods 文件夹
|
||||
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("非新版方式安装 Forge 失败", ex)
|
||||
Finally
|
||||
Try
|
||||
'清理文件
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
|
||||
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
|
||||
Catch ex As Exception
|
||||
Log(ex, "非新版方式安装 Forge 清理文件时出错")
|
||||
End Try
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 1})
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
|
||||
Dim Installer As ZipArchive = Nothing
|
||||
Try
|
||||
'解压并获取信息
|
||||
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
|
||||
Task.Progress = 0.2
|
||||
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
|
||||
Task.Progress = 0.4
|
||||
'新建版本文件夹
|
||||
Directory.CreateDirectory(VersionFolder)
|
||||
Task.Progress = 0.5
|
||||
If Json("install") Is Nothing Then
|
||||
'中版格式
|
||||
Log("[Download] 进行中版方式安装：" & InstallerAddress)
|
||||
'建立 Json 文件
|
||||
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
|
||||
JsonVersion("id") = Id
|
||||
WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
|
||||
Task.Progress = 0.6
|
||||
'解压支持库文件
|
||||
Installer.Dispose()
|
||||
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
|
||||
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
|
||||
DeleteDirectory(InstallerAddress & "_unrar\")
|
||||
Else
|
||||
'旧版格式
|
||||
Log("[Download] 进行旧版方式安装：" & InstallerAddress)
|
||||
'解压 Jar 文件
|
||||
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
|
||||
If File.Exists(JarAddress) Then File.Delete(JarAddress)
|
||||
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
|
||||
Task.Progress = 0.9
|
||||
'建立 Json 文件
|
||||
Json("versionInfo")("id") = Id
|
||||
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
|
||||
WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
|
||||
End If
|
||||
'新建 mods 文件夹
|
||||
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("非新版方式安装 Forge 失败", ex)
|
||||
Finally
|
||||
Try
|
||||
'清理文件
|
||||
If Installer IsNot Nothing Then Installer.Dispose()
|
||||
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
|
||||
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
|
||||
Catch ex As Exception
|
||||
Log(ex, "非新版方式安装 Forge 清理文件时出错")
|
||||
End Try
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 1})
|
||||
If FixLibrary Then
|
||||
If IsCustomFolder Then Throw New Exception("若需要补全支持库，就不能自定义 MC 文件夹")
|
||||
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
|
||||
|
||||
@@ -913,5 +913,8 @@
|
||||
<Resource Include="Images\Icons\Disabled.png" />
|
||||
<Resource Include="Images\Icons\Unavaliable.png" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Resource Include="Images\Heads\MCBBS.png" />
|
||||
</ItemGroup>
|
||||
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
|
||||
</Project>
|
||||
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user