diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index 6c9a97d..6b7082a 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -19,7 +19,6 @@ Public Class Application '开始 Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup - ApplicationStartTick = GetTimeTick() SecretOnApplicationStart() Try '检查参数调用 @@ -104,9 +103,10 @@ Public Class Application '日志初始化 LogStart() '添加日志 - Log("[Start] 程序版本：" & VersionDisplayName & "（" & VersionCode & "）") - Log("[Start] 识别码：" & UniqueAddress & If(ThemeCheckOne(9), "，已解锁反馈主题", "")) - Log("[Start] 程序路径：" & PathWithName) + Log($"[Start] 程序版本：{VersionDisplayName} ({VersionCode})") + Log($"[Start] 识别码：{UniqueAddress}{If(ThemeCheckOne(9), "，已解锁反馈主题", "")}") + Log($"[Start] 程序路径：{PathWithName}") + Log($"[Start] 系统编码：{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") '检测压缩包运行 If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then MyMsgBox("PCL 正在临时文件夹运行，设置、游戏存档等很可能无法保存，且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压，或是更换文件夹后再继续使用！", "环境警告", "我知道了", IsWarn:=True) @@ -220,7 +220,7 @@ Public Class Application Names.Remove(sender.Tag) Setup.Set("LoginLegacyName", Join(Names, "¨")) FrmLoginLegacy.ComboName.ItemsSource = Names - FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "") + FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "") Case Else '第三方 Dim Token As String = GetStringFromEnum(Setup.Get("LoginType")) @@ -238,12 +238,12 @@ Public Class Application Select Case Token Case "Nide" FrmLoginNide.ComboName.ItemsSource = Dict.Keys - FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "") - FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "") + FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "") + FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "") Case "Auth" FrmLoginAuth.ComboName.ItemsSource = Dict.Keys - FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "") - FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "") + FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "") + FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "") End Select End Select End Sub diff --git a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb index b341275..beaeb1c 100644 --- a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb +++ b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb @@ -8,10 +8,12 @@ Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub Dim SourceType = e.Source.GetType - If Content.TemplatedParent Is Nothing AndAlso - ((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse - (GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse - GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then + If Content.TemplatedParent Is Nothing AndAlso ( + (GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse + (GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse + GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse + TypeOf e.Source Is CheckBox + ) Then '如果当前是在对有滚动条的下拉框或文本框执行，则不接管操作 Exit Sub End If diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 941e7f6..ee53027 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -10,6 +10,10 @@ Public Class FormMain Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) '统计更新日志条目 #If BETA Then + If LastVersion < 321 Then 'Release 2.7.1 + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug")) + BugCount += 1 + End If If LastVersion < 319 Then 'Release 2.7.0 FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志")) @@ -96,7 +100,15 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- - If LastVersion < 318 Then 'Snapshot 2.7.1 + If LastVersion < 322 Then 'Snapshot 2.7.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug")) + FeatureCount += 18 + BugCount += 18 + End If + If LastVersion < 320 Then 'Snapshot 2.7.1 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug")) BugCount += 1 End If @@ -430,6 +442,8 @@ Public Class FormMain Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode) End If #End If + '被移除的窗口设置选项 + If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1) '修改主题设置项名称 If LowerVersionCode <= 207 Then Dim UnlockedTheme As New List(Of String) From {"2"} @@ -653,7 +667,7 @@ Public Class FormMain If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack() End Sub Private Sub TriggerPageBack() - If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then + If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then FrmDownloadInstall.ExitSelectPage() Else PageBack() @@ -761,7 +775,7 @@ Public Class FormMain RunInNewThread( Sub() Dim FilePath As String = FilePathList.First - Log("[System] 接受文件拖拽：" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer) + Log("[System] 接受文件拖拽：" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer) '基础检查 If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then Hint("请拖入一个文件，而非文件夹！", HintType.Critical) @@ -1176,8 +1190,11 @@ Install: ''' 通过点击返回按钮或手动触发返回来改变页面。 ''' Public Sub PageBack() Handles BtnTitleInner.Click - If Not PageStack.Any() Then Exit Sub - PageChangeActual(PageStack(0)) + If PageStack.Any() Then + PageChangeActual(PageStack(0)) + Else + PageChange(PageType.Launch) + End If End Sub '实际处理页面切换 @@ -1357,23 +1374,22 @@ Install: End Sub Private Sub PanMainLeft_Resize(NewWidth As Double) Dim Delta As Double = NewWidth - RectLeftBackground.Width - If Math.Abs(Delta) < 0.1 Then Exit Sub - If AniControlEnabled = 0 Then + If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏 If NewWidth > 0 Then '宽度足够，显示 AniStart({ - AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), - AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200), - AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250) - }, "FrmMain LeftChange", True) + AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), + AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200), + AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250) + }, "FrmMain LeftChange", True) Else '宽度不足，隐藏 AniStart({ - AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent), - AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200), - AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170) - }, "FrmMain LeftChange", True) + AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent), + AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200), + AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170) + }, "FrmMain LeftChange", True) End If Else RectLeftBackground.Width = NewWidth diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 7ec28b6..dfb628d 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -11,12 +11,12 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.7.1" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.7.1." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号 #If BETA Then - Public Const VersionCode As Integer = 319 'Release + Public Const VersionCode As Integer = 321 'Release #Else - Public Const VersionCode As Integer = 320 'Snapshot + Public Const VersionCode As Integer = 322 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -58,7 +58,7 @@ Public Module ModBase ''' ''' 程序的打开计时。 ''' - Public ApplicationStartTick As Long + Public ApplicationStartTick As Long = GetTimeTick() ''' ''' 程序打开时的时间。 ''' @@ -76,6 +76,10 @@ Public Module ModBase ''' Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem ''' + ''' 是否使用 GBK 编码。 + ''' + Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936 + ''' ''' 操作系统版本。Win10 为 10.0。 ''' Public OsVersion As Version = Environment.OSVersion.Version @@ -726,8 +730,8 @@ Public Module ModBase Public Function GetFileNameFromPath(FilePath As String) As String FilePath = FilePath.Replace("/", "\") If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名：" & FilePath) - If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1) If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ? + If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1) Dim length As Integer = FilePath.Length If length = 0 Then Throw New Exception("不包含文件名：" & FilePath) If length > 250 Then Throw New PathTooLongException("文件名过长：" & FilePath) @@ -1215,43 +1219,35 @@ Re: ''' ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。 ''' 会尝试创建，但不会清空目标文件夹。 - ''' 成功返回 True，并非压缩文件或失败返回 False。 ''' - Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean - Try - Directory.CreateDirectory(DestDirectory) - If CompressFilePath.EndsWithF(".gz", True) Then - '以 gz 方式解压 - Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) - Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) - Dim data As Integer = stream.ReadByte() - While data <> -1 - decompressedFile.WriteByte(data) - data = stream.ReadByte() - End While - decompressedFile.Close() - stream.Close() - Return True - Else - '以 zip 方式解压 - Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030"))) - For Each Entry As ZipArchiveEntry In Archive.Entries - Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) - If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then - Continue For '不创建空文件夹 - Else - Directory.CreateDirectory(GetPathFromFullPath(DestinationPath)) - Entry.ExtractToFile(DestinationPath, True) - End If - Next - End Using - Return True - End If - Catch ex As Exception - Log(ex, "尝试解压文件失败") - Return False - End Try - End Function + Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) + Directory.CreateDirectory(DestDirectory) + If CompressFilePath.EndsWithF(".gz", True) Then + '以 gz 方式解压 + Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) + Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) + Dim data As Integer = stream.ReadByte() + While data <> -1 + decompressedFile.WriteByte(data) + data = stream.ReadByte() + End While + decompressedFile.Close() + stream.Close() + Else + '以 zip 方式解压 + Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030"))) + For Each Entry As ZipArchiveEntry In Archive.Entries + Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) + If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then + Continue For '不创建空文件夹 + Else + Directory.CreateDirectory(GetPathFromFullPath(DestinationPath)) + Entry.ExtractToFile(DestinationPath, True) + End If + Next + End Using + End If + End Sub ''' ''' 删除文件夹，返回删除的文件个数。通过参数选择是否抛出异常。 @@ -1342,7 +1338,7 @@ Re: Loop DescList = DescList.Distinct.ToList Dim Desc As String = Join(DescList, vbCrLf & "→ ") - Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "") + Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "") '常见错误（记得同时修改下面的） Dim CommonReason As String = Nothing @@ -1541,6 +1537,12 @@ Re: Next Return tmp.ToString() End Function + ''' + ''' 检查字符串中的字符是否均为 ASCII 字符。 + ''' + Public Function IsASCII(Input As String) As Boolean + Return Input.All(Function(c) AscW(c) < 128) + End Function ''' ''' 高速的 StartsWith。 @@ -2073,7 +2075,7 @@ NextElement: ''' 传入两个对象，若第一个对象应该排在前面，则返回 True。 Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T) Dim NewList As New List(Of T) - While List.Count > 0 + While List.Any Dim Highest = List(0) For i = 1 To List.Count - 1 If SortRule(List(i), Highest) Then Highest = List(i) @@ -2646,7 +2648,7 @@ Retry: ''' Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T) Shuffle = New List(Of T) - Do While array.Count > 0 + Do While array.Any Dim i As Integer = RandomInteger(0, array.Count - 1) Shuffle.Add(array(i)) array.RemoveAt(i) diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb index f2bf1b4..9c1c573 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb @@ -571,7 +571,7 @@ Restart: Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None - Public Sub LoaderTaskbarAdd(Loader As LoaderBase) + Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T)) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) SyncLock LoaderTaskbarLock LoaderTaskbar.Add(Loader) @@ -587,11 +587,11 @@ Restart: '外显任务是否已经全部完成 Dim IsAllDownloadTaskCompleted As Boolean = True For Each Loader In LoaderTaskbar - If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False + If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False Next '若单个任务已中止或全部任务已完成，则刷新并移除 For Each Task In LoaderTaskbar.ToList() - If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then + If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) LoaderTaskbar.Remove(Task) Log($"[Taskbar] {Task.Name} 已移出任务列表") @@ -628,7 +628,6 @@ Restart: Dim Total As Double = 0, Count As Integer = 0 SyncLock LoaderTaskbarLock For Each Task In LoaderTaskbar.ToList - If Not Task.Show Then Continue For Total += Task.Progress Count += 1 '避免多线程影响导致计数出错 Next diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index 5bdf83a..ca3b5a2 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -1,4 +1,5 @@ Imports System.Net +Imports PCL.ModNet Public Module ModNet Public Const NetDownloadEnd As String = ".PCLDownloading" @@ -235,11 +236,11 @@ RequestFinished: ''' 以多线程下载网页文件的方式获取网页源代码。 ''' ''' 网页的 Url 列表。 - 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() + Public Function NetGetCodeByDownload(Urls As IEnumerable(Of 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.First.GetHashCode() & "_" & GetUuid() 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) & "）") + NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）") NetGetCodeByDownload = ReadFile(Temp) File.Delete(Temp) Finally @@ -448,7 +449,7 @@ RequestFinished: ''' ''' 速度下限。 ''' - Public NetTaskSpeedLimitLow As Long = 1024 * 1024L + Public NetTaskSpeedLimitLow As Long = 256 * 1024L '256K/s ''' ''' 速度上限。若无限制则为 -1。 ''' @@ -601,7 +602,7 @@ RequestFinished: SyncLock Task.LockChain If NextThread Is Nothing Then If Task.IsUnknownSize Then - Return 1024 * 1024 * 1024 '1G + Return 5 * 1024 * 1024 * 1024L '5G Else Return Task.FileSize - 1 End If @@ -616,7 +617,7 @@ RequestFinished: ''' Public ReadOnly Property DownloadUndone As Long Get - Return DownloadEnd + 1 - (DownloadStart + DownloadDone) + Return DownloadEnd - (DownloadStart + DownloadDone) + 1 End Get End Property ''' @@ -715,7 +716,7 @@ RequestFinished: CurrentSource = Sources(Id) End While Return CurrentSource - ElseIf SourcesOnce.Count > 0 Then + ElseIf SourcesOnce.Any Then '仅存在单线程可用源 Return SourcesOnce(0) Else @@ -728,7 +729,7 @@ RequestFinished: ''' 是否已经没有可用源了。 ''' Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean - If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False + If AllowOnceSource AndAlso SourcesOnce.Any Then Return False SyncLock LockSource For Each Source As NetSource In Sources If Not Source.IsFailed Then Return False @@ -754,15 +755,12 @@ RequestFinished: ''' 导致下载失败的原因。 ''' Public Ex As New List(Of Exception) - '''' - '''' 文件进行整体重试的计数。 - '''' - 'Private RetryCount As Integer = 0 ''' ''' 作为文件组成部分的线程链表。 + ''' 如果没有线程，可以为 Nothing。 ''' - Private Threads As NetThread + Public Threads As NetThread ''' ''' 文件的总大小。若为 -2 则为未获取，若为 -1 则为无法获取准确大小。 @@ -844,10 +842,10 @@ RequestFinished: Case NetState.Get Return 0.04 Case NetState.Download - '正在下载中，对应 5% ~ 99% + '正在下载中，对应 5% ~ 98% Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1)) OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9 - Return OriginalProgress * 0.94 + 0.05 + Return OriginalProgress * 0.93 + 0.05 Case NetState.Merge Return 0.99 Case NetState.Finish, NetState.Error @@ -878,14 +876,13 @@ RequestFinished: End Property Private Const FilePieceLimit As Long = 256 * 1024 - Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999) Public ReadOnly LockCount As New Object Public ReadOnly LockState As New Object Public ReadOnly LockChain As New Object Public ReadOnly LockSource As New Object Public ReadOnly LockTasks As New Object - Private ReadOnly Uuid As Integer = GetUuid() + Public ReadOnly Uuid As Integer = GetUuid() Public Overrides Function Equals(obj As Object) As Boolean Dim file = TryCast(obj, NetFile) Return file IsNot Nothing AndAlso Uuid = file.Uuid @@ -914,14 +911,15 @@ RequestFinished: ''' ''' 尝试开始一个新的下载线程。 + ''' 如果失败，返回 Nothing。 ''' - Public Function TryBeginThread() As Boolean + Public Function TryBeginThread() As NetThread Try '条件检测 If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse - (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False - If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False + (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing + If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing SyncLock LockState If State < NetState.Connect Then State = NetState.Connect End SyncLock @@ -936,7 +934,7 @@ RequestFinished: '单线程 If IsSourceFailed(False) Then '确认没有其他线程正使用此点 - If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False + If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return Nothing '占用此点 Capture: SmailFileCache = Nothing @@ -952,14 +950,8 @@ Capture: If Threads Is Nothing Then StartPosition = 0 StartSource = GetSource(FirstThreadSource) - If StartSource Is Nothing Then - '没有可用源了 - Throw New Exception("无可用源，请反馈此问题。") - Else - '有可用源 - FirstThreadSource = StartSource.Id + 1 - GoTo StartThread - End If + FirstThreadSource = StartSource.Id + 1 + GoTo StartThread End If '寻找失败点 For Each Thread As NetThread In Threads @@ -971,24 +963,25 @@ Capture: Next '是否禁用多线程，以及规定碎片大小 Dim TargetUrl As String = GetSource().Url - If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") Then Return False + If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing '寻找最大碎片 + 'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程 Dim FilePieceMax As NetThread = Threads For Each Thread As NetThread In Threads If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread Next - If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return False + If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return Nothing StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4 StartSource = GetSource() '开始线程 StartThread: - If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False + If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing '构建线程 Dim ThreadUuid As Integer = GetUuid() SyncLock LockTasks - If Not Tasks.Any() Then Return False '由于中断，已没有可用任务 - Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal} + If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务 + Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal} End SyncLock ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} '链表处理 @@ -1012,11 +1005,11 @@ StartThread: If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo End SyncLock Th.Start(ThreadInfo) - Return True + Return ThreadInfo Catch ex As Exception Log(ex, "尝试开始下载线程失败（" & If(LocalName, "Nothing") & "）", LogLevel.Hint) - Return False + Return Nothing End Try End Function ''' @@ -1040,35 +1033,44 @@ StartThread: HttpRequest.Timeout = Timeout HttpRequest.AddRange(Info.DownloadStart) SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent) + Dim ContentLength As Long = 0 Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse() + If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then + Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.ResponseUri.OriginalString}") + End If '文件大小校验 - Dim ThreadFileSize = HttpResponse.ContentLength - If ThreadFileSize = -1 Then + ContentLength = HttpResponse.ContentLength + If ContentLength = -1 Then If FileSize > 1 Then - Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知，但已从其他下载源获取，不作处理") + If Info.DownloadStart = 0 Then + Log($"[Download] {LocalName} {Info.Uuid}#：文件大小未知，但已从其他下载源获取，不作处理") + Else + Log($"[Download] {LocalName} {Info.Uuid}#：ContentLength 返回了 -1，无法确定是否支持分段下载，视作不支持") + GoTo NotSupportRange + End If Else FileSize = -1 : IsUnknownSize = True - Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知") + Log($"[Download] {LocalName} {Info.Uuid}#：文件大小未知") End If - ElseIf ThreadFileSize < 0 Then - Throw New Exception("获取片大小失败，结果为 " & ThreadFileSize & "。") + ElseIf ContentLength < 0 Then + Throw New Exception("获取片大小失败，结果为 " & ContentLength & "。") ElseIf Info.IsFirstThread Then If Check IsNot Nothing Then - If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then - Throw New Exception("文件大小不足，获取结果为 " & ThreadFileSize & "，要求至少为 " & Check.MinSize & "。") + If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then + Throw New Exception($"文件大小不足，获取结果为 {ContentLength}，要求至少为 {Check.MinSize}。") End If - If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then - Throw New Exception("文件大小不一致，获取结果为 " & ThreadFileSize & "，要求必须为 " & Check.ActualSize & "。") + If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then + Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。") End If End If - FileSize = ThreadFileSize : IsUnknownSize = False - Log("[Download] " & LocalName & "：文件大小 " & ThreadFileSize & " B" & "（" & GetString(ThreadFileSize) & "）") + FileSize = ContentLength : IsUnknownSize = False + Log($"[Download] {LocalName} {Info.Uuid}#：文件大小 {ContentLength}（{GetString(ContentLength)}）") '若文件大小大于 50 M，进行剩余磁盘空间校验 - If ThreadFileSize > 50 * 1024 * 1024 Then + If ContentLength > 50 * 1024 * 1024 Then For Each Drive As DriveInfo In DriveInfo.GetDrives Dim DriveName As String = Drive.Name.First.ToString - Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ThreadFileSize * 1.1, 0) + - If(LocalPath.StartsWithF(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0) + Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) + + If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0) If Drive.TotalFreeSpace < RequiredSpace Then Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" & If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", "")) @@ -1076,8 +1078,9 @@ StartThread: Next End If ElseIf FileSize < 0 Then - Throw New Exception("非首线程运行时，尚未获取文件大小。") - ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then + Throw New Exception("非首线程运行时，尚未获取文件大小") + ElseIf Info.DownloadStart > 0 AndAlso ContentLength = FileSize Then +NotSupportRange: SyncLock LockSource If SourcesOnce.Contains(Info.Source) Then GoTo SourceBreak @@ -1085,10 +1088,11 @@ StartThread: SourcesOnce.Add(Info.Source) End If End SyncLock - Throw New WebException("该下载源不支持断点续传。") - ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then - Throw New WebException("获取到的片大小不一致：线程结果为 " & ThreadFileSize & " B，任务结果为 " & FileSize & "B，起点为 " & Info.DownloadStart & "B。") + Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}") + ElseIf Not FileSize - Info.DownloadStart = ContentLength Then + Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}") End If + 'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}") Info.State = NetState.Get SyncLock LockState If State < NetState.Get Then State = NetState.Get @@ -1108,7 +1112,7 @@ StartThread: Dim HttpData As Byte() = New Byte(16384) {} HttpDataCount = HttpStream.Read(HttpData, 0, 16384) While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成 - HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread)) + HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread)) '限速 While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0 Threading.Thread.Sleep(16) @@ -1170,17 +1174,17 @@ StartThread: End Using End Using SourceBreak: - If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then - '服务器无返回数据 - Throw New Exception("服务器无返回数据，但下载尚未完成") - ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then + If State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then '被外部中断 Info.State = NetState.Error - Log("[Download] " & LocalName & " " & Info.Uuid & "#：中断") + Log($"[Download] {LocalName} {Info.Uuid}#：中断") + ElseIf HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then + '服务器无返回数据 + Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Info.DownloadDone}（全文件总数据量 {DownloadDone}）") Else '本线程完成 Info.State = NetState.Finish - If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#：完成，已下载 " & GetString(Info.DownloadDone)) + If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#：完成，已下载 {Info.DownloadDone}") End If Catch ex As Exception '状态变更 @@ -1212,11 +1216,11 @@ SourceBreak: 'End SyncLock Info.Source.Ex = ex '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传） - 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源 If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse - ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的片大小不一致") OrElse - (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse - Info.Source.FailCount > NetTaskThreadLimit Then + ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse + (ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源 + (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse + Info.Source.FailCount > NetTaskThreadLimit + 2 Then Dim IsThisFail As Boolean = False SyncLock LockSource If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then @@ -1232,8 +1236,8 @@ Wrong: End SyncLock '本线程引发下载源被禁用 If IsThisFail Then - Log("[Download] " & LocalName & " " & Uuid & "#：下载源被禁用（" & Info.Source.Id & "）：" & Info.Source.Url) - Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug)) + Log($"[Download] {LocalName} {Info.Uuid}#：下载源被禁用（{Info.Source.Id}）：{Info.Source.Url}") + Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug)) If IsSourceFailed() Then '没有可用源 Log("[Download] 文件 " & LocalName & " 已无可用下载源") @@ -1265,6 +1269,7 @@ Wrong: SyncLock NetTaskThreadCountLock NetTaskThreadCount -= 1 End SyncLock + '可能在没有下载完的时候开始合并文件了，这造成了大多数合并失败 If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge() End Try End Sub @@ -1287,7 +1292,6 @@ Wrong: Try Retry: SyncLock LockChain - If ModeDebug Then Log("[Download] " & LocalName & "：正在合并文件") '创建文件夹 If File.Exists(LocalPath) Then File.Delete(LocalPath) Dim Info As New FileInfo(LocalPath) @@ -1295,6 +1299,7 @@ Retry: '合并文件 If IsNoSplit Then '仅有一个线程，从缓存中输出 + If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件") MergeFile = New FileStream(LocalPath, FileMode.Create) AddWriter = New BinaryWriter(MergeFile) AddWriter.Write(SmailFileCache.ToArray) @@ -1302,17 +1307,19 @@ Retry: MergeFile.Dispose() : MergeFile = Nothing ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then '仅有一个文件，直接复制 + If ModeDebug Then Log($"[Download] {LocalName}：下载结束，仅有一个文件，无需合并") CopyFile(Threads.Temp, LocalPath) Else '有多个线程，合并 + If ModeDebug Then Log($"[Download] {LocalName}：下载结束，开始合并文件") MergeFile = New FileStream(LocalPath, FileMode.Create) AddWriter = New BinaryWriter(MergeFile) For Each Thread As NetThread In Threads If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read) - Dim TempReader As New BinaryReader(fs) - AddWriter.Write(TempReader.ReadBytes(fs.Length)) - TempReader.Close() + Using TempReader As New BinaryReader(fs) + AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone)) + End Using End Using Next AddWriter.Dispose() : AddWriter = Nothing @@ -1329,9 +1336,9 @@ Retry: '检查文件 Dim CheckResult As String = Check?.Check(LocalPath) If CheckResult IsNot Nothing Then - Log("[Download] " & Uuid & "# 的下载线程细节：") + Log($"[Download] {LocalName} 合并文件失败，下载线程细节：") For Each Th As NetThread In Threads - Log("[Download] " & Th.Uuid & "#，状态 " & GetStringFromEnum(CType(Th.State, [Enum])) & "，字节范围 " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & "，字节剩余 " & Th.DownloadUndone) + Log($"[Download] {Th.Uuid}#，状态 {GetStringFromEnum(Th.State)}，范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone}，完成 {Th.DownloadDone}，剩余 {Th.DownloadUndone}") Next Throw New Exception(CheckResult) End If @@ -1379,11 +1386,6 @@ Retry: SyncLock NetManager.LockRemain NetManager.FileRemain -= 1 Log("[Download] " & LocalName & "：已失败，剩余文件 " & NetManager.FileRemain) - 'If NetManage.FileRemainList.Contains(LocalPath) Then - ' NetManage.FileRemainList.Remove(LocalPath) - 'Else - ' Log("ERROR " & LocalPath) - 'End If End SyncLock For Each Task In Tasks Task.OnFileFail(Me) @@ -1396,7 +1398,7 @@ Retry: '确认任务移除 SyncLock LockTasks Tasks.Remove(CausedByTask) - If Tasks.Count > 0 Then Exit Sub + If Tasks.Any Then Exit Sub End SyncLock '确认中断 SyncLock LockState @@ -1406,11 +1408,6 @@ Retry: SyncLock NetManager.LockRemain NetManager.FileRemain -= 1 If ModeDebug Then Log("[Download] " & LocalName & "：已取消，剩余文件 " & NetManager.FileRemain) - 'If NetManage.FileRemainList.Contains(LocalPath) Then - ' NetManage.FileRemainList.Remove(LocalPath) - 'Else - ' Log("ERROR " & LocalPath) - 'End If End SyncLock End Sub @@ -1426,11 +1423,6 @@ Retry: SyncLock NetManager.LockRemain NetManager.FileRemain -= 1 If PrintLog Then Log("[Download] " & LocalName & "：已完成，剩余文件 " & NetManager.FileRemain) - 'If NetManage.FileRemainList.Contains(LocalPath) Then - ' NetManage.FileRemainList.Remove(LocalPath) - 'Else - ' Log("ERROR " & LocalPath) - 'End If End SyncLock SyncLock LockTasks For Each Task In Tasks @@ -1507,7 +1499,7 @@ FinishExCatch: #End Region ''' - ''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。 + ''' 刷新公开属性。由 NetManager 每 0.1 秒调用一次。 ''' Public Sub RefreshStat() '计算进度 @@ -1519,15 +1511,15 @@ FinishExCatch: NewProgress += File.Progress * 0.2 TotalProgress += 0.2 Else - NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1) + NewProgress += File.Progress TotalProgress += 1 End If Next End SyncLock If TotalProgress > 0 Then NewProgress /= TotalProgress '刷新进度 - If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001) - _Progress = NewProgress * 0.99 + 0.01 + If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况 + _Progress = NewProgress End Sub Public Sub New(Name As String, FileTasks As List(Of NetFile)) @@ -1556,71 +1548,72 @@ NextElement: End SyncLock State = LoadState.Loading '开始执行 - RunInNewThread(Sub() - Try - '输入检测 - If Not Files.Any() Then - OnFinish() - Exit Sub - End If - For Each File As NetFile In Files - If File Is Nothing Then Throw New ArgumentException("存在空文件请求！") - For Each Source As NetSource In File.Sources - If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then - Source.Ex = New ArgumentException("输入的下载链接不正确！") - Source.IsFailed = True - End If - Next - If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确！") - If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！") - If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！") - '文件夹检测 - Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName - If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath) - Next - '接入下载管理器 - NetManager.Start(Me) - '将文件分配给多个线程以进行已存在查找 - Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表 - Dim FoldersFinal As New List(Of String) '最终用于查找的列表 - If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制 - Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里 - For Each Folder In McFolderList - Folders.Add(Folder.Path) - Next - Folders = Folders.Distinct.ToList - For Each Folder In Folders - If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder) - Next - End If - '最多 5 个线程，最少每个线程分配 10 个文件 - SyncLock FilesLock - Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1) - Dim FilesInThread As New List(Of NetFile) - For Each File In Files - FilesInThread.Add(File) - If FilesInThread.Count = FilesPerThread Then - Dim FilesToRun As New List(Of NetFile) - FilesToRun.AddRange(FilesInThread) - RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) - FilesInThread.Clear() - End If - Next - If FilesInThread.Count > 0 Then - Dim FilesToRun As New List(Of NetFile) - FilesToRun.AddRange(FilesInThread) - RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) - FilesInThread.Clear() - End If - End SyncLock - Catch ex As Exception - OnFail(New List(Of Exception) From {ex}) - End Try - End Sub, "NetTask " & Uuid & " Main") + RunInNewThread( + Sub() + Try + '输入检测 + If Not Files.Any() Then + OnFinish() + Exit Sub + End If + For Each File As NetFile In Files + If File Is Nothing Then Throw New ArgumentException("存在空文件请求！") + For Each Source As NetSource In File.Sources + If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then + Source.Ex = New ArgumentException("输入的下载链接不正确！") + Source.IsFailed = True + End If + Next + If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确！") + If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！") + If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！") + '文件夹检测 + Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName + If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath) + Next + '接入下载管理器 + NetManager.Start(Me) + '将文件分配给多个线程以进行已存在查找 + Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表 + Dim FoldersFinal As New List(Of String) '最终用于查找的列表 + If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制 + Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里 + For Each Folder In McFolderList + Folders.Add(Folder.Path) + Next + Folders = Folders.Distinct.ToList + For Each Folder In Folders + If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder) + Next + End If + '最多 5 个线程，最少每个线程分配 10 个文件 + SyncLock FilesLock + Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1) + Dim FilesInThread As New List(Of NetFile) + For Each File In Files + FilesInThread.Add(File) + If FilesInThread.Count = FilesPerThread Then + Dim FilesToRun As New List(Of NetFile) + FilesToRun.AddRange(FilesInThread) + RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) + FilesInThread.Clear() + End If + Next + If FilesInThread.Any Then + Dim FilesToRun As New List(Of NetFile) + FilesToRun.AddRange(FilesInThread) + RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) + FilesInThread.Clear() + End If + End SyncLock + Catch ex As Exception + OnFail(New List(Of Exception) From {ex}) + End Try + End Sub, "NetTask " & Uuid & " Main") End Sub Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String)) Try - If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count) + If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count & "，线程名：" & Thread.CurrentThread.Name) '试图从已存在的 Minecraft 文件夹中寻找目标文件 Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String} For Each File As NetFile In Files @@ -1702,14 +1695,13 @@ Retry: If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")} '寻找第一个不是 404 的下载源 Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList - [Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0)) + [Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0)) '获取实际失败的文件 SyncLock FilesLock For Each File In Files If File.State = NetState.Error Then [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join( - File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")).ToList(), - vbCrLf), [Error]) + File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")), vbCrLf), [Error]) Exit For End If Next @@ -1794,9 +1786,9 @@ Retry: ''' Private SpeedLastDone As Long = 0 ''' - ''' 最近 10 次下载速度的记录，较新的在后面。间隔为 0.2 秒，故记录了 2 秒的速度。 + ''' 至多最近 30 次下载速度的记录，较新的在前面。 ''' - Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0} + Private SpeedLast As New List(Of Long) '这些属性由 RefreshStat 刷新 ''' ''' 当前的全局下载速度，单位为 Byte / 秒。 @@ -1808,28 +1800,29 @@ Retry: #End Region ''' - ''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。 + ''' 进度与下载速度由下载管理线程每隔约 0.1 秒刷新一次。 ''' Private Sub RefreshStat() Try Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast RefreshStatLast += DeltaTime #Region "刷新整体速度" - '计算即时速度 + '计算瞬时速度 Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)) - SpeedLast.Add(ActualSpeed) - SpeedLast.RemoveAt(0) + SpeedLast.Insert(0, ActualSpeed) + If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30) SpeedLastDone = DownloadDone '计算用于显示的速度 - 'If SpeedLast(9) = 0 Then - ' Speed = 0 - 'Else - Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5 - 'End If + Dim SpeedSum As Long = 0, SpeedDiv As Long = 0, Weight = SpeedLast.Count + For Each SpeedRecord In SpeedLast + SpeedSum += SpeedRecord * Weight + SpeedDiv += Weight + Weight -= 1 + Next + Speed = If(SpeedDiv > 0, SpeedSum / SpeedDiv, 0) '计算新的速度下限 - SpeedLast.Add(ActualSpeed) - SpeedLast.RemoveAt(0) - Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9 + Dim Limit As Long = 0 + If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85% If Limit > NetTaskSpeedLimitLow Then NetTaskSpeedLimitLow = Limit Log("[Download] " & "速度下限已提升到 " & GetString(Limit)) @@ -1854,128 +1847,65 @@ Retry: Private Sub StartManager() If IsManagerStarted Then Exit Sub IsManagerStarted = True - RunInNewThread( - Sub() + Dim ThreadStarter = + Sub(Id As Integer) '0 或 1 Try - Dim LastLoopTime As Long While True - LastLoopTime = GetTimeTick() + Thread.Sleep(20) '若已完成，则清空 - If FileRemain = 0 AndAlso Files.Count > 0 Then + If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then SyncLock LockFiles Files.Clear() End SyncLock End If - '开启新线程 - 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 = 0 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 + '获取文件列表 + Dim AllFiles As List(Of NetFile) + SyncLock LockFiles + AllFiles = Files.Values.ToList() + End SyncLock + Dim WaitingFiles As New List(Of NetFile) + Dim OngoingFiles As New List(Of NetFile) + For Each File As NetFile In AllFiles + If File.Uuid Mod 2 = Id Then Continue For + If File.State = NetState.WaitForDownload Then + WaitingFiles.Add(File) + ElseIf File.State < NetState.Merge Then + OngoingFiles.Add(File) + End If + Next + '为等待中的文件开始线程 + For Each File As NetFile In WaitingFiles + If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查 + Dim NewThread = File.TryBeginThread() + If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests + Next + '为进行中的文件追加线程 + If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增 + For Each File As NetFile In OngoingFiles + If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查 + '线程种类计数 + Dim PreparingCount = 0, DownloadingCount = 0 + If File.Threads IsNot Nothing Then + For Each Thread As NetThread In File.Threads.ToList + If Thread.State < NetState.Download Then + PreparingCount += 1 + ElseIf Thread.State = NetState.Download Then + DownloadingCount += 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 If + '新增线程 + If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增 + Dim NewThread = File.TryBeginThread() + If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests + Next End While Catch ex As Exception - Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert) + Log(ex, $"下载管理启动线程 {Id} 出错", 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 - '等待 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") + End Sub + RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0") + RunInNewThread(Sub() ThreadStarter(1), "NetManager ThreadStarter 1") RunInNewThread( Sub() Try @@ -1989,8 +1919,8 @@ Retry: NetTaskSpeedLimitLeftLast = TimeNow '刷新公开属性 RefreshStat() - '等待直至 170 ms - Do While GetTimeTick() - LastLoopTime < 170 + '等待直至 80 ms + Do While GetTimeTick() - LastLoopTime < 80 Thread.Sleep(10) Loop End While diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index cc112ad..a993f7b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -414,10 +414,10 @@ Json("Website") = Website If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate Json("DownloadCount") = DownloadCount - If ModLoaders IsNot Nothing AndAlso ModLoaders.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) + If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) Json("Tags") = New JArray(Tags) If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl - If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions) + If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions) Json("CacheTime") = Date.Now '用于检查缓存时间 Return Json End Function @@ -596,7 +596,7 @@ SubtitleList = SubtitleList.Distinct().ToList() '设置标题与描述 Dim Subtitle As String = "" - If SubtitleList.Count > 0 Then + If SubtitleList.Any Then For Each Ex In SubtitleList Dim IsModLoaderDescription As Boolean = Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt") @@ -1356,9 +1356,9 @@ Retry: Dim Info As String = "" Select Case Type Case CompType.Mod - Info += If(ModLoaders.Count > 0, + Info += If(ModLoaders.Any, "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "，", "") - Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod，", "") + Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod，", "") Case CompType.ModPack If GameVersions.All(Function(v) v.Contains("w")) Then Info += $"游戏版本 {Join(GameVersions, "、")}，" @@ -1452,7 +1452,7 @@ Retry: SelectMany(Function(f) f.RawDependencies).Distinct().ToList Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList '获取前置 Mod 工程信息 - If UndoneDeps.Count > 0 Then + If UndoneDeps.Any Then Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod：{Join(UndoneDeps, "，")}") Dim Projects As JArray If TargetProject.FromCurseForge Then @@ -1467,7 +1467,7 @@ Retry: Next End If '更新前置 Mod 信息 - If Deps.Count > 0 Then + If Deps.Any Then For Each DepProject In Deps.Select(Function(id) CompProjectCache(id)) For Each File In CompFilesCache(ProjectId) If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 01bba12..9ab3bb2 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -94,7 +94,7 @@ Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）") End Try Next - If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then + If LatestLog IsNot Nothing AndAlso LatestLog.Any Then Dim RawOutput As String = Join(LatestLog, vbCrLf) Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput) WriteFile(TempFolder & "RawOutput.log", RawOutput) @@ -110,21 +110,20 @@ Public Sub Import(FilePath As String) Log("[Crash] 步骤 1：自主导入日志文件") - '解压压缩包 + '尝试视作压缩包解压 Try Dim Info As New FileInfo(FilePath) - If Not Info.Exists OrElse Info.Length = 0 Then Exit Try - If Not FilePath.EndsWithF(".jar", True) AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then - '解压成功 + If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then + ExtractFile(FilePath, TempFolder & "Temp\") Log("[Crash] 已解压导入的日志文件：" & FilePath) - Else - '解压失败 - CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath)) - Log("[Crash] 已复制导入的日志文件：" & FilePath) + GoTo Extracted End If - Catch ex As Exception - Log(ex, "解压导入文件中的压缩包失败") + Catch End Try + '并非压缩包 + CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath)) + Log("[Crash] 已复制导入的日志文件：" & FilePath) +Extracted: '导入其中的日志文件 For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList() @@ -389,9 +388,9 @@ '1. 精准日志匹配，中/高优先级 AnalyzeCrit1() - If CrashReasons.Count > 0 Then GoTo Done + If CrashReasons.Any Then GoTo Done AnalyzeCrit2() - If CrashReasons.Count > 0 Then GoTo Done + If CrashReasons.Any Then GoTo Done '2. 堆栈分析 If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then @@ -406,7 +405,7 @@ If LogMc IsNot Nothing Then Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)") Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项") - If Fatals.Count > 0 Then + If Fatals.Any Then For Each Fatal In Fatals Keywords.AddRange(AnalyzeStackKeyword(Fatal)) Next @@ -419,7 +418,7 @@ Keywords.AddRange(AnalyzeStackKeyword(StackLogs)) End If 'Mod 名称分析 - If Keywords.Count > 0 Then + If Keywords.Any Then Dim Names = AnalyzeModName(Keywords) If Names Is Nothing Then AppendReason(CrashReason.堆栈分析发现关键字, Keywords) @@ -442,7 +441,7 @@ Done: Else Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因") For Each Reason In CrashReasons - Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "（" & Join(Reason.Value, "；") & "）", "")) + Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Join(Reason.Value, "；") & "）", "")) Next End If End Sub @@ -458,7 +457,7 @@ Done: Else CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}))) End If - Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "（" & Join(Additional, "；") & "）", "")) + Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Join(Additional, "；") & "）", "")) End Sub Private Sub AppendReason(Reason As CrashReason, Additional As String) AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional})) @@ -567,7 +566,6 @@ Done: End If End If If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) - If LogCrash.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) End If @@ -612,6 +610,9 @@ Done: If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)") AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray))) + Else + '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 + If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) End If '极短的程序输出 If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then @@ -678,7 +679,7 @@ NextStack: Next PossibleWords = PossibleWords.Distinct.ToList Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词") - If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", ")) + If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", ")) If PossibleWords.Count > 10 Then Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑") Return New List(Of String) @@ -847,7 +848,7 @@ NextStack: FileName = "游戏崩溃前的输出.txt" End Select If File.Exists(OutputFile) Then - WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile))) + WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*"))) End If Next '导出报告 @@ -903,7 +904,7 @@ NextStack: Results.Add("你正在使用 32 位的操作系统，这会导致 Minecraft 无法使用所需的内存，进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内，那或许只能换台电脑了……\h") End If Case CrashReason.Mod缺少前置或MC版本错误 - If Additional.Count > 0 Then + If Additional.Any Then Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n未满足的依赖项：\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index 9a725c5..237b084 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -79,7 +79,7 @@ Public Overrides Function ToString() As String Dim VersionString = Version.ToString If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3) - Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")，" & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, "，手动导入", "") & "：" & PathFolder + Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", "，32 位") & If(IsUserImport, "，手动导入", "") & "：" & PathFolder End Function '构造 @@ -220,7 +220,7 @@ Next '检查特定的 Java - If TargetJavaList.Count > 0 Then + If TargetJavaList.Any Then TargetJavaList = JavaCheckList(TargetJavaList) Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java：") For Each Java In TargetJavaList @@ -534,7 +534,7 @@ NoUserJava: Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接") JavaWithoutReparse.Add(Pair.Key, Pair.Value) Next - If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse + If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse '若不全为特殊引用，则清除特殊引用的地址 Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) @@ -546,7 +546,7 @@ NoUserJava: JavaWithoutInherit.Add(Pair.Key, Pair.Value) End If Next - If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit + If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit #End Region diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 383eb9a..ba856b5 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -62,7 +62,7 @@ Public Module ModLaunch ''' 记录启动日志。 ''' Public Sub McLaunchLog(Text As String) - Text = SecretFilter(Text) + Text = SecretFilter(Text, "*") RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text) Log("[Launch] " & Text) End Sub @@ -101,10 +101,10 @@ Public Module ModLaunch '正式加载 Try '构造主加载器 - Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", { - New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False, .Show = False}, + Dim Loaders As New List(Of LoaderBase) From { + New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False}, McLoginLoader, - New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True}, + New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False}, New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2}, New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, @@ -112,7 +112,12 @@ Public Module ModLaunch New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2}, New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1}, New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1} - }) With {.Show = False} + } + If Setup.Get("LaunchArgumentRam") Then + CType(Loaders(2), LoaderCombo(Of String)).Block = False + Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30}) + End If + Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False} If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器 '等待加载器执行并更新 UI McLaunchLoaderReal = LaunchLoader @@ -163,6 +168,28 @@ NextInner: #End Region +#Region "内存优化" + + Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer)) + McLaunchLog("内存优化开始") + Dim Finished As Boolean = False + RunInNewThread( + Sub() + PageOtherTest.MemoryOptimize(False) + Finished = True + End Sub, "Launch Memory Optimize") + Do While Not Finished AndAlso Not Loader.IsAborted + If Loader.Progress < 0.7 Then + Loader.Progress += 0.007 '10s + Else + Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005 + End If + Thread.Sleep(100) + Loop + End Sub + +#End Region + #Region "预检测" Private Sub McLaunchPrecheck() @@ -247,7 +274,7 @@ NextInner: ''' Public BaseUrl As String ''' - ''' 登录所使用的标识符，如 “Mojang”、“Nide”，用于存储缓存等。 + ''' 登录所使用的标识符，目前只可能为 “Auth” 或 “Nide”，用于存储缓存等。 ''' Public Token As String ''' @@ -526,7 +553,13 @@ SkipLogin: McLaunchLog("登录方式：" & Input.Description & "（" & LogUsername & "）") Data.Progress = 0.05 '尝试登录 - If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then + If (Not Data.Input.ForceReselectProfile) AndAlso + Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso + Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso + Setup.Get("Cache" & Input.Token & "Access") <> "" AndAlso + Setup.Get("Cache" & Input.Token & "Client") <> "" AndAlso + Setup.Get("Cache" & Input.Token & "Uuid") <> "" AndAlso + Setup.Get("Cache" & Input.Token & "Name") <> "" Then '尝试验证登录 Try If Data.IsAborted Then Throw New ThreadInterruptedException @@ -990,14 +1023,14 @@ SystemBrowser: Case 1 'Steve Do Until McSkinSex(Uuid) = "Steve" - If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000" - Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X") + If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000" + Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0") Loop Case 2 'Alex Do Until McSkinSex(Uuid) = "Alex" - If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000" - Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X") + If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000" + Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0") Loop Case 3 '使用正版用户名 @@ -1096,22 +1129,25 @@ SystemBrowser: If McVersionCurrent.Version.HasForge Then If McVersionCurrent.Version.McName = "1.7.2" Then '1.7.2：必须 Java 7 - MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999) + MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer) + MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer) ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then '<=1.12：Java 8 MaxVer = New Version(1, 8, 999, 999) ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then '1.13 - 1.14：Java 8 - 10 - MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999) + MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) + MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer) ElseIf McVersionCurrent.Version.McCodeMain = 15 Then '1.15：Java 8 - 15 - MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999) + MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) + MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer) ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then '1.16，Forge 34.X ~ 36.2.25：最高 Java 8u320 - MaxVer = New Version(1, 8, 0, 320) + MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer) ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305 '1.18：若安装了 OptiFine，最高 Java 18 - MaxVer = New Version(1, 18, 999, 999) + MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer) End If End If @@ -1119,10 +1155,10 @@ SystemBrowser: If McVersionCurrent.Version.HasFabric Then If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then '1.15 - 1.16：Java 8+ - MinVer = New Version(1, 8, 0, 0) + MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then '1.18+：Java 17+ - MinVer = New Version(1, 17, 0, 0) + MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer) End If End If @@ -1202,17 +1238,20 @@ SystemBrowser: ''' Public Function ExtractJavaWrapper() As String Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar" - WriteFile(WrapperPath, GetResources("JavaWrapper")) + SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 + WriteFile(WrapperPath, GetResources("JavaWrapper")) + End SyncLock Log("[Java] 已释放 Java Wrapper：" & WrapperPath) Return WrapperPath End Function + Private ExtractJavaWrapperLock As New Object ''' ''' 获取 Java Wrapper 所在的文件夹，不以 \ 结尾。 ''' Public Function GetJavaWrapperDir() As String - If Encoding.UTF8.GetByteCount(PathAppdata) = PathAppdata.Length Then + If PathAppdata.IsASCII() Then Return PathAppdata.TrimEnd("\") - ElseIf Encoding.UTF8.GetByteCount(PathTemp) = PathTemp.Length Then + ElseIf PathTemp.IsASCII() Then Log("[Java] Wrapper：AppData 路径中包含非 ASCII 字符，换用 Temp 目录") Return PathTemp.TrimEnd("\") Else @@ -1276,9 +1315,7 @@ SystemBrowser: '不包含端口号 Arguments += " --server " & Server & " --port 25565" End If - If McVersionCurrent.Version.HasOptiFine Then 'OptiFine 警告 - Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical) - End If + If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical) End If End If '自定义 @@ -1300,10 +1337,11 @@ SystemBrowser: Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent) If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm") If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true" + ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理 DataList.Insert(0, ArgumentJvm) '可变 JVM 参数 - DataList.Add("-Xmn256m") + DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m") DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m") - DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""") + DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """") DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表 '统一通行证 @@ -1415,6 +1453,9 @@ NextVersion: DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu=")) Next + '#3511 的清理 + DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M") + '去重 Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ") @@ -1535,7 +1576,7 @@ NextVersion: '基础参数 GameArguments.Add("${classpath_separator}", ";") - GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives") + GameArguments.Add("${natives_directory}", GetNativesFolder()) GameArguments.Add("${library_directory}", PathMcFolder & "libraries") GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries") GameArguments.Add("${launcher_name}", "PCL") @@ -1552,9 +1593,26 @@ NextVersion: GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken) GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken) GameArguments.Add("${user_type}", "msa") '#1221 - Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize() - GameArguments.Add("${resolution_width}", GameSize.Width) - GameArguments.Add("${resolution_height}", GameSize.Height) + + '窗口尺寸参数 + Dim GameSize As Size + Select Case Setup.Get("LaunchArgumentWindowType") + Case 2 + Dim Result As Size + RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight))) + GameSize = Result + Case 3 + GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth") - 2), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight") - 2)) + Case Else + GameSize = New Size(875 - 2, 540 - 2) + End Select + GameSize.Height -= 29.5 * DPI / 96 '标题栏高度 + If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍 + GameSize.Width /= DPI / 96 + GameSize.Height /= DPI / 96 + End If + GameArguments.Add("${resolution_width}", Math.Round(GameSize.Width)) + GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height)) 'Assets 相关参数 GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并 @@ -1586,7 +1644,8 @@ NextVersion: Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer)) '创建文件夹 - Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives") + Dim Target As String = GetNativesFolder() & "\" + Directory.CreateDirectory(Target) '解压文件 McLaunchLog("正在解压 Natives 文件") @@ -1605,7 +1664,7 @@ NextVersion: Dim FileName As String = Entry.FullName If FileName.EndsWithF(".dll", True) Then '实际解压文件的步骤 - Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName + Dim FilePath As String = Target & FileName ExistFiles.Add(FilePath) Dim OriginalFile As New FileInfo(FilePath) If OriginalFile.Exists Then @@ -1631,7 +1690,7 @@ NextVersion: Next '删除多余文件 - For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives") + For Each FileName As String In Directory.GetFiles(Target) If ExistFiles.Contains(FileName) Then Continue For Try McLaunchLog("删除：" & FileName) @@ -1644,6 +1703,16 @@ NextVersion: Next End Sub + ''' + ''' 获取 Natives 文件夹路径，不以 \ 结尾。 + ''' + Private Function GetNativesFolder() As String + Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives" + If IsGBKEncoding OrElse Result.IsASCII() Then Return Result + Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives" + If Result.IsASCII() Then Return Result + Return OsDrive & "ProgramData\PCL\natives" + End Function #End Region @@ -1758,7 +1827,7 @@ NextVersion: Select Case Setup.Get("LaunchArgumentWindowType") Case 0 '全屏 WriteIni(SetupFileAddress, "fullscreen", "true") - Case 5 '保持默认 + Case 1 '默认 Case Else '其他 WriteIni(SetupFileAddress, "fullscreen", "false") End Select @@ -1936,7 +2005,7 @@ IgnoreCustomSkin: """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & "echo 游戏已退出。" & vbCrLf & "pause" - WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString), + WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"), Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030"))) If McLaunchLoader.Input.SaveBatch IsNot Nothing Then McLaunchLog("导出启动脚本完成，强制结束启动过程") @@ -2058,7 +2127,7 @@ IgnoreCustomSkin: McLaunchLog("") McLaunchLog("~ 基础参数 ~") McLaunchLog("PCL 版本：" & VersionDisplayName & " (" & VersionCode & ")") - McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）") + McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）") McLaunchLog("资源版本：" & McAssetsGetIndexName(McVersionCurrent)) McLaunchLog("版本继承：" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion)) McLaunchLog("分配的内存：" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）") @@ -2068,6 +2137,7 @@ IgnoreCustomSkin: McLaunchLog("HMCL 格式：" & McVersionCurrent.IsHmclFormatJson) McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java")) McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置")) + McLaunchLog("Natives 文件夹：" & GetNativesFolder()) McLaunchLog("") McLaunchLog("~ 登录参数 ~") McLaunchLog("玩家用户名：" & McLoginLoader.Output.Name) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index 1f25858..0014d14 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -181,7 +181,7 @@ If AniControlEnabled = 0 AndAlso Setup.Get("VersionServerAuthServer", Version:=value) <> Setup.Get("CacheAuthServerServer") AndAlso Setup.Get("VersionServerLogin", Version:=value) = 4 Then - Setup.Set("CacheNideServer", "") + Setup.Set("CacheAuthAccess", "") Log("[Launch] 服务器改变，要求重新登录 Authlib-Injector") End If If Setup.Get("VersionServerLogin", Version:=value) = 4 Then @@ -216,8 +216,8 @@ '尚未判断 Dim ModFolder As New DirectoryInfo(Path & "mods\") Dim SaveFolder As New DirectoryInfo(Path & "saves\") - If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse - (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then + If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse + (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then '自动开启 Setup.Set("VersionArgumentIndie", 1, Version:=Me) Log("[Setup] 已自动开启单版本隔离：" & Name) @@ -1234,7 +1234,7 @@ OnLoaded: For Each Version As McVersion In VersionList If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version) Next - If StaredVersions.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) + If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) '预先筛选出愚人节的版本 McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error) @@ -1308,8 +1308,8 @@ OnLoaded: '将剩余的东西添加进去 VersionRubbish.AddRange(VersionList) - If VersionUseful.Count > 0 Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful) - If VersionRubbish.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish) + If VersionUseful.Any Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful) + If VersionRubbish.Any Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish) '按照自定义版本分类重新添加 For Each VersionPair In VersionListOriginal @@ -1429,7 +1429,7 @@ OnLoaded: NextVersion: Next '加入版本列表，并从剩余中删除 - If KeepList.Count > 0 Then + If KeepList.Any Then Target.Add(CardType, KeepList) For Each Version As McVersion In KeepList VersionList.Remove(Version) @@ -1450,7 +1450,7 @@ NextVersion: Next NextVersion: Next - If KeepList.Count > 0 Then + If KeepList.Any Then For Each Version As McVersion In KeepList VersionList.Remove(Version) Next @@ -1515,7 +1515,7 @@ NextVersion: ''' Public Function McSkinGetAddress(Uuid As String, Type As String) As String If Uuid = "" Then Throw New Exception("Uuid 为空。") - If Uuid.StartsWithF("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。") + If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。") '尝试读取缓存 Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid) If Not CacheSkinAddress = "" Then Return CacheSkinAddress @@ -2048,8 +2048,7 @@ NextVersion: If Version.InheritVersion = "" Then Exit Do Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion) Loop - Catch ex As Exception - Log(ex, "获取资源文件索引下载地址失败") + Catch End Try '无法获取到下载地址 If ReturnLegacyOnError Then @@ -2239,10 +2238,11 @@ NextVersion: '弹窗结果 If MsgResult = 2 Then '下载 - RunInUi(Sub() - PageDownloadInstall.McVersionWaitingForSelect = VersionName - FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) - End Sub) + RunInUi( + Sub() + PageDownloadInstall.McVersionWaitingForSelect = VersionName + FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) + End Sub) End If Catch ex As Exception diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 1a05fe3..040e9d5 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -337,7 +337,7 @@ Public Module ModMod For Each Token In AuthorJson Author.Add(Token.ToString) Next - If Author.Count > 0 Then Authors = Join(Author, ", ") + If Author.Any Then Authors = Join(Author, ", ") End If Dim Reqs As JArray = InfoObject("requiredMods") If Reqs IsNot Nothing Then @@ -393,7 +393,7 @@ GotFabric: For Each Token In AuthorJson Author.Add(Token.ToString) Next - If Author.Count > 0 Then Authors = Join(Author, ", ") + If Author.Any Then Authors = Join(Author, ", ") End If 'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then ' '添加 Minecraft 依赖 @@ -438,7 +438,7 @@ GotFabric: Line = Line.Substring(0, Line.IndexOfF("#")) End If Line = Line.Trim(New Char() {" "c, " "c, "　"c}) '去除头尾的空格 - If Line.Count > 0 Then Lines.Add(Line) '去除空行 + If Line.Any Then Lines.Add(Line) '去除空行 Next '读取文件数据 Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))} @@ -925,7 +925,7 @@ Finished: End Sub '联网加载 Mod 详情 - Private Const LocalModCacheVersion As Integer = 2 + Private Const LocalModCacheVersion As Integer = 3 Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Dim Mods As List(Of McMod) = Loader.Input.Key @@ -965,6 +965,7 @@ Finished: Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod)) For Each Entry In Mods If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For + If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存，加快结果出现速度 If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index 9cc2d6f..bcd878c 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -244,16 +244,17 @@ Retry: ModList.Add(ModEntry("fileID")) If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID")) Next - If ModList.Count > 0 Then + If ModList.Any Then + Dim ModDownloadLoaders As New List(Of LoaderBase) '获取 Mod 下载信息 - InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", + ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", Sub(Task As LoaderTask(Of Integer, JArray)) Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data") '如果文件已被删除，则 API 会跳过那一项 If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本") End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s '构造 NetFile - InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息", + ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息", Sub(Task As LoaderTask(Of JArray, List(Of NetFile))) Dim FileList As New Dictionary(Of Integer, NetFile) For Each ModJson In Task.Input @@ -288,7 +289,10 @@ Retry: Task.Output = FileList.Values.ToList End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s '下载 Mod 文件 - InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s + ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s + '构造加载器 + InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod（主加载器）", ModDownloadLoaders) With + {.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)}) End If '构造加载器 @@ -299,43 +303,35 @@ Retry: .ForgeVersion = ForgeVersion, .FabricVersion = FabricVersion } - Dim InstallExpectTime As Double = 0 - For Each InstallLoader In InstallLoaders - InstallExpectTime += InstallLoader.ProgressWeight - Next Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) If MergeLoaders Is Nothing Then Exit Sub - Dim MergeExpectTime As Double = 0 - For Each MergeLoader In MergeLoaders - MergeExpectTime += MergeLoader.ProgressWeight - Next - '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + '构造 Libraries 加载器 Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) '构造总加载器 Dim Loaders As New List(Of LoaderBase) - Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime}) - Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)}) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", - Sub(Task As LoaderTask(Of String, String)) - '设置图标 - Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" - If Logo IsNot Nothing AndAlso File.Exists(Logo) Then - File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) - WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") - WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") - Log("[ModPack] 已设置整合包 Logo：" & Logo) - End If - '删除原始整合包文件 - For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} - If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then - Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target) - File.Delete(Target) - End If - Next - End Sub) With {.ProgressWeight = 0.1, .Show = False}) + Sub(Task As LoaderTask(Of String, String)) + '设置图标 + Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" + If Logo IsNot Nothing AndAlso File.Exists(Logo) Then + File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) + WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") + WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") + Log("[ModPack] 已设置整合包 Logo：" & Logo) + End If + '删除原始整合包文件 + For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} + If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then + Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target) + File.Delete(Target) + End If + Next + End Sub) With {.ProgressWeight = 0.1, .Show = False}) '重复任务检查 Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " " @@ -438,10 +434,10 @@ Retry: End If '添加下载文件 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), True)) + PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString, + New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True)) Next - If FileList.Count > 0 Then + If FileList.Any Then InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s End If @@ -453,43 +449,35 @@ Retry: .ForgeVersion = ForgeVersion, .FabricVersion = FabricVersion } - Dim InstallExpectTime As Double = 0 - For Each InstallLoader In InstallLoaders - InstallExpectTime += InstallLoader.ProgressWeight - Next Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) If MergeLoaders Is Nothing Then Exit Sub - Dim MergeExpectTime As Double = 0 - For Each MergeLoader In MergeLoaders - MergeExpectTime += MergeLoader.ProgressWeight - Next - '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + '构造 Libraries 加载器 Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) '构造总加载器 Dim Loaders As New List(Of LoaderBase) - Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime}) - Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)}) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", - Sub(Task As LoaderTask(Of String, String)) - '设置图标 - Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" - If Logo IsNot Nothing AndAlso File.Exists(Logo) Then - File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) - WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") - WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") - Log("[ModPack] 已设置整合包 Logo：" & Logo) - End If - '删除原始整合包文件 - For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} - If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then - Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target) - File.Delete(Target) - End If - Next - End Sub) With {.ProgressWeight = 0.1, .Show = False}) + Sub(Task As LoaderTask(Of String, String)) + '设置图标 + Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" + If Logo IsNot Nothing AndAlso File.Exists(Logo) Then + File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) + WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") + WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") + Log("[ModPack] 已设置整合包 Logo：" & Logo) + End If + '删除原始整合包文件 + For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} + If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then + Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target) + File.Delete(Target) + End If + Next + End Sub) With {.ProgressWeight = 0.1, .Show = False}) '重复任务检查 Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " " @@ -554,16 +542,8 @@ Retry: .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .MinecraftName = Json("gameVersion").ToString } - Dim InstallExpectTime As Double = 0 - For Each InstallLoader In InstallLoaders - InstallExpectTime += InstallLoader.ProgressWeight - Next Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) If MergeLoaders Is Nothing Then Exit Sub - Dim MergeExpectTime As Double = 0 - For Each MergeLoader In MergeLoaders - MergeExpectTime += MergeLoader.ProgressWeight - Next '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）", @@ -584,8 +564,8 @@ Retry: LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) '构造总加载器 Dim Loaders As New List(Of LoaderBase) From { - New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}, - New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}, + New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}, + New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)}, New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8} } @@ -704,24 +684,16 @@ Retry: End Select Next '构造加载器 - Dim InstallExpectTime As Double = 0 - For Each InstallLoader In InstallLoaders - InstallExpectTime += InstallLoader.ProgressWeight - Next Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) If MergeLoaders Is Nothing Then Exit Sub - Dim MergeExpectTime As Double = 0 - For Each MergeLoader In MergeLoaders - MergeExpectTime += MergeLoader.ProgressWeight - Next - '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + '构造 Libraries 加载器 Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) '构造总加载器 Dim Loaders As New List(Of LoaderBase) - Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}) - Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) '重复任务检查 @@ -802,24 +774,16 @@ Retry: .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing), .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) } - Dim InstallExpectTime As Double = 0 - For Each InstallLoader In InstallLoaders - InstallExpectTime += InstallLoader.ProgressWeight - Next Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) If MergeLoaders Is Nothing Then Exit Sub - Dim MergeExpectTime As Double = 0 - For Each MergeLoader In MergeLoaders - MergeExpectTime += MergeLoader.ProgressWeight - Next - '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + '构造 Libraries 加载器 Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) '构造总加载器 Dim Loaders As New List(Of LoaderBase) - Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}) - Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) '重复任务检查 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index 2c63b18..c4e5c55 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -276,17 +276,18 @@ IsWindowFinished = True '最大化 If Setup.Get("LaunchArgumentWindowType") = 4 Then - RunInNewThread(Sub() - Try - '如果最大化导致屏幕渲染大小不对，那是 MC 的 Bug，不是我的 Bug - '……虽然我很想这样说，但总有人反馈，算了 - Thread.Sleep(2000) - ShowWindow(WindowHandle, 3) - WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}") - Catch ex As Exception - Log(ex, "最大化 Minecraft 窗口时出现错误") - End Try - End Sub, "MinecraftWindowMaximize") + RunInNewThread( + Sub() + Try + '如果最大化导致屏幕渲染大小不对，那是 MC 的 Bug，不是我的 Bug + '……虽然我很想这样说，但总有人反馈，算了 + Thread.Sleep(2000) + ShowWindow(WindowHandle, 3) + WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}") + Catch ex As Exception + Log(ex, "最大化 Minecraft 窗口时出现错误") + End Try + End Sub, "MinecraftWindowMaximize") End If ElseIf Not IsWindowAppeared Then '已找到 FML 窗口 diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index aecafd2..860a967 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -266,7 +266,7 @@ Public Module ModMusic Thread.Sleep(100) End While '当前音乐已播放结束，继续下一曲 - If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress) + If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress) Catch ex As Exception Log("[Music] 播放音乐失败的文件完整路径：" & MusicCurrent) If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index 49ea2bc..e657d2d 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -8,11 +8,11 @@ Imports System.Runtime.InteropServices '查看程序集特性的值 - + - - + + @@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 方法是按如下所示使用“*” - - + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb index 48560e0..5a8f8e9 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -487,7 +487,7 @@ Public Module ModDownloadLib outputWaitHandle.WaitOne(10000) errorWaitHandle.WaitOne(10000) process.Dispose() - If TotalLength < 1000 Then Throw New Exception("安装器运行出错，末行为 " & LastResult) + If TotalLength < 1000 OrElse LastResult.Contains("at ") Then Throw New Exception("安装器运行出错，末行为 " & LastResult) End Using End Using End SyncLock @@ -538,7 +538,7 @@ Public Module ModDownloadLib 'OptiFine 中文镜像源 Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile) '构造文件请求 - Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))} + Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} End Sub) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载", @@ -548,8 +548,8 @@ Public Module ModDownloadLib 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] OptiFine 安装正在等待原版文件下载完成") - Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted + If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成") + Do While TargetLoaders.Any AndAlso Not Task.IsAborted TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList Thread.Sleep(50) Loop @@ -560,12 +560,10 @@ Public Module ModDownloadLib Dim ClientName As String = GetFolderNameFromPath(ClientFolder) Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then - CopyFile(ClientFolder & ClientName & ".json", - McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") + CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json") End If If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then - CopyFile(ClientFolder & ClientName & ".jar", - McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") + CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar") End If End SyncLock End Sub) With {.ProgressWeight = 0.1, .Show = False}) @@ -1283,20 +1281,20 @@ Retry: '获取下载信息 If DownloadInfo Is Nothing Then Loaders.Add(New LoaderTask(Of String, String)("获取 Mod 加载器详细信息", - Sub(Task As LoaderTask(Of String, String)) - '获取 Forge 版本列表 - Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain) - ForgeLoader.WaitForExit(Inherit) - Task.Progress = 0.8 - '查找对应版本 - For Each ForgeVersion In ForgeLoader.Output - If ForgeVersion.Version = Version Then - DownloadInfo = ForgeVersion - Exit Sub - End If - Next - Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息！") - End Sub) With {.ProgressWeight = 3}) + Sub(Task As LoaderTask(Of String, String)) + '获取 Forge 版本列表 + Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain) + ForgeLoader.WaitForExit(Inherit) + Task.Progress = 0.8 + '查找对应版本 + For Each ForgeVersion In ForgeLoader.Output + If ForgeVersion.Version = Version Then + DownloadInfo = ForgeVersion + Exit Sub + End If + Next + Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息！") + End Sub) With {.ProgressWeight = 3}) End If '下载 Forge 主文件 Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载", @@ -1383,8 +1381,8 @@ Retry: 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 + If TargetLoaders.Any Then Log("[Download] Forge 安装正在等待原版文件下载完成") + Do While TargetLoaders.Any AndAlso Not Task.IsAborted TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList Thread.Sleep(50) Loop @@ -1441,7 +1439,7 @@ Retry: 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，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空 @@ -1537,7 +1535,7 @@ Retry: Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entrys As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) '获取推荐版本与最新版本 Dim FreshVersion As DlForgeVersionEntry = Nothing - If Entrys.Count > 0 Then + If Entrys.Any Then FreshVersion = Entrys(0) Else Log("[System] 未找到可用的 Forge 版本", LogLevel.Debug) @@ -2014,7 +2012,7 @@ Retry: Dim LoaderList As New List(Of LoaderBase) '添加忽略标识 - LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False}) + LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False}) 'Fabric API If Request.FabricApi IsNot Nothing Then LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False}) @@ -2164,7 +2162,7 @@ Retry: For i = 0 To RawArguments.Count - 1 If RawArguments(i).StartsWithF("-") Then SplitArguments.Add(RawArguments(i)) - ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then + ElseIf SplitArguments.Any AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i) Else SplitArguments.Add(RawArguments(i)) @@ -2172,6 +2170,7 @@ Retry: Next Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ") '合并 + '相关讨论见 #2801 OutputJson = MinecraftJson If HasOptiFine Then '合并 OptiFine diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb index 2434192..56959a5 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb @@ -210,10 +210,10 @@ If Project.Type = CompType.Mod Then '获取 Mod 所需的加载器种类 Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing - If File.ModLoaders.Count > 0 Then '从文件中获取 + If File.ModLoaders.Any Then '从文件中获取 AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric) - ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取 + ElseIf Project.ModLoaders.Any Then '从工程中获取 AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric) End If diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml index ec68dd9..f7333fe 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml @@ -20,7 +20,6 @@ - diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb index 1c6f77b..edfd0af 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb @@ -32,7 +32,7 @@ #Region "页面切换" '页面切换动画 - Private IsInSelectPage As Boolean = False + Public IsInSelectPage As Boolean = False Private IsFirstLoaded As Boolean = False Private Sub EnterSelectPage() If IsInSelectPage Then Exit Sub @@ -273,11 +273,13 @@ End If End Sub + Private IsReloading As Boolean = False '#3742 中，LoadOptiFineGetError 会初始化 LoadOptiFine，触发事件 LoadOptiFine.StateChanged，导致再次调用 SelectReload ''' ''' 重载已选择的项目的显示。 ''' Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged - If SelectedMinecraftId Is Nothing Then Exit Sub + If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub + IsReloading = True '主预览 SelectNameUpdate() ItemSelect.Title = TextSelectName.Text @@ -385,17 +387,12 @@ '主警告 HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed) If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then - If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then - HintOptiFabric.Visibility = Visibility.Collapsed - HintOptiFabricOld.Visibility = Visibility.Visible - Else - HintOptiFabric.Visibility = Visibility.Visible - HintOptiFabricOld.Visibility = Visibility.Collapsed - End If + HintOptiFabric.Visibility = Visibility.Visible Else HintOptiFabric.Visibility = Visibility.Collapsed - HintOptiFabricOld.Visibility = Visibility.Collapsed End If + '结束 + IsReloading = False End Sub ''' ''' 清空已选择的项目。 @@ -1037,7 +1034,6 @@ ''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。 ''' Private Function LoadOptiFabricGetError() As String - If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric，请手动下载 OptiFabric Origins" If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFabric.State, Object).Error.Message If DlOptiFabricLoader.Output Is Nothing Then diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml index 92b0585..814d1c8 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml @@ -35,7 +35,6 @@ - @@ -44,11 +43,9 @@ - - @@ -122,4 +119,4 @@ - + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml index 26bdd3c..a59954f 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml @@ -34,7 +34,6 @@ - @@ -43,11 +42,9 @@ - - @@ -111,4 +108,4 @@ - + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb index 8ea7421..1cc46fe 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -19,51 +19,53 @@ RefreshButtonsUI() '加载版本 - RunInNewThread(Sub() - '确认 Minecraft 文件夹存在 - PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) - If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then - '无效的文件夹 - If PathMcFolder = "" Then - Log("[Launch] 没有已储存的 Minecraft 文件夹") - Else - Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug) - End If - McFolderListLoader.WaitForExit(IsForceRestart:=True) - Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) - End If - Log("[Launch] Minecraft 文件夹：" & PathMcFolder) - If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) - '确认 Minecraft 版本存在 - Dim Selection As String = Setup.Get("LaunchVersionSelect") - Dim Version As McVersion - If Selection = "" Then - Version = Nothing - Else - Version = New McVersion(Selection) - End If - If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then - '无效的版本 - Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) - If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) - If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then - Version = Nothing - Setup.Set("LaunchVersionSelect", "") - Log("[Launch] 无可用 Minecraft 版本") - Else - Version = McVersionList.First.Value(0) - Setup.Set("LaunchVersionSelect", Version.Name) - Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path) - End If - End If - RunInUi(Sub() - McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变 - IsLoadFinished = True - RefreshButtonsUI() - RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新 - If McLoginAble() = "" Then McLoginLoader.Start() '自动登录 - End Sub) - End Sub, "Version Check", ThreadPriority.AboveNormal) + RunInNewThread( + Sub() + '确认 Minecraft 文件夹存在 + PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) + If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then + '无效的文件夹 + If PathMcFolder = "" Then + Log("[Launch] 没有已储存的 Minecraft 文件夹") + Else + Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug) + End If + McFolderListLoader.WaitForExit(IsForceRestart:=True) + Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) + End If + Log("[Launch] Minecraft 文件夹：" & PathMcFolder) + If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) + '确认 Minecraft 版本存在 + Dim Selection As String = Setup.Get("LaunchVersionSelect") + Dim Version As McVersion + If Selection = "" Then + Version = Nothing + Else + Version = New McVersion(Selection) + End If + If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then + '无效的版本 + Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) + If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) + If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then + Version = Nothing + Setup.Set("LaunchVersionSelect", "") + Log("[Launch] 无可用 Minecraft 版本") + Else + Version = McVersionList.First.Value(0) + Setup.Set("LaunchVersionSelect", Version.Name) + Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path) + End If + End If + RunInUi( + Sub() + McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变 + IsLoadFinished = True + RefreshButtonsUI() + RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新 + If McLoginAble() = "" Then McLoginLoader.Start() '自动登录 + End Sub) + End Sub, "Version Check", ThreadPriority.AboveNormal) '改变页面 Dim LoginType As McLoginType = Setup.Get("LoginType") diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb index bae5e07..64d755f 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -67,7 +67,7 @@ Download: End If Case 3 Select Case Setup.Get("UiCustomPreset") - Case 0 '你知道吗 + Case 0 Log("[Page] 主页预设：你知道吗") Content = " @@ -76,7 +76,7 @@ Download: EventType=""刷新主页"" EventData=""/"" Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" /> " - Case 1 '回声洞 + Case 1 Log("[Page] 主页预设：回声洞") Content = " @@ -85,17 +85,17 @@ Download: EventType=""刷新主页"" EventData=""/"" Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" /> " - Case 2 '新闻 + Case 2 Log("[Page] 主页预设：Minecraft 新闻") Url = "http://pcl.mcnews.thestack.top" GoTo Download - Case 3 '简单主页 + Case 3 Log("[Page] 主页预设：简单主页") Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml" GoTo Download - Case 4 '历史上的今天 - Log("[Page] 主页预设：历史上的今天") - Url = "https://pclnews.52chye.cn/custom.xaml" + Case 4 + Log("[Page] 主页预设：每日整合包推荐") + Url = "https://pclsub.sodamc.com/" GoTo Download End Select End Select diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb index 6d3ee42..15a3581 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb @@ -85,50 +85,51 @@ Hint("正在更改皮肤……") IsChanging = True '开始实际获取 - RunInNewThread(Async Sub() - Try + RunInNewThread( + Async Sub() + Try Retry: - If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束 - Dim AccessToken As String = Setup.Get("CacheMsAccess") - Dim Uuid As String = Setup.Get("CacheMsUuid") + If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束 + Dim AccessToken As String = Setup.Get("CacheMsAccess") + Dim Uuid As String = Setup.Get("CacheMsUuid") - Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)} - Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) - Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*")) - Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) - Dim Contents As New Net.Http.MultipartFormDataContent From { - {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, - {New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} - } - Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync - If Result.Contains("request requires user authentication") Then - Hint("正在登录，将在登录完成后继续更改皮肤……") - McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) - GoTo Retry - ElseIf Result.Contains("""error""") Then - Hint("更改皮肤失败：" & GetJson(Result)("error"), HintType.Critical) - Exit Sub - End If - '获取新皮肤地址 - Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result) - Dim ResultJson As JObject = GetJson(Result) - For Each Skin As JObject In ResultJson("skins") - If Skin("state").ToString = "ACTIVE" Then - MySkin.ReloadCache(Skin("url")) - Exit Sub - End If - Next - Throw New Exception("未知错误（" & Result & "）") - Catch ex As Exception - If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then - Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical) - Else - Log(ex, "更改皮肤失败", LogLevel.Hint) - End If - Finally - IsChanging = False - End Try - End Sub, "Ms Skin Upload") + Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)} + Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) + Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*")) + Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) + Dim Contents As New Net.Http.MultipartFormDataContent From { + {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, + {New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} + } + Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync + If Result.Contains("request requires user authentication") Then + Hint("正在登录，将在登录完成后继续更改皮肤……") + McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) + GoTo Retry + ElseIf Result.Contains("""error""") Then + Hint("更改皮肤失败：" & GetJson(Result)("error"), HintType.Critical) + Exit Sub + End If + '获取新皮肤地址 + Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result) + Dim ResultJson As JObject = GetJson(Result) + For Each Skin As JObject In ResultJson("skins") + If Skin("state").ToString = "ACTIVE" Then + MySkin.ReloadCache(Skin("url")) + Exit Sub + End If + Next + Throw New Exception("未知错误（" & Result & "）") + Catch ex As Exception + If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then + Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical) + Else + Log(ex, "更改皮肤失败", LogLevel.Hint) + End If + Finally + IsChanging = False + End Try + End Sub, "Ms Skin Upload") End Sub '保存皮肤 diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb index 9848581..ac127bf 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb @@ -237,7 +237,7 @@ If Not Version.Modable Then Continue For '4. 该版本的隔离文件夹下不存在 mods Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\") - If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Count > 0 Then Exit Sub + If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub '满足以上全部条件则视为根目录整合包 Setup.Set("VersionArgumentIndie", 2, Version:=Version) Log("[Setup] 已自动关闭单版本隔离：" & Version.Name, LogLevel.Debug) diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml index 8e9be7c..f4ff7e8 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -115,7 +115,7 @@ - + @@ -125,11 +125,10 @@ - - - + + + - @@ -138,7 +137,7 @@ + ToolTip="Forge 1.12.2 等个别版本存在 Bug，会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5"> @@ -175,11 +174,16 @@ + + + @@ -229,7 +233,7 @@ - diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb index 20e888e..99b962a 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb @@ -38,6 +38,7 @@ ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType") TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth") TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight") + CheckArgumentRam.Checked = Setup.Get("LaunchArgumentRam") RefreshJavaComboBox() '游戏内存 @@ -71,6 +72,7 @@ Setup.Reset("LaunchArgumentWindowWidth") Setup.Reset("LaunchArgumentWindowHeight") Setup.Reset("LaunchArgumentPriority") + Setup.Reset("LaunchArgumentRam") Setup.Reset("LaunchRamType") Setup.Reset("LaunchRamCustom") Setup.Reset("LaunchSkinType") @@ -108,7 +110,7 @@ Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) End Sub - Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change, CheckArgumentRam.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) End Sub @@ -352,19 +354,19 @@ '可安装 Mod 的版本 Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) - RamMininum = 0.4 + ModCount / 150 - RamTarget1 = 1.5 + ModCount / 100 - RamTarget2 = 3 + ModCount / 60 - RamTarget3 = 6 + ModCount / 30 + RamMininum = 0.5 + ModCount / 150 + RamTarget1 = 1.5 + ModCount / 90 + RamTarget2 = 2.7 + ModCount / 50 + RamTarget3 = 4.5 + ModCount / 25 ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then 'OptiFine 版本 - RamMininum = 0.3 + RamMininum = 0.5 RamTarget1 = 1.5 RamTarget2 = 3 - RamTarget3 = 6 + RamTarget3 = 5 Else '普通版本 - RamMininum = 0.3 + RamMininum = 0.5 RamTarget1 = 1.5 RamTarget2 = 2.5 RamTarget3 = 4 @@ -372,27 +374,23 @@ Dim RamDelta As Double '预分配内存，阶段一，0 ~ T1，100% RamDelta = RamTarget1 - RamAvailable = Math.Max(0, RamAvailable - 0.1) - RamGive += Math.Min(RamAvailable * 1, RamDelta) - RamAvailable -= RamDelta / 1 + 0.1 + RamGive += Math.Min(RamAvailable, RamDelta) + RamAvailable -= RamDelta If RamAvailable < 0.1 Then GoTo PreFin - '预分配内存，阶段二，T1 ~ T2，80% + '预分配内存，阶段二，T1 ~ T2，70% RamDelta = RamTarget2 - RamTarget1 - RamAvailable = Math.Max(0, RamAvailable - 0.1) - RamGive += Math.Min(RamAvailable * 0.8, RamDelta) - RamAvailable -= RamDelta / 0.8 + 0.1 + RamGive += Math.Min(RamAvailable * 0.7, RamDelta) + RamAvailable -= RamDelta / 0.7 If RamAvailable < 0.1 Then GoTo PreFin - '预分配内存，阶段三，T2 ~ T3，60% + '预分配内存，阶段三，T2 ~ T3，40% RamDelta = RamTarget3 - RamTarget2 - RamAvailable = Math.Max(0, RamAvailable - 0.2) - RamGive += Math.Min(RamAvailable * 0.6, RamDelta) - RamAvailable -= RamDelta / 0.6 + 0.2 - If RamAvailable < 0.1 Then GoTo PreFin - '预分配内存，阶段四，T3 ~ T3 * 2，40% - RamDelta = RamTarget3 - RamAvailable = Math.Max(0, RamAvailable - 0.3) RamGive += Math.Min(RamAvailable * 0.4, RamDelta) - RamAvailable -= RamDelta / 0.4 + 0.3 + RamAvailable -= RamDelta / 0.4 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段四，T3 ~ T3 * 2，15% + RamDelta = RamTarget3 + RamGive += Math.Min(RamAvailable * 0.15, RamDelta) + RamAvailable -= RamDelta / 0.15 If RamAvailable < 0.1 Then GoTo PreFin PreFin: '不低于最低值 @@ -444,7 +442,7 @@ PreFin: Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback) End Try '更新选择项 - If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择” + If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择” ComboArgumentJava.SelectedItem = SelectedItem '结束处理 If SelectedItem Is Nothing Then @@ -515,15 +513,16 @@ PreFin: Hint("正在搜索 Java，请稍候！", HintType.Critical) Exit Sub End If - RunInThread(Sub() - Hint("正在搜索 Java！") - JavaSearchLoader.WaitForExit(IsForceRestart:=True) - If Not JavaList.Any() Then - Hint("未找到可用的 Java！", HintType.Critical) - Else - Hint("已找到 " & JavaList.Count & " 个 Java，请检查下拉框查看列表！", HintType.Finish) - End If - End Sub) + RunInThread( + Sub() + Hint("正在搜索 Java！") + JavaSearchLoader.WaitForExit(IsForceRestart:=True) + If Not JavaList.Any() Then + Hint("未找到可用的 Java！", HintType.Critical) + Else + Hint("已找到 " & JavaList.Count & " 个 Java，请检查下拉框查看列表！", HintType.Finish) + End If + End Sub) End Sub #End Region @@ -548,12 +547,24 @@ PreFin: If AniControlEnabled <> 0 Then Exit Sub If ComboArgumentVisibie.SelectedIndex = 0 Then If MyMsgBox("若在游戏启动后立即关闭启动器，崩溃检测、更改游戏标题等功能将失效。" & vbCrLf & - "如果想保留这些功能，可以选择让启动器在游戏启动后隐藏，游戏退出后自动关闭。", "提示", "继续", "取消") = 2 Then + "如果想保留这些功能，可以选择让启动器在游戏启动后隐藏，游戏退出后自动关闭。", "提醒", "继续", "取消") = 2 Then ComboArgumentVisibie.SelectedItem = e.RemovedItems(0) End If End If End Sub + '开启自动内存优化的警告 + Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change + If AniControlEnabled <> 0 Then Exit Sub + If Not CheckArgumentRam.Checked Then Return + If MyMsgBox("内存优化耗时较长，这会拖慢游戏的启动过程，建议仅在电脑内存不充裕时开启此选项。" & vbCrLf & + "如果你在使用机械硬盘，这还可能会导致一小段时间的严重卡顿。" & + If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"), + "提醒", "确定", "取消") = 2 Then + CheckArgumentRam.Checked = False + End If + End Sub + #End Region #Region "高级设置" diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb index 14dbfef..9ec4061 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb @@ -126,23 +126,21 @@ '滑动条 Private Sub SliderLoad() - SliderDownloadThread.GetHintText = Function(Value As Integer) - Return Value + 1 - End Function - SliderDownloadSpeed.GetHintText = Function(Value As Integer) - If Value <= 14 Then - Return (Value + 1) * 0.1 & " M/s" - ElseIf Value <= 31 Then - Return (Value - 11) * 0.5 & " M/s" - ElseIf Value <= 41 Then - Return (Value - 21) & " M/s" - Else - Return "无限制" - End If - End Function - SliderDebugAnim.GetHintText = Function(Value As Integer) - Return If(Value > 29, "关闭", (Value / 10 + 0.1) & "x") - End Function + SliderDownloadThread.GetHintText = Function(v) v + 1 + SliderDownloadSpeed.GetHintText = + Function(v) + Select Case v + Case Is <= 14 + Return (v + 1) * 0.1 & " M/s" + Case Is <= 31 + Return (v - 11) * 0.5 & " M/s" + Case Is <= 41 + Return (v - 21) & " M/s" + Case Else + Return "无限制" + End Select + End Function + SliderDebugAnim.GetHintText = Function(v) If(v > 29, "关闭", (v / 10 + 0.1) & "x") End Sub Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange If SliderDownloadThread.Value < 100 Then Exit Sub diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb index ce03d0d..9af7c14 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb @@ -177,7 +177,7 @@ Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Try Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output) - If Result.Count > 0 Then + If Result.Any Then MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果") Else Hint("Mod 检查完成，未发现任何问题！", HintType.Finish) @@ -620,13 +620,13 @@ If ModEntry.ModId IsNot Nothing Then DebugInfo.Add("Mod ID：" & ModEntry.ModId) End If - If ModEntry.Dependencies.Count > 0 Then + If ModEntry.Dependencies.Any Then DebugInfo.Add("依赖于：") For Each Dep In ModEntry.Dependencies DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", "，版本：" & Dep.Value)) Next End If - If DebugInfo.Count > 0 Then + If DebugInfo.Any Then ContentLines.Add("") ContentLines.AddRange(DebugInfo) End If diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb index b54cc26..ad72125 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb @@ -33,7 +33,7 @@ If Indie = -1 Then Dim ModFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "mods\") Dim SaveFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "saves\") - If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then + If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then '自动开启 Setup.Set("VersionArgumentIndie", 1, Version:=PageVersionLeft.Version) Log("[Setup] 已自动开启单版本隔离：" & PageVersionLeft.Version.Name) @@ -438,7 +438,7 @@ PreFin: Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback) End Try '更新选择项 - If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then + If SelectedItem Is Nothing AndAlso JavaList.Any Then If SelectedBySetup = "" Then SelectedItem = ComboArgumentJava.Items(1) '选中 “自动选择” Else diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip index d00647e..c55c8d3 100644 Binary files a/Plain Craft Launcher 2/Resources/Help.zip and b/Plain Craft Launcher 2/Resources/Help.zip differ diff --git a/Plain Craft Launcher 2/app.manifest b/Plain Craft Launcher 2/app.manifest index bb8082f..2d4820f 100644 --- a/Plain Craft Launcher 2/app.manifest +++ b/Plain Craft Launcher 2/app.manifest @@ -29,8 +29,8 @@ - - + @@ -38,7 +38,7 @@ - +