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

Merge pull request #1 from Hex-Dragon/main

Browse Source 
Update
This commit is contained in:
wuliaodexiaoluo
2024-03-16 12:23:26 +08:00
committed by GitHub
parent ec6784d57d 3076f3a6b7
commit 7affc1e24f
17 changed files with 339 additions and 308 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.github/ISSUE_TEMPLATE/bug2.yml
+1 -1
View File
@@ -8,7 +8,7 @@ body:
label: "检查项" label: "检查项"
description: "请逐个检查下列项目，并勾选确认。" description: "请逐个检查下列项目，并勾选确认。"
options: 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 required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的，但我确实认为我的问题可能是 PCL 导致的，和网络环境无关。" - label: "我知晓大多数此类问题都是网络环境不佳导致的，但我确实认为我的问题可能是 PCL 导致的，和网络环境无关。"
required: true required: true
Plain Craft Launcher 2/FormMain.xaml.vb
+16
View File
@@ -10,6 +10,17 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #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 If LastVersion < 313 Then 'Release 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6 FeatureCount += 6
@@ -129,6 +140,11 @@ Public Class FormMain
'3：BUG+ IMP* FEAT- '3：BUG+ IMP* FEAT-
'2：BUG* IMP- '2：BUG* IMP-
'1：BUG- '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 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, "优化 MC 下载，尝试解决各种导致 MC 下载失败的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容"))
Plain Craft Launcher 2/Images/Heads/MCBBS.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 715 B

Plain Craft Launcher 2/Modules/Base/ModBase.vb
+4 -4
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.14" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.14." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 313 'Release Public Const VersionCode As Integer = 317 'Release
#Else #Else
Public Const VersionCode As Integer = 314 'Snapshot Public Const VersionCode As Integer = 316 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+112 -101
View File
@@ -28,7 +28,7 @@ Public Module ModNet
''' </summary> ''' </summary>
''' <param name="Url">网页的 Url。</param> ''' <param name="Url">网页的 Url。</param>
''' <param name="Encoding">网页的编码，通常为 UTF-8。</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 RetryCount As Integer = 0
Dim RetryException As Exception = Nothing Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeTick()
@@ -36,15 +36,15 @@ Public Module ModNet
Retry: Retry:
Select Case RetryCount Select Case RetryCount
Case 0 '正常尝试 Case 0 '正常尝试
Return NetGetCodeByClient(Url, Encoding, 10000, Accept) Return NetGetCodeByClient(Url, Encoding, 10000, Accept, UseBrowserUserAgent)
Case 1 '慢速重试 Case 1 '慢速重试
Thread.Sleep(500) Thread.Sleep(500)
Return NetGetCodeByClient(Url, Encoding, 30000, Accept) Return NetGetCodeByClient(Url, Encoding, 30000, Accept, UseBrowserUserAgent)
Case Else '快速重试 Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上，才进行重试 '若前两次加载耗费 5 秒以上，才进行重试
Thread.Sleep(500) Thread.Sleep(500)
Return NetGetCodeByClient(Url, Encoding, 4000, Accept) Return NetGetCodeByClient(Url, Encoding, 4000, Accept, UseBrowserUserAgent)
Else Else
Throw RetryException Throw RetryException
End If End If
@@ -63,7 +63,7 @@ Retry:
End Select End Select
End Try End Try
End Function 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) Url = SecretCdnSign(Url)
Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout) Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout)
Dim Request As CookieWebClient Dim Request As CookieWebClient
@@ -77,7 +77,7 @@ Retry:
Request.Headers("Accept") = Accept Request.Headers("Accept") = Accept
Request.Headers("Accept-Language") = "en-US,en;q=0.5" Request.Headers("Accept-Language") = "en-US,en;q=0.5"
Request.Headers("X-Requested-With") = "XMLHttpRequest" Request.Headers("X-Requested-With") = "XMLHttpRequest"
SecretHeadersSign(Url, Request) SecretHeadersSign(Url, Request, UseBrowserUserAgent)
Return Request.DownloadString(Url) Return Request.DownloadString(Url)
Catch ex As Exception Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then 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="Encode">网页的编码，通常为 UTF-8。</param>
''' <param name="BackupUrl">如果第一次尝试失败，换用的备用 URL。</param> ''' <param name="BackupUrl">如果第一次尝试失败，换用的备用 URL。</param>
Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", 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 RetryCount As Integer = 0
Dim RetryException As Exception = Nothing Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeTick()
@@ -106,15 +106,15 @@ Retry:
Retry: Retry:
Select Case RetryCount Select Case RetryCount
Case 0 '正常尝试 Case 0 '正常尝试
Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept) Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept, UseBrowserUserAgent)
Case 1 '慢速重试 Case 1 '慢速重试
Thread.Sleep(500) Thread.Sleep(500)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept) Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept, UseBrowserUserAgent)
Case Else '快速重试 Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上，才进行重试 '若前两次加载耗费 5 秒以上，才进行重试
Thread.Sleep(500) Thread.Sleep(500)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept) Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept, UseBrowserUserAgent)
Else Else
Throw RetryException Throw RetryException
End If End If
@@ -140,7 +140,7 @@ Retry:
''' </summary> ''' </summary>
''' <param name="Url">网页的 Url。</param> ''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码，通常为 UTF-8。</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 Threads As New List(Of Thread)
Dim RequestResult = Nothing Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing Dim RequestEx As Exception = Nothing
@@ -182,7 +182,7 @@ RequestFinished:
Loop Loop
Throw New Exception("未知错误") Throw New Exception("未知错误")
End Function 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 线程执行了网络请求") If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url) Url = SecretCdnSign(Url)
Log($"[Net] 获取网络结果：{Url}，超时 {Timeout}ms{If(IsJson, "，要求 json", "")}") Log($"[Net] 获取网络结果：{Url}，超时 {Timeout}ms{If(IsJson, "，要求 json", "")}")
@@ -192,7 +192,7 @@ RequestFinished:
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11 If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
Request.Timeout = Timeout Request.Timeout = Timeout
Request.Accept = Accept Request.Accept = Accept
SecretHeadersSign(Url, Request) SecretHeadersSign(Url, Request, UseBrowserUserAgent)
Using res As HttpWebResponse = Request.GetResponse() Using res As HttpWebResponse = Request.GetResponse()
Using HttpStream As Stream = res.GetResponseStream() Using HttpStream As Stream = res.GetResponseStream()
HttpStream.ReadTimeout = Timeout HttpStream.ReadTimeout = Timeout
@@ -220,9 +220,9 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。 ''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary> ''' </summary>
''' <param name="Url">网页的 Url。</param> ''' <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 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 Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）") NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）")
NetGetCodeByDownload = ReadFile(Temp) NetGetCodeByDownload = ReadFile(Temp)
@@ -235,9 +235,9 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。 ''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary> ''' </summary>
''' <param name="Urls">网页的 Url 列表。</param> ''' <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 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 Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls(0) & "）") NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls(0) & "）")
NetGetCodeByDownload = ReadFile(Temp) NetGetCodeByDownload = ReadFile(Temp)
@@ -252,7 +252,7 @@ RequestFinished:
''' </summary> ''' </summary>
''' <param name="Url">网络 Url。</param> ''' <param name="Url">网络 Url。</param>
''' <param name="LocalFile">下载的本地地址。</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) Log("[Net] 直接下载文件：" & Url)
'初始化 '初始化
@@ -268,7 +268,11 @@ RequestFinished:
'下载 '下载
Using Client As New WebClient Using Client As New WebClient
Try 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.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
Client.DownloadFile(Url, LocalFile) Client.DownloadFile(Url, LocalFile)
Catch ex As Exception Catch ex As Exception
@@ -369,7 +373,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 发送一次网络请求并获取返回内容。 ''' 发送一次网络请求并获取返回内容。
''' </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 线程执行了网络请求") If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url) Url = SecretCdnSign(Url)
If MakeLog Then Log("[Net] 发起网络请求（" & Method & "，" & Url & "），最大超时 " & Timeout) If MakeLog Then Log("[Net] 发起网络请求（" & Method & "，" & Url & "），最大超时 " & Timeout)
@@ -392,7 +396,7 @@ RequestFinished:
End If End If
Req.ContentType = ContentType Req.ContentType = ContentType
Req.Timeout = Timeout Req.Timeout = Timeout
SecretHeadersSign(Url, Req) SecretHeadersSign(Url, Req, UseBrowserUserAgent)
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11 If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
If Method = "POST" OrElse Method = "PUT" Then If Method = "POST" OrElse Method = "PUT" Then
Req.ContentLength = SendData.Length Req.ContentLength = SendData.Length
@@ -790,6 +794,10 @@ RequestFinished:
''' 文件的校验规则。 ''' 文件的校验规则。
''' </summary> ''' </summary>
Public Check As FileChecker Public Check As FileChecker
''' <summary>
''' 下载时是否添加浏览器 UA。
''' </summary>
Public UseBrowserUserAgent As Boolean
''' <summary> ''' <summary>
''' 上次记速时的时间。 ''' 上次记速时的时间。
@@ -889,7 +897,7 @@ RequestFinished:
''' 新建一个需要下载的文件。 ''' 新建一个需要下载的文件。
''' </summary> ''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param> ''' <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 Sources As New List(Of NetSource)
Dim Count As Integer = 0 Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray Urls = Urls.Distinct.ToArray
@@ -900,6 +908,7 @@ RequestFinished:
Me.Sources = Sources.ToArray Me.Sources = Sources.ToArray
Me.LocalPath = LocalPath Me.LocalPath = LocalPath
Me.Check = Check Me.Check = Check
Me.UseBrowserUserAgent = UseBrowserUserAgent
Me.LocalName = GetFileNameFromPath(LocalPath) Me.LocalName = GetFileNameFromPath(LocalPath)
End Sub End Sub
@@ -1030,7 +1039,7 @@ StartThread:
'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port) 'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
HttpRequest.Timeout = Timeout HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart) HttpRequest.AddRange(Info.DownloadStart)
SecretHeadersSign(Info.Source.Url, HttpRequest) SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse() Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
'文件大小校验 '文件大小校验
Dim ThreadFileSize = HttpResponse.ContentLength Dim ThreadFileSize = HttpResponse.ContentLength
@@ -1909,84 +1918,86 @@ Retry:
Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert) Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
End Try End Try
End Sub, "NetManager ThreadStarter Single") End Sub, "NetManager ThreadStarter Single")
RunInNewThread(Sub() RunInNewThread(
Try Sub()
Dim LastLoopTime As Long Try
While True Dim LastLoopTime As Long
LastLoopTime = GetTimeTick() While True
'开启新线程 LastLoopTime = GetTimeTick()
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then '开启新线程
'速度小于下限或剩余文件还贼多，尝试开启线程 If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
Dim IsSuccess As Boolean = False '速度小于下限或剩余文件还贼多，尝试开启线程
Dim NewThreadCount As Integer Dim IsSuccess As Boolean = False
'确定最大线程追加数 Dim NewThreadCount As Integer
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4)) '确定最大线程追加数
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半 NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit) NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
'循环追加 NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
Do '循环追加
IsSuccess = False Do
'启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去…… IsSuccess = False
'此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始 '启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去……
Dim FilesWaiting As New List(Of NetFile) '此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始
Dim FilesLoading As New List(Of NetFile) Dim FilesWaiting As New List(Of NetFile)
SyncLock LockFiles Dim FilesLoading As New List(Of NetFile)
For Each File As NetFile In Files.Values SyncLock LockFiles
If File.RandomCode Mod 2 = 1 Then Continue For For Each File As NetFile In Files.Values
If File.State = NetState.WaitForDownload Then If File.RandomCode Mod 2 = 1 Then Continue For
FilesWaiting.Add(File) If File.State = NetState.WaitForDownload Then
ElseIf File.State < NetState.Merge Then FilesWaiting.Add(File)
FilesLoading.Add(File) ElseIf File.State < NetState.Merge Then
End If FilesLoading.Add(File)
Next End If
End SyncLock Next
'为文件列表中的文件开始线程 End SyncLock
For Each File As NetFile In FilesWaiting '为文件列表中的文件开始线程
If NewThreadCount = 0 Then Exit For For Each File As NetFile In FilesWaiting
If File.TryBeginThread() Then If NewThreadCount = 0 Then Exit For
IsSuccess = True If File.TryBeginThread() Then
NewThreadCount -= 1 IsSuccess = True
End If NewThreadCount -= 1
Next End If
For Each File As NetFile In FilesLoading Next
If NewThreadCount = 0 Then Exit For For Each File As NetFile In FilesLoading
If File.TryBeginThread() Then If NewThreadCount = 0 Then Exit For
IsSuccess = True If File.TryBeginThread() Then
NewThreadCount -= 1 IsSuccess = True
End If NewThreadCount -= 1
Next End If
Loop While NewThreadCount > 0 AndAlso IsSuccess Next
End If '等待 40 ms：BMCLAPI 部分时候有 20QPS 的限制
'等待直至 120 ms Thread.Sleep(40)
Do While GetTimeTick() - LastLoopTime < 120 Loop While NewThreadCount > 0 AndAlso IsSuccess
Thread.Sleep(10) End If
Loop '等待 40 ms
End While Thread.Sleep(40)
Catch ex As Exception End While
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert) Catch ex As Exception
End Try Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
End Sub, "NetManager ThreadStarter Odd") End Try
RunInNewThread(Sub() End Sub, "NetManager ThreadStarter Odd")
Try RunInNewThread(
Dim LastLoopTime As Long Sub()
NetTaskSpeedLimitLeftLast = GetTimeTick() Try
While True Dim LastLoopTime As Long
Dim TimeNow = GetTimeTick() NetTaskSpeedLimitLeftLast = GetTimeTick()
LastLoopTime = TimeNow While True
'增加限速余量 Dim TimeNow = GetTimeTick()
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast) LastLoopTime = TimeNow
NetTaskSpeedLimitLeftLast = TimeNow '增加限速余量
'刷新公开属性 If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
RefreshStat() NetTaskSpeedLimitLeftLast = TimeNow
'等待直至 170 ms '刷新公开属性
Do While GetTimeTick() - LastLoopTime < 170 RefreshStat()
Thread.Sleep(10) '等待直至 170 ms
Loop Do While GetTimeTick() - LastLoopTime < 170
End While Thread.Sleep(10)
Catch ex As Exception Loop
Log(ex, "下载管理刷新线程出错", LogLevel.Assert) End While
End Try Catch ex As Exception
End Sub, "NetManager StatRefresher") Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
End Try
End Sub, "NetManager StatRefresher")
End Sub End Sub
Private IsManagerStarted As Boolean = False Private IsManagerStarted As Boolean = False
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+1 -1
View File
@@ -1196,7 +1196,7 @@ Retry:
''' </summary> ''' </summary>
''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param> ''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile 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 End Function
'实例化 '实例化
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+2 -2
View File
@@ -452,7 +452,7 @@
''' </summary> ''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain) Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) 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 & "）") 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)") 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))) Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String Dim Result As String
Try 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 Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本") Throw New Exception("没有可用版本")
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+1 -1
View File
@@ -439,7 +439,7 @@ Retry:
'添加下载文件 '添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390 FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString, 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 Next
If FileList.Count > 0 Then If FileList.Count > 0 Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
+1 -1
View File
@@ -57,7 +57,7 @@ RetryStart:
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小 Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
+1 -1
View File
@@ -59,7 +59,7 @@ RetryStart:
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小 Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.14.0")> <Assembly: AssemblyVersion("2.6.15.0")>
<Assembly: AssemblyFileVersion("2.6.14.0")> <Assembly: AssemblyFileVersion("2.6.15.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+186 -185
View File
@@ -526,7 +526,7 @@ Public Module ModDownloadLib
'官方源 '官方源
Dim PageData As String Dim PageData As String
Try 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 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
@@ -691,7 +691,7 @@ Retry:
'官方源 '官方源
Dim PageData As String Dim PageData As String
Try 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 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
@@ -1317,206 +1317,207 @@ Retry:
If Version.Split(".")(0) >= 20 Then If Version.Split(".")(0) >= 20 Then
Log("[Download] 检测为新版 Forge：" & Version) Log("[Download] 检测为新版 Forge：" & Version)
Dim Libs As List(Of McLibToken) = Nothing 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))) Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件",
Task.Output = New List(Of NetFile) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim Installer As ZipArchive = Nothing Task.Output = New List(Of NetFile)
Try Dim Installer As ZipArchive = Nothing
'解压并获取、合并两个 Json 的信息 Try
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) '解压并获取、合并两个 Json 的信息
Task.Progress = 0.2 Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Task.Progress = 0.2
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Json.Merge(Json2) Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
'获取 Lib 下载信息 Json.Merge(Json2)
Libs = McLibListGetWithJson(Json, True) '获取 Lib 下载信息
'添加 Mappings 下载信息 Libs = McLibListGetWithJson(Json, True)
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then '添加 Mappings 下载信息
'下载原版 Json 文件 If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
Task.Progress = 0.4 '下载原版 Json 文件
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) Task.Progress = 0.4
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0) '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, 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")}) .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
Log("[Download] 需要下载 Mappings：" & Address) Log("[Download] 需要下载 Mappings：" & Address)
End If End If
Task.Progress = 0.8 Task.Progress = 0.8
'去除其中的原始 Forge 项 '去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug) Log("[Download] 已从待下载 Forge 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
End If End If
Next Next
Task.Output = McLibFixFromLibToken(Libs, PathMcFolder) Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
Catch ex As Exception Catch ex As Exception
Throw New Exception("获取新版 Forge 支持库列表失败", ex) Throw New Exception("获取新版 Forge 支持库列表失败", ex)
Finally Finally
'释放文件 '释放文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
End Try End Try
End Sub) With {.ProgressWeight = 2}) End Sub) With {.ProgressWeight = 2})
Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12}) Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("获取 Mod 下载器支持库文件", 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 文件" #Region "Forge 文件"
If IsCustomFolder Then If IsCustomFolder Then
For Each LibFile As McLibToken In Libs For Each LibFile As McLibToken In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder) Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
If Not File.Exists(RealPath) Then If Not File.Exists(RealPath) Then
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath)) Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
CopyFile(LibFile.LocalPath, RealPath) CopyFile(LibFile.LocalPath, RealPath)
End If End If
If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath) If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath)
Next Next
End If End If
#End Region #End Region
#Region "原版文件" #Region "原版文件"
'等待原版文件下载完成 '等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) = Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成") If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsAborted Then Exit Sub If Task.IsAborted Then Exit Sub
'拷贝原版文件 '拷贝原版文件
If Not IsCustomFolder Then Exit Sub If Not IsCustomFolder Then Exit Sub
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder) Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & Inherit) Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json") CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If End If
End SyncLock End SyncLock
#End Region #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）", Loaders.Add(New LoaderTask(Of Boolean, Boolean)("安装 Mod 加载器（方式 A）",
Sub(Task As LoaderTask(Of Boolean, Boolean)) Sub(Task As LoaderTask(Of Boolean, Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress) Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress)
'记录当前文件夹列表（在新建目标文件夹之前） '记录当前文件夹列表（在新建目标文件夹之前）
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories. Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
Select(Function(i) i.FullName).ToList() Select(Function(i) i.FullName).ToList()
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
'新建目标版本文件夹 '新建目标版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
Task.Progress = 0.04 Task.Progress = 0.04
'释放 launcher_installer.json '释放 launcher_installer.json
McFolderLauncherProfilesJsonCreate(McFolder) McFolderLauncherProfilesJsonCreate(McFolder)
Task.Progress = 0.05 Task.Progress = 0.05
'运行 Forge 安装器 '运行 Forge 安装器
Dim UseJavaWrapper As Boolean = True Dim UseJavaWrapper As Boolean = True
Retry: Retry:
Try Try
'释放 Forge 注入器 '释放 Forge 注入器
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller")) WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
Task.Progress = 0.06 Task.Progress = 0.06
'运行注入器 '运行注入器
ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper) ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
Task.Progress = 0.97 Task.Progress = 0.97
Catch ex As Exception Catch ex As Exception
If UseJavaWrapper Then If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 Forge 失败，将不使用 JavaWrapper 并重试") Log(ex, "使用 JavaWrapper 安装 Forge 失败，将不使用 JavaWrapper 并重试")
UseJavaWrapper = False UseJavaWrapper = False
GoTo Retry GoTo Retry
Else Else
Throw New Exception("运行 Forge 安装器失败", ex) Throw New Exception("运行 Forge 安装器失败", ex)
End If End If
End Try End Try
'拷贝新增的版本 Json '拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories. Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList() SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
If DeltaList.Count > 1 Then If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151） '它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空 '也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
End If End If
If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的 If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First() Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName)) WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
End If End If
'新建 mods 文件夹 '新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception("安装新 Forge 版本失败", ex) Throw New Exception("安装新 Forge 版本失败", ex)
Finally Finally
'清理文件 '清理文件
Try Try
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
Catch ex As Exception Catch ex As Exception
Log(ex, "安装 Forge 清理文件时出错") Log(ex, "安装 Forge 清理文件时出错")
End Try End Try
End Try End Try
End Sub) With {.ProgressWeight = 10}) End Sub) With {.ProgressWeight = 10})
Else Else
Log("[Download] 检测为非新版 Forge：" & Version) Log("[Download] 检测为非新版 Forge：" & Version)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器（方式 B）", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器（方式 B）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4 Task.Progress = 0.4
'新建版本文件夹 '新建版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
Task.Progress = 0.5 Task.Progress = 0.5
If Json("install") Is Nothing Then If Json("install") Is Nothing Then
'中版格式 '中版格式
Log("[Download] 进行中版方式安装：" & InstallerAddress) Log("[Download] 进行中版方式安装：" & InstallerAddress)
'建立 Json 文件 '建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = Id JsonVersion("id") = Id
WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString) WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
Task.Progress = 0.6 Task.Progress = 0.6
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\") ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\") CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\") DeleteDirectory(InstallerAddress & "_unrar\")
Else Else
'旧版格式 '旧版格式
Log("[Download] 进行旧版方式安装：" & InstallerAddress) Log("[Download] 进行旧版方式安装：" & InstallerAddress)
'解压 Jar 文件 '解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder) Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress) If File.Exists(JarAddress) Then File.Delete(JarAddress)
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9 Task.Progress = 0.9
'建立 Json 文件 '建立 Json 文件
Json("versionInfo")("id") = Id Json("versionInfo")("id") = Id
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString) WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
End If End If
'新建 mods 文件夹 '新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex) Throw New Exception("非新版方式安装 Forge 失败", ex)
Finally Finally
Try Try
'清理文件 '清理文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\") If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
Catch ex As Exception Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错") Log(ex, "非新版方式安装 Forge 清理文件时出错")
End Try End Try
End Try End Try
End Sub) With {.ProgressWeight = 1}) End Sub) With {.ProgressWeight = 1})
If FixLibrary Then If FixLibrary Then
If IsCustomFolder Then Throw New Exception("若需要补全支持库，就不能自定义 MC 文件夹") 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}) 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})
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+3
View File
@@ -913,5 +913,8 @@
<Resource Include="Images\Icons\Disabled.png" /> <Resource Include="Images\Icons\Disabled.png" />
<Resource Include="Images\Icons\Unavaliable.png" /> <Resource Include="Images\Icons\Unavaliable.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\MCBBS.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
Plain Craft Launcher 2/Resources/Custom.xaml
+8 -8
View File
@@ -104,27 +104,27 @@
<local:MyCard Title="事件 4：其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwaped="True"> <local:MyCard Title="事件 4：其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15"> <StackPanel Margin="25,40,23,15">
<TextBlock Margin="0,4,0,6" FontWeight="Bold" <TextBlock TextWrapping="Wrap" Margin="0,4,0,6" FontWeight="Bold"
Text="EventType 共有以下种类：" /> Text="EventType 共有以下种类：" />
<TextBlock Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="· 打开网页、启动游戏、打开文件：已在上方的卡片中介绍" /> Text="· 打开网页、启动游戏、打开文件：已在上方的卡片中介绍" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="查看 PCL 源代码" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/blob/main/Plain%20Craft%20Launcher%202/FormMain.xaml.vb"/> Text="查看 PCL 源代码" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/blob/main/Plain%20Craft%20Launcher%202/FormMain.xaml.vb"/>
<TextBlock Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="· 今日人品、清理垃圾、内存优化、安装整合包：触发对应功能" /> Text="· 今日人品、清理垃圾、内存优化、安装整合包：触发对应功能" />
<TextBlock Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="· 复制文本：将 EventData 中的内容复制到剪贴板" /> Text="· 复制文本：将 EventData 中的内容复制到剪贴板" />
<TextBlock Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="· 刷新主页：点击重新加载主页。如果主页文件为联网更新，这会重新下载主页内容" /> Text="· 刷新主页：点击重新加载主页。如果主页文件为联网更新，这会重新下载主页内容" />
<TextBlock Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="· 下载文件：在点击时要求选择文件保存位置，并且下载 EventData 的链接中的文件" /> Text="· 下载文件：在点击时要求选择文件保存位置，并且下载 EventData 的链接中的文件" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" /> Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
<TextBlock Margin="0,4,0,4" <TextBlock TextWrapping="Wrap" Margin="0,4,0,4"
Text="· 打开帮助：跳转到 EventData 对应的帮助文件（输入相对 Help 文件夹的路径）"/> Text="· 打开帮助：跳转到 EventData 对应的帮助文件（输入相对 Help 文件夹的路径）"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/> Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/>
<TextBlock Margin="0,4,0,4" <TextBlock TextWrapping="Wrap" Margin="0,4,0,4"
Text="· 切换页面：强制切换到 PCL 的某一页面（尝试切换到不太对头的页面会出现不可预知的 Bug，使用时请谨慎）&#xa; 　　　　　EventData 为 页面种类|次要页面种类（PageType|PageSubType，例如 1|1）&#xa; 　　　　　点击上方的 查看 PCL 源代码 按钮，在 1000 行左右的位置即可查找到对应数值"/> Text="· 切换页面：强制切换到 PCL 的某一页面（尝试切换到不太对头的页面会出现不可预知的 Bug，使用时请谨慎）&#xa; 　　　　　EventData 为 页面种类|次要页面种类（PageType|PageSubType，例如 1|1）&#xa; 　　　　　点击上方的 查看 PCL 源代码 按钮，在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到下载页面" EventType="切换页面" EventData="1|1"/> Text="切换到下载页面" EventType="切换页面" EventData="1|1"/>
Plain Craft Launcher 2/Resources/Help.zip
BIN
View File
Binary file not shown.
Plain Craft Launcher 2/Resources/forge-installer.jar
BIN
View File
Binary file not shown.
最新正式版.zip
BIN
View File
Binary file not shown.