龙腾猫跃 há 2 anos atrás
pai
commit
f78250020e

+ 16 - 0
Plain Craft Launcher 2/FormMain.xaml.vb

@@ -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 关站,移除其相关内容"))

BIN
Plain Craft Launcher 2/Images/Heads/MCBBS.png


+ 4 - 4
Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -11,12 +11,12 @@ Public Module ModBase
 #Region "声明"
 #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
 #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

+ 112 - 101
Plain Craft Launcher 2/Modules/Base/ModNet.vb

@@ -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()
-                               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
         End Sub
         Private IsManagerStarted As Boolean = False
         Private IsManagerStarted As Boolean = False
 
 

+ 1 - 1
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb

@@ -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
 
 
         '实例化
         '实例化

+ 2 - 2
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb

@@ -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("没有可用版本")

+ 1 - 1
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
             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

+ 1 - 1
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb

@@ -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()

+ 1 - 1
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb

@@ -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()

+ 2 - 2
Plain Craft Launcher 2/My Project/AssemblyInfo.vb

@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
 ' 方法是按如下所示使用“*”
 ' 方法是按如下所示使用“*”
 
 
-<Assembly: AssemblyVersion("2.6.14.0")>
-<Assembly: AssemblyFileVersion("2.6.14.0")>
+<Assembly: AssemblyVersion("2.6.15.0")>
+<Assembly: AssemblyFileVersion("2.6.15.0")>
 <Assembly: NeutralResourcesLanguage("")>
 <Assembly: NeutralResourcesLanguage("")>

+ 186 - 185
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb

@@ -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)))
-                                                                                           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")})
                                                                                                             .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
                                                                                                       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 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
-                                                                                 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
 #End Region
 #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).
                                                                                 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 安装正在等待原版文件下载完成")
-                                                                             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 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))
-                                                                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()
                                                                         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:
 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()
                                                                         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
         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))
-                                                                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 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})

+ 3 - 0
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj

@@ -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>

BIN
Plain Craft Launcher 2/Resources/Help.zip


BIN
Plain Craft Launcher 2/Resources/forge-installer.jar