diff --git a/.github/ISSUE_TEMPLATE/bug2.yml b/.github/ISSUE_TEMPLATE/bug2.yml
index a0860bf..b2db13b 100644
--- a/.github/ISSUE_TEMPLATE/bug2.yml
+++ b/.github/ISSUE_TEMPLATE/bug2.yml
@@ -8,7 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目，并勾选确认。"
options:
- - label: "**我已尝试使用其他启动器，其他启动器没有出现问题。** 如果其他启动器也存在问题，证明是网络环境不佳[（解决方法）](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr)，并非 PCL 的问题，请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
+ - label: "**我已尝试使用其他启动器，其他启动器没有出现问题。** 如果其他启动器也存在问题，证明是网络环境不佳[（解决方法）](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr)，并非 PCL 的问题，请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的，但我确实认为我的问题可能是 PCL 导致的，和网络环境无关。"
required: true
@@ -38,4 +38,4 @@ body:
description: "上传 PCL 文件夹中的 Log1~5.txt。[日志在哪？](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-fvZW)"
placeholder: "先点击这个文本框，然后再将文件直接拖拽到文本框中以上传。"
validations:
- required: true
\ No newline at end of file
+ required: true
diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb
index 8089006..9d4d744 100644
--- a/Plain Craft Launcher 2/FormMain.xaml.vb
+++ b/Plain Craft Launcher 2/FormMain.xaml.vb
@@ -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 关站，移除其相关内容"))
diff --git a/Plain Craft Launcher 2/Images/Heads/MCBBS.png b/Plain Craft Launcher 2/Images/Heads/MCBBS.png
new file mode 100644
index 0000000..b76dd5a
Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/MCBBS.png differ
diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb
index b6d5130..f97ba7e 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb
@@ -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
diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
index 82673de..8084128 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
@@ -28,7 +28,7 @@ Public Module ModNet
'''
''' 网页的 Url。
''' 网页的编码，通常为 UTF-8。
- 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:
''' 网页的编码，通常为 UTF-8。
''' 如果第一次尝试失败，换用的备用 URL。
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:
'''
''' 网页的 Url。
''' 网页的编码，通常为 UTF-8。
- 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:
''' 以多线程下载网页文件的方式获取网页源代码。
'''
''' 网页的 Url。
- 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:
''' 以多线程下载网页文件的方式获取网页源代码。
'''
''' 网页的 Url 列表。
- 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:
'''
''' 网络 Url。
''' 下载的本地地址。
- 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:
'''
''' 发送一次网络请求并获取返回内容。
'''
- 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:
''' 文件的校验规则。
'''
Public Check As FileChecker
+ '''
+ ''' 下载时是否添加浏览器 UA。
+ '''
+ Public UseBrowserUserAgent As Boolean
'''
''' 上次记速时的时间。
@@ -889,7 +897,7 @@ RequestFinished:
''' 新建一个需要下载的文件。
'''
''' 包含文件名的本地地址。
- 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
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
index e443eba..72fc6a7 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
@@ -1196,7 +1196,7 @@ Retry:
'''
''' 目标本地文件夹，或完整的文件路径。会自动判断类型。
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
'实例化
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
index d9c8eb5..e41a940 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
@@ -452,7 +452,7 @@
'''
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("没有可用版本")
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
index 58a3bd2..745a6ed 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
@@ -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
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
index 9462e98..9acefae 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
@@ -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()
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
index 3483e0c..1fa401f 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
@@ -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()
diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
index d402fe4..bbd6bbb 100644
--- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
-
-
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
index 1eaffa1..938b2f2 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
@@ -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})
diff --git a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
index 9eb1b72..4df8c36 100644
--- a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+++ b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
@@ -913,5 +913,8 @@
+
+
+
\ No newline at end of file
diff --git a/Plain Craft Launcher 2/Resources/Custom.xaml b/Plain Craft Launcher 2/Resources/Custom.xaml
index f35be1d..7a25cc8 100644
--- a/Plain Craft Launcher 2/Resources/Custom.xaml
+++ b/Plain Craft Launcher 2/Resources/Custom.xaml
@@ -104,27 +104,27 @@
-
-
-
-
-
-
-
-
diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip
index 5a3fbe3..d00647e 100644
Binary files a/Plain Craft Launcher 2/Resources/Help.zip and b/Plain Craft Launcher 2/Resources/Help.zip differ
diff --git a/Plain Craft Launcher 2/Resources/forge-installer.jar b/Plain Craft Launcher 2/Resources/forge-installer.jar
index 1f650ad..bc54f90 100644
Binary files a/Plain Craft Launcher 2/Resources/forge-installer.jar and b/Plain Craft Launcher 2/Resources/forge-installer.jar differ
diff --git a/最新正式版.zip b/最新正式版.zip
index 8ebd9c2..c5703bf 100644
Binary files a/最新正式版.zip and b/最新正式版.zip differ