龙腾猫跃 2 anni fa
parent
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))
         '统计更新日志条目
 #If BETA Then
+        If LastVersion < 317 Then 'Release 2.6.15
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
+            FeatureCount += 2
+            BugCount += 2
+        End If
+        If LastVersion < 315 Then 'Release 2.6.14
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
+            FeatureCount += 17
+            BugCount += 16
+        End If
         If LastVersion < 313 Then 'Release 2.6.13
             FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
             FeatureCount += 6
@@ -129,6 +140,11 @@ Public Class FormMain
         '3:BUG+ IMP* FEAT-
         '2:BUG* IMP-
         '1:BUG-
+        If LastVersion < 316 Then 'Snapshot 2.6.15
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
+            FeatureCount += 2
+            BugCount += 2
+        End If
         If LastVersion < 314 Then 'Snapshot 2.6.14
             FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
             FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))

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 "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.6.14" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.6.14." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号
 #If BETA Then
-    Public Const VersionCode As Integer = 313 'Release
+    Public Const VersionCode As Integer = 317 'Release
 #Else
-    Public Const VersionCode As Integer = 314 'Snapshot
+    Public Const VersionCode As Integer = 316 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName

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

@@ -28,7 +28,7 @@ Public Module ModNet
     ''' </summary>
     ''' <param name="Url">网页的 Url。</param>
     ''' <param name="Encoding">网页的编码,通常为 UTF-8。</param>
-    Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01") As String
+    Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01", Optional UseBrowserUserAgent As Boolean = False) As String
         Dim RetryCount As Integer = 0
         Dim RetryException As Exception = Nothing
         Dim StartTime As Long = GetTimeTick()
@@ -36,15 +36,15 @@ Public Module ModNet
 Retry:
             Select Case RetryCount
                 Case 0 '正常尝试
-                    Return NetGetCodeByClient(Url, Encoding, 10000, Accept)
+                    Return NetGetCodeByClient(Url, Encoding, 10000, Accept, UseBrowserUserAgent)
                 Case 1 '慢速重试
                     Thread.Sleep(500)
-                    Return NetGetCodeByClient(Url, Encoding, 30000, Accept)
+                    Return NetGetCodeByClient(Url, Encoding, 30000, Accept, UseBrowserUserAgent)
                 Case Else '快速重试
                     If GetTimeTick() - StartTime > 5500 Then
                         '若前两次加载耗费 5 秒以上,才进行重试
                         Thread.Sleep(500)
-                        Return NetGetCodeByClient(Url, Encoding, 4000, Accept)
+                        Return NetGetCodeByClient(Url, Encoding, 4000, Accept, UseBrowserUserAgent)
                     Else
                         Throw RetryException
                     End If
@@ -63,7 +63,7 @@ Retry:
             End Select
         End Try
     End Function
-    Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String) As String
+    Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String, Optional UseBrowserUserAgent As Boolean = False) As String
         Url = SecretCdnSign(Url)
         Log("[Net] 获取客户端网络结果:" & Url & ",最大超时 " & Timeout)
         Dim Request As CookieWebClient
@@ -77,7 +77,7 @@ Retry:
             Request.Headers("Accept") = Accept
             Request.Headers("Accept-Language") = "en-US,en;q=0.5"
             Request.Headers("X-Requested-With") = "XMLHttpRequest"
-            SecretHeadersSign(Url, Request)
+            SecretHeadersSign(Url, Request, UseBrowserUserAgent)
             Return Request.DownloadString(Url)
         Catch ex As Exception
             If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
@@ -98,7 +98,7 @@ Retry:
     ''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
     ''' <param name="BackupUrl">如果第一次尝试失败,换用的备用 URL。</param>
     Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "",
-                                             Optional IsJson As Boolean = False, Optional BackupUrl As String = Nothing)
+                                             Optional IsJson As Boolean = False, Optional BackupUrl As String = Nothing, Optional UseBrowserUserAgent As Boolean = False)
         Dim RetryCount As Integer = 0
         Dim RetryException As Exception = Nothing
         Dim StartTime As Long = GetTimeTick()
@@ -106,15 +106,15 @@ Retry:
 Retry:
             Select Case RetryCount
                 Case 0 '正常尝试
-                    Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept)
+                    Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept, UseBrowserUserAgent)
                 Case 1 '慢速重试
                     Thread.Sleep(500)
-                    Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
+                    Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept, UseBrowserUserAgent)
                 Case Else '快速重试
                     If GetTimeTick() - StartTime > 5500 Then
                         '若前两次加载耗费 5 秒以上,才进行重试
                         Thread.Sleep(500)
-                        Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
+                        Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept, UseBrowserUserAgent)
                     Else
                         Throw RetryException
                     End If
@@ -140,7 +140,7 @@ Retry:
     ''' </summary>
     ''' <param name="Url">网页的 Url。</param>
     ''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
-    Public Function NetGetCodeByRequestMuity(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
+    Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
         Dim Threads As New List(Of Thread)
         Dim RequestResult = Nothing
         Dim RequestEx As Exception = Nothing
@@ -182,7 +182,7 @@ RequestFinished:
         Loop
         Throw New Exception("未知错误")
     End Function
-    Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "")
+    Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "", Optional UseBrowserUserAgent As Boolean = False)
         If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
         Url = SecretCdnSign(Url)
         Log($"[Net] 获取网络结果:{Url},超时 {Timeout}ms{If(IsJson, ",要求 json", "")}")
@@ -192,7 +192,7 @@ RequestFinished:
             If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
             Request.Timeout = Timeout
             Request.Accept = Accept
-            SecretHeadersSign(Url, Request)
+            SecretHeadersSign(Url, Request, UseBrowserUserAgent)
             Using res As HttpWebResponse = Request.GetResponse()
                 Using HttpStream As Stream = res.GetResponseStream()
                     HttpStream.ReadTimeout = Timeout
@@ -220,9 +220,9 @@ RequestFinished:
     ''' 以多线程下载网页文件的方式获取网页源代码。
     ''' </summary>
     ''' <param name="Url">网页的 Url。</param>
-    Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
+    Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
         Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
-        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson})})
+        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
         Try
             NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & ")")
             NetGetCodeByDownload = ReadFile(Temp)
@@ -235,9 +235,9 @@ RequestFinished:
     ''' 以多线程下载网页文件的方式获取网页源代码。
     ''' </summary>
     ''' <param name="Urls">网页的 Url 列表。</param>
-    Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String
+    Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
         Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
-        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson})})
+        Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
         Try
             NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls(0) & ")")
             NetGetCodeByDownload = ReadFile(Temp)
@@ -252,7 +252,7 @@ RequestFinished:
     ''' </summary>
     ''' <param name="Url">网络 Url。</param>
     ''' <param name="LocalFile">下载的本地地址。</param>
-    Public Sub NetDownload(Url As String, LocalFile As String)
+    Public Sub NetDownload(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
         Log("[Net] 直接下载文件:" & Url)
 
         '初始化
@@ -268,7 +268,11 @@ RequestFinished:
         '下载
         Using Client As New WebClient
             Try
-                Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
+                If UseBrowserUserAgent Then
+                    Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
+                Else
+                    Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode
+                End If
                 Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
                 Client.DownloadFile(Url, LocalFile)
             Catch ex As Exception
@@ -369,7 +373,7 @@ RequestFinished:
     ''' <summary>
     ''' 发送一次网络请求并获取返回内容。
     ''' </summary>
-    Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) As String
+    Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True, Optional UseBrowserUserAgent As Boolean = False) As String
         If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
         Url = SecretCdnSign(Url)
         If MakeLog Then Log("[Net] 发起网络请求(" & Method & "," & Url & "),最大超时 " & Timeout)
@@ -392,7 +396,7 @@ RequestFinished:
             End If
             Req.ContentType = ContentType
             Req.Timeout = Timeout
-            SecretHeadersSign(Url, Req)
+            SecretHeadersSign(Url, Req, UseBrowserUserAgent)
             If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
             If Method = "POST" OrElse Method = "PUT" Then
                 Req.ContentLength = SendData.Length
@@ -790,6 +794,10 @@ RequestFinished:
         ''' 文件的校验规则。
         ''' </summary>
         Public Check As FileChecker
+        ''' <summary>
+        ''' 下载时是否添加浏览器 UA。
+        ''' </summary>
+        Public UseBrowserUserAgent As Boolean
 
         ''' <summary>
         ''' 上次记速时的时间。
@@ -889,7 +897,7 @@ RequestFinished:
         ''' 新建一个需要下载的文件。
         ''' </summary>
         ''' <param name="LocalPath">包含文件名的本地地址。</param>
-        Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing)
+        Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
             Dim Sources As New List(Of NetSource)
             Dim Count As Integer = 0
             Urls = Urls.Distinct.ToArray
@@ -900,6 +908,7 @@ RequestFinished:
             Me.Sources = Sources.ToArray
             Me.LocalPath = LocalPath
             Me.Check = Check
+            Me.UseBrowserUserAgent = UseBrowserUserAgent
             Me.LocalName = GetFileNameFromPath(LocalPath)
         End Sub
 
@@ -1030,7 +1039,7 @@ StartThread:
                 'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
                 HttpRequest.Timeout = Timeout
                 HttpRequest.AddRange(Info.DownloadStart)
-                SecretHeadersSign(Info.Source.Url, HttpRequest)
+                SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
                 Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
                     '文件大小校验
                     Dim ThreadFileSize = HttpResponse.ContentLength
@@ -1909,84 +1918,86 @@ Retry:
                     Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
                 End Try
             End Sub, "NetManager ThreadStarter Single")
-            RunInNewThread(Sub()
-                               Try
-                                   Dim LastLoopTime As Long
-                                   While True
-                                       LastLoopTime = GetTimeTick()
-                                       '开启新线程
-                                       If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
-                                           '速度小于下限或剩余文件还贼多,尝试开启线程
-                                           Dim IsSuccess As Boolean = False
-                                           Dim NewThreadCount As Integer
-                                           '确定最大线程追加数
-                                           NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
-                                           NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
-                                           NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
-                                           '循环追加
-                                           Do
-                                               IsSuccess = False
-                                               '启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
-                                               '此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
-                                               Dim FilesWaiting As New List(Of NetFile)
-                                               Dim FilesLoading As New List(Of NetFile)
-                                               SyncLock LockFiles
-                                                   For Each File As NetFile In Files.Values
-                                                       If File.RandomCode Mod 2 = 1 Then Continue For
-                                                       If File.State = NetState.WaitForDownload Then
-                                                           FilesWaiting.Add(File)
-                                                       ElseIf File.State < NetState.Merge Then
-                                                           FilesLoading.Add(File)
-                                                       End If
-                                                   Next
-                                               End SyncLock
-                                               '为文件列表中的文件开始线程
-                                               For Each File As NetFile In FilesWaiting
-                                                   If NewThreadCount = 0 Then Exit For
-                                                   If File.TryBeginThread() Then
-                                                       IsSuccess = True
-                                                       NewThreadCount -= 1
-                                                   End If
-                                               Next
-                                               For Each File As NetFile In FilesLoading
-                                                   If NewThreadCount = 0 Then Exit For
-                                                   If File.TryBeginThread() Then
-                                                       IsSuccess = True
-                                                       NewThreadCount -= 1
-                                                   End If
-                                               Next
-                                           Loop While NewThreadCount > 0 AndAlso IsSuccess
-                                       End If
-                                       '等待直至 120 ms
-                                       Do While GetTimeTick() - LastLoopTime < 120
-                                           Thread.Sleep(10)
-                                       Loop
-                                   End While
-                               Catch ex As Exception
-                                   Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
-                               End Try
-                           End Sub, "NetManager ThreadStarter Odd")
-            RunInNewThread(Sub()
-                               Try
-                                   Dim LastLoopTime As Long
-                                   NetTaskSpeedLimitLeftLast = GetTimeTick()
-                                   While True
-                                       Dim TimeNow = GetTimeTick()
-                                       LastLoopTime = TimeNow
-                                       '增加限速余量
-                                       If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
-                                       NetTaskSpeedLimitLeftLast = TimeNow
-                                       '刷新公开属性
-                                       RefreshStat()
-                                       '等待直至 170 ms
-                                       Do While GetTimeTick() - LastLoopTime < 170
-                                           Thread.Sleep(10)
-                                       Loop
-                                   End While
-                               Catch ex As Exception
-                                   Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
-                               End Try
-                           End Sub, "NetManager StatRefresher")
+            RunInNewThread(
+            Sub()
+                Try
+                    Dim LastLoopTime As Long
+                    While True
+                        LastLoopTime = GetTimeTick()
+                        '开启新线程
+                        If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
+                            '速度小于下限或剩余文件还贼多,尝试开启线程
+                            Dim IsSuccess As Boolean = False
+                            Dim NewThreadCount As Integer
+                            '确定最大线程追加数
+                            NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
+                            NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
+                            NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
+                            '循环追加
+                            Do
+                                IsSuccess = False
+                                '启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
+                                '此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
+                                Dim FilesWaiting As New List(Of NetFile)
+                                Dim FilesLoading As New List(Of NetFile)
+                                SyncLock LockFiles
+                                    For Each File As NetFile In Files.Values
+                                        If File.RandomCode Mod 2 = 1 Then Continue For
+                                        If File.State = NetState.WaitForDownload Then
+                                            FilesWaiting.Add(File)
+                                        ElseIf File.State < NetState.Merge Then
+                                            FilesLoading.Add(File)
+                                        End If
+                                    Next
+                                End SyncLock
+                                '为文件列表中的文件开始线程
+                                For Each File As NetFile In FilesWaiting
+                                    If NewThreadCount = 0 Then Exit For
+                                    If File.TryBeginThread() Then
+                                        IsSuccess = True
+                                        NewThreadCount -= 1
+                                    End If
+                                Next
+                                For Each File As NetFile In FilesLoading
+                                    If NewThreadCount = 0 Then Exit For
+                                    If File.TryBeginThread() Then
+                                        IsSuccess = True
+                                        NewThreadCount -= 1
+                                    End If
+                                Next
+                                '等待 40 ms:BMCLAPI 部分时候有 20QPS 的限制
+                                Thread.Sleep(40)
+                            Loop While NewThreadCount > 0 AndAlso IsSuccess
+                        End If
+                        '等待 40 ms
+                        Thread.Sleep(40)
+                    End While
+                Catch ex As Exception
+                    Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
+                End Try
+            End Sub, "NetManager ThreadStarter Odd")
+            RunInNewThread(
+            Sub()
+                Try
+                    Dim LastLoopTime As Long
+                    NetTaskSpeedLimitLeftLast = GetTimeTick()
+                    While True
+                        Dim TimeNow = GetTimeTick()
+                        LastLoopTime = TimeNow
+                        '增加限速余量
+                        If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
+                        NetTaskSpeedLimitLeftLast = TimeNow
+                        '刷新公开属性
+                        RefreshStat()
+                        '等待直至 170 ms
+                        Do While GetTimeTick() - LastLoopTime < 170
+                            Thread.Sleep(10)
+                        Loop
+                    End While
+                Catch ex As Exception
+                    Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
+                End Try
+            End Sub, "NetManager StatRefresher")
         End Sub
         Private IsManagerStarted As Boolean = False
 

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

@@ -1196,7 +1196,7 @@ Retry:
         ''' </summary>
         ''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
         Public Function ToNetFile(LocalAddress As String) As NetFile
-            Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""))
+            Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""), UseBrowserUserAgent:=True)
         End Function
 
         '实例化

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

@@ -452,7 +452,7 @@
     ''' </summary>
     Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
     Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
-        Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
+        Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True)
         If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
         '获取所有版本信息
         Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -589,7 +589,7 @@
     Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
         Dim Result As String
         Try
-            Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
+            Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
         Catch ex As Exception
             If GetExceptionSummary(ex).Contains("(404)") Then
                 Throw New Exception("没有可用版本")

+ 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
                                      PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
-                                     New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString)))
+                                     New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
         Next
         If FileList.Count > 0 Then
             InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s

+ 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 图标,所以重试时不再缩小
             End If
             '下载图片
-            NetDownload(Url, LocalFileAddress & DownloadEnd)
+            NetDownload(Url, LocalFileAddress & DownloadEnd, True)
             Dim LoadError As Exception = Nothing
             RunInUiWait(
             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 图标,所以重试时不再缩小
             End If
             '下载图片
-            NetDownload(Url, LocalFileAddress & DownloadEnd)
+            NetDownload(Url, LocalFileAddress & DownloadEnd, True)
             Dim LoadError As Exception = Nothing
             RunInUiWait(
             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("")>

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

@@ -526,7 +526,7 @@ Public Module ModDownloadLib
                 '官方源
                 Dim PageData As String
                 Try
-                    PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
+                    PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
                     Task.Progress = 0.8
                     Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
                     Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0))
@@ -691,7 +691,7 @@ Retry:
             '官方源
             Dim PageData As String
             Try
-                PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
+                PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
                 Task.Progress = 0.8
                 Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
                 Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0))
@@ -1317,206 +1317,207 @@ Retry:
         If Version.Split(".")(0) >= 20 Then
             Log("[Download] 检测为新版 Forge:" & Version)
             Dim Libs As List(Of McLibToken) = Nothing
-            Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-                                                                                           Task.Output = New List(Of NetFile)
-                                                                                           Dim Installer As ZipArchive = Nothing
-                                                                                           Try
-                                                                                               '解压并获取、合并两个 Json 的信息
-                                                                                               Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
-                                                                                               Task.Progress = 0.2
-                                                                                               Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
-                                                                                               Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
-                                                                                               Json.Merge(Json2)
-                                                                                               '获取 Lib 下载信息
-                                                                                               Libs = McLibListGetWithJson(Json, True)
-                                                                                               '添加 Mappings 下载信息
-                                                                                               If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
-                                                                                                   '下载原版 Json 文件
-                                                                                                   Task.Progress = 0.4
-                                                                                                   Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
-                                                                                                   '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
-                                                                                                   Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
-                                                                                                   Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
-                                                                                                   Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
+            Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件",
+            Sub(Task As LoaderTask(Of String, List(Of NetFile)))
+                Task.Output = New List(Of NetFile)
+                Dim Installer As ZipArchive = Nothing
+                Try
+                    '解压并获取、合并两个 Json 的信息
+                    Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+                    Task.Progress = 0.2
+                    Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+                    Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
+                    Json.Merge(Json2)
+                    '获取 Lib 下载信息
+                    Libs = McLibListGetWithJson(Json, True)
+                    '添加 Mappings 下载信息
+                    If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
+                        '下载原版 Json 文件
+                        Task.Progress = 0.4
+                        Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
+                        '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
+                        Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
+                        Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
+                        Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
                                                                                                             .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
-                                                                                                   Log("[Download] 需要下载 Mappings:" & Address)
-                                                                                               End If
-                                                                                               Task.Progress = 0.8
-                                                                                               '去除其中的原始 Forge 项
-                                                                                               For i = 0 To Libs.Count - 1
-                                                                                                   If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
+                        Log("[Download] 需要下载 Mappings:" & Address)
+                    End If
+                    Task.Progress = 0.8
+                    '去除其中的原始 Forge 项
+                    For i = 0 To Libs.Count - 1
+                        If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
                                                                                                       Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
-                                                                                                       Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
-                                                                                                       Libs.RemoveAt(i)
-                                                                                                       Exit For
-                                                                                                   End If
-                                                                                               Next
-                                                                                               Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
-                                                                                           Catch ex As Exception
-                                                                                               Throw New Exception("获取新版 Forge 支持库列表失败", ex)
-                                                                                           Finally
-                                                                                               '释放文件
-                                                                                               If Installer IsNot Nothing Then Installer.Dispose()
-                                                                                           End Try
-                                                                                       End Sub) With {.ProgressWeight = 2})
+                            Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
+                            Libs.RemoveAt(i)
+                            Exit For
+                        End If
+                    Next
+                    Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
+                Catch ex As Exception
+                    Throw New Exception("获取新版 Forge 支持库列表失败", ex)
+                Finally
+                    '释放文件
+                    If Installer IsNot Nothing Then Installer.Dispose()
+                End Try
+            End Sub) With {.ProgressWeight = 2})
             Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12})
             Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("获取 Mod 下载器支持库文件",
-                                                                         Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
+            Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
 #Region "Forge 文件"
-                                                                             If IsCustomFolder Then
-                                                                                 For Each LibFile As McLibToken In Libs
-                                                                                     Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
-                                                                                     If Not File.Exists(RealPath) Then
-                                                                                         Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
-                                                                                         CopyFile(LibFile.LocalPath, RealPath)
-                                                                                     End If
-                                                                                     If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件:" & LibFile.LocalPath)
-                                                                                 Next
-                                                                             End If
+                If IsCustomFolder Then
+                    For Each LibFile As McLibToken In Libs
+                        Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
+                        If Not File.Exists(RealPath) Then
+                            Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
+                            CopyFile(LibFile.LocalPath, RealPath)
+                        End If
+                        If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件:" & LibFile.LocalPath)
+                    Next
+                End If
 #End Region
 #Region "原版文件"
-                                                                             '等待原版文件下载完成
-                                                                             If ClientDownloadLoader Is Nothing Then Exit Sub
-                                                                             Dim TargetLoaders As List(Of LoaderBase) =
+                '等待原版文件下载完成
+                If ClientDownloadLoader Is Nothing Then Exit Sub
+                Dim TargetLoaders As List(Of LoaderBase) =
                                                                                 ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
                                                                                 Where(Function(l) l.State <> LoadState.Finished).ToList
-                                                                             If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
-                                                                             Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
-                                                                                 TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
-                                                                                 Thread.Sleep(50)
-                                                                             Loop
-                                                                             If Task.IsAborted Then Exit Sub
-                                                                             '拷贝原版文件
-                                                                             If Not IsCustomFolder Then Exit Sub
-                                                                             SyncLock VanillaSyncLock
-                                                                                 Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
-                                                                                 Directory.CreateDirectory(McFolder & "versions\" & Inherit)
-                                                                                 If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
-                                                                                     CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
-                                                                                 End If
-                                                                                 If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
-                                                                                     CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
-                                                                                 End If
-                                                                             End SyncLock
+                If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
+                Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
+                    TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
+                    Thread.Sleep(50)
+                Loop
+                If Task.IsAborted Then Exit Sub
+                '拷贝原版文件
+                If Not IsCustomFolder Then Exit Sub
+                SyncLock VanillaSyncLock
+                    Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
+                    Directory.CreateDirectory(McFolder & "versions\" & Inherit)
+                    If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
+                        CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
+                    End If
+                    If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
+                        CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
+                    End If
+                End SyncLock
 #End Region
-                                                                         End Sub) With {.ProgressWeight = 0.1, .Show = False})
+            End Sub) With {.ProgressWeight = 0.1, .Show = False})
             Loaders.Add(New LoaderTask(Of Boolean, Boolean)("安装 Mod 加载器(方式 A)",
-                                                            Sub(Task As LoaderTask(Of Boolean, Boolean))
-                                                                Dim Installer As ZipArchive = Nothing
-                                                                Try
-                                                                    Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress)
-                                                                    '记录当前文件夹列表(在新建目标文件夹之前)
-                                                                    Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
+            Sub(Task As LoaderTask(Of Boolean, Boolean))
+                Dim Installer As ZipArchive = Nothing
+                Try
+                    Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress)
+                    '记录当前文件夹列表(在新建目标文件夹之前)
+                    Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
                                                                         Select(Function(i) i.FullName).ToList()
-                                                                    '解压并获取信息
-                                                                    Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
-                                                                    Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
-                                                                    '新建目标版本文件夹
-                                                                    Directory.CreateDirectory(VersionFolder)
-                                                                    Task.Progress = 0.04
-                                                                    '释放 launcher_installer.json
-                                                                    McFolderLauncherProfilesJsonCreate(McFolder)
-                                                                    Task.Progress = 0.05
-                                                                    '运行 Forge 安装器
-                                                                    Dim UseJavaWrapper As Boolean = True
+                    '解压并获取信息
+                    Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+                    Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+                    '新建目标版本文件夹
+                    Directory.CreateDirectory(VersionFolder)
+                    Task.Progress = 0.04
+                    '释放 launcher_installer.json
+                    McFolderLauncherProfilesJsonCreate(McFolder)
+                    Task.Progress = 0.05
+                    '运行 Forge 安装器
+                    Dim UseJavaWrapper As Boolean = True
 Retry:
-                                                                    Try
-                                                                        '释放 Forge 注入器
-                                                                        WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
-                                                                        Task.Progress = 0.06
-                                                                        '运行注入器
-                                                                        ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
-                                                                        Task.Progress = 0.97
-                                                                    Catch ex As Exception
-                                                                        If UseJavaWrapper Then
-                                                                            Log(ex, "使用 JavaWrapper 安装 Forge 失败,将不使用 JavaWrapper 并重试")
-                                                                            UseJavaWrapper = False
-                                                                            GoTo Retry
-                                                                        Else
-                                                                            Throw New Exception("运行 Forge 安装器失败", ex)
-                                                                        End If
-                                                                    End Try
-                                                                    '拷贝新增的版本 Json
-                                                                    Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
+                    Try
+                        '释放 Forge 注入器
+                        WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
+                        Task.Progress = 0.06
+                        '运行注入器
+                        ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
+                        Task.Progress = 0.97
+                    Catch ex As Exception
+                        If UseJavaWrapper Then
+                            Log(ex, "使用 JavaWrapper 安装 Forge 失败,将不使用 JavaWrapper 并重试")
+                            UseJavaWrapper = False
+                            GoTo Retry
+                        Else
+                            Throw New Exception("运行 Forge 安装器失败", ex)
+                        End If
+                    End Try
+                    '拷贝新增的版本 Json
+                    Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
                                                                         SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
-                                                                    If DeltaList.Count > 1 Then
-                                                                        '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
-                                                                        '也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
-                                                                        DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
-                                                                    End If
-                                                                    If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的
-                                                                        Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
-                                                                        WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
-                                                                    End If
-                                                                    '新建 mods 文件夹
-                                                                    Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
-                                                                Catch ex As Exception
-                                                                    Throw New Exception("安装新 Forge 版本失败", ex)
-                                                                Finally
-                                                                    '清理文件
-                                                                    Try
-                                                                        If Installer IsNot Nothing Then Installer.Dispose()
-                                                                        If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
-                                                                    Catch ex As Exception
-                                                                        Log(ex, "安装 Forge 清理文件时出错")
-                                                                    End Try
-                                                                End Try
-                                                            End Sub) With {.ProgressWeight = 10})
+                    If DeltaList.Count > 1 Then
+                        '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
+                        '也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
+                        DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
+                    End If
+                    If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的
+                        Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
+                        WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
+                    End If
+                    '新建 mods 文件夹
+                    Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
+                Catch ex As Exception
+                    Throw New Exception("安装新 Forge 版本失败", ex)
+                Finally
+                    '清理文件
+                    Try
+                        If Installer IsNot Nothing Then Installer.Dispose()
+                        If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
+                    Catch ex As Exception
+                        Log(ex, "安装 Forge 清理文件时出错")
+                    End Try
+                End Try
+            End Sub) With {.ProgressWeight = 10})
         Else
             Log("[Download] 检测为非新版 Forge:" & Version)
             Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器(方式 B)",
-                                                            Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
-                                                                Dim Installer As ZipArchive = Nothing
-                                                                Try
-                                                                    '解压并获取信息
-                                                                    Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
-                                                                    Task.Progress = 0.2
-                                                                    Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
-                                                                    Task.Progress = 0.4
-                                                                    '新建版本文件夹
-                                                                    Directory.CreateDirectory(VersionFolder)
-                                                                    Task.Progress = 0.5
-                                                                    If Json("install") Is Nothing Then
-                                                                        '中版格式
-                                                                        Log("[Download] 进行中版方式安装:" & InstallerAddress)
-                                                                        '建立 Json 文件
-                                                                        Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
-                                                                        JsonVersion("id") = Id
-                                                                        WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
-                                                                        Task.Progress = 0.6
-                                                                        '解压支持库文件
-                                                                        Installer.Dispose()
-                                                                        ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
-                                                                        CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
-                                                                        DeleteDirectory(InstallerAddress & "_unrar\")
-                                                                    Else
-                                                                        '旧版格式
-                                                                        Log("[Download] 进行旧版方式安装:" & InstallerAddress)
-                                                                        '解压 Jar 文件
-                                                                        Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
-                                                                        If File.Exists(JarAddress) Then File.Delete(JarAddress)
-                                                                        WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
-                                                                        Task.Progress = 0.9
-                                                                        '建立 Json 文件
-                                                                        Json("versionInfo")("id") = Id
-                                                                        If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
-                                                                        WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
-                                                                    End If
-                                                                    '新建 mods 文件夹
-                                                                    Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
-                                                                Catch ex As Exception
-                                                                    Throw New Exception("非新版方式安装 Forge 失败", ex)
-                                                                Finally
-                                                                    Try
-                                                                        '清理文件
-                                                                        If Installer IsNot Nothing Then Installer.Dispose()
-                                                                        If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
-                                                                        If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
-                                                                    Catch ex As Exception
-                                                                        Log(ex, "非新版方式安装 Forge 清理文件时出错")
-                                                                    End Try
-                                                                End Try
-                                                            End Sub) With {.ProgressWeight = 1})
+            Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
+                Dim Installer As ZipArchive = Nothing
+                Try
+                    '解压并获取信息
+                    Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+                    Task.Progress = 0.2
+                    Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+                    Task.Progress = 0.4
+                    '新建版本文件夹
+                    Directory.CreateDirectory(VersionFolder)
+                    Task.Progress = 0.5
+                    If Json("install") Is Nothing Then
+                        '中版格式
+                        Log("[Download] 进行中版方式安装:" & InstallerAddress)
+                        '建立 Json 文件
+                        Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
+                        JsonVersion("id") = Id
+                        WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
+                        Task.Progress = 0.6
+                        '解压支持库文件
+                        Installer.Dispose()
+                        ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
+                        CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
+                        DeleteDirectory(InstallerAddress & "_unrar\")
+                    Else
+                        '旧版格式
+                        Log("[Download] 进行旧版方式安装:" & InstallerAddress)
+                        '解压 Jar 文件
+                        Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
+                        If File.Exists(JarAddress) Then File.Delete(JarAddress)
+                        WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
+                        Task.Progress = 0.9
+                        '建立 Json 文件
+                        Json("versionInfo")("id") = Id
+                        If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
+                        WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
+                    End If
+                    '新建 mods 文件夹
+                    Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
+                Catch ex As Exception
+                    Throw New Exception("非新版方式安装 Forge 失败", ex)
+                Finally
+                    Try
+                        '清理文件
+                        If Installer IsNot Nothing Then Installer.Dispose()
+                        If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
+                        If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
+                    Catch ex As Exception
+                        Log(ex, "非新版方式安装 Forge 清理文件时出错")
+                    End Try
+                End Try
+            End Sub) With {.ProgressWeight = 1})
             If FixLibrary Then
                 If IsCustomFolder Then Throw New Exception("若需要补全支持库,就不能自定义 MC 文件夹")
                 Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})

+ 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\Unavaliable.png" />
   </ItemGroup>
+  <ItemGroup>
+    <Resource Include="Images\Heads\MCBBS.png" />
+  </ItemGroup>
   <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
 </Project>

BIN
Plain Craft Launcher 2/Resources/Help.zip


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