diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml new file mode 100644 index 0000000..f4820c8 --- /dev/null +++ b/.github/FUNDING.yml @@ -0,0 +1,3 @@ +# These are supported funding model platforms + +custom: ['https://afdian.com/a/LTCat'] diff --git a/.github/ISSUE_TEMPLATE/bug1.yml b/.github/ISSUE_TEMPLATE/bug1.yml index 6a1f699..68cd2ba 100644 --- a/.github/ISSUE_TEMPLATE/bug1.yml +++ b/.github/ISSUE_TEMPLATE/bug1.yml @@ -1,6 +1,6 @@ name: "Minecraft 崩溃" description: "PCL 提示 “Minecraft 出现错误”，或游戏崩溃" -labels: [· Bug, 新反馈] +labels: [· Bug, 新提交] body: - type: checkboxes id: "yml-1" diff --git a/.github/ISSUE_TEMPLATE/bug2.yml b/.github/ISSUE_TEMPLATE/bug2.yml index b2db13b..de636f0 100644 --- a/.github/ISSUE_TEMPLATE/bug2.yml +++ b/.github/ISSUE_TEMPLATE/bug2.yml @@ -1,6 +1,6 @@ name: "下载或登录时卡住或失败" description: "下载游戏、Mod 或整合包，或登录正版账号时出现问题" -labels: [· Bug, 新反馈] +labels: [· Bug, 新提交] body: - type: checkboxes id: "yml-1" diff --git a/.github/ISSUE_TEMPLATE/bug9.yml b/.github/ISSUE_TEMPLATE/bug9.yml index 124b0c7..be20097 100644 --- a/.github/ISSUE_TEMPLATE/bug9.yml +++ b/.github/ISSUE_TEMPLATE/bug9.yml @@ -1,6 +1,6 @@ name: "综合 Bug 反馈" description: "遇见了没有细分选项的其他 Bug" -labels: [· Bug, 新反馈] +labels: [· Bug, 新提交] body: - type: checkboxes id: "yml-1" diff --git a/.github/ISSUE_TEMPLATE/ch.yml b/.github/ISSUE_TEMPLATE/ch.yml index 77ed3fd..0ddd693 100644 --- a/.github/ISSUE_TEMPLATE/ch.yml +++ b/.github/ISSUE_TEMPLATE/ch.yml @@ -1,6 +1,6 @@ name: "优化建议" description: "对已有功能的小幅度优化或改进建议" -labels: [· 优化, 新反馈] +labels: [· 优化, 新提交] body: - type: checkboxes id: "yml-1" diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml index feb73a1..082755e 100644 --- a/.github/ISSUE_TEMPLATE/config.yml +++ b/.github/ISSUE_TEMPLATE/config.yml @@ -1,5 +1,8 @@ blank_issues_enabled: false contact_links: + - name: 主页预设反馈 + url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页 + about: 提交与预设的主页（设置 → 个性化 → 主页预设）中的具体内容相关的反馈 - name: 帮助文档反馈 url: https://github.com/LTCatt/PCL2Help/issues about: 提交与 PCL 帮助文档（更多 → 帮助）中的具体内容相关的反馈 diff --git a/.github/ISSUE_TEMPLATE/feature.yml b/.github/ISSUE_TEMPLATE/feature.yml index e799ee4..e27452b 100644 --- a/.github/ISSUE_TEMPLATE/feature.yml +++ b/.github/ISSUE_TEMPLATE/feature.yml @@ -1,6 +1,6 @@ name: "新功能提案" description: "对已有功能的大幅度修改，或添加一个新内容或选项" -labels: [· 新功能, 新反馈] +labels: [· 新功能, 新提交] body: - type: checkboxes id: "yml-1" diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index f2c4927..bf88c42 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -1,5 +1,4 @@ name: Build - on: push: paths: @@ -12,37 +11,42 @@ on: workflow_dispatch: jobs: - build: - - strategy: - matrix: - configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate] - + name: Build runs-on: windows-latest - + strategy: + matrix: + configuration: [Debug, Release] steps: - name: Checkout uses: actions/checkout@v4 with: fetch-depth: 0 - - name: Set Describe shell: bash run: | - Describe=`git describe --tags --always` - echo "Describe=$Describe" >> $GITHUB_ENV - + describe=`git describe --tags --always` + echo "describe=$describe" >> $GITHUB_ENV - name: Setup MSBuild.exe uses: microsoft/setup-msbuild@v2 with: msbuild-architecture: x64 - + - name: Replace + run: | + (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" + (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" + (gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb" + rm "Plain Craft Launcher 2\Resources\Help.zip" + aria2c "--out=Plain Craft Launcher 2\Resources\Help.zip" "https://codeload.github.com/LTCatt/PCL2Help/zip/refs/heads/master" + 7z x "Plain Craft Launcher 2\Resources\Help.zip" -o"Plain Craft Launcher 2\Resources" + rm "Plain Craft Launcher 2\Resources\Help.zip" + rm "Plain Craft Launcher 2\Resources\PCL2Help-master\*.*" + 7z a "Plain Craft Launcher 2\Resources\Help.zip" ".\Plain Craft Launcher 2\Resources\PCL2Help-master\*" + rm "Plain Craft Launcher 2\Resources\PCL2Help-master\" -Recurse - name: Build run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }} - - name: Upload a Build Artifact uses: actions/upload-artifact@v4 with: - name: ${{ matrix.configuration }} ${{ env.Describe }} + name: ${{ matrix.configuration }} ${{ env.describe }} path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe diff --git a/LICENCE b/LICENCE index 9bd5dbe..2336a98 100644 --- a/LICENCE +++ b/LICENCE @@ -2,23 +2,25 @@ 一、承诺与声明。 -　　开发者承诺，在您遵守本指南的情况下，不会追究您的法律责任，但最终裁量权仍由开发者保留。 +　　开发者承诺，在您遵守本指南且善意使用的情况下，不会追究您的责任，但最终裁量权仍由开发者保留。 　　法律上，开发者仍保留所有权利（All Rights Reserved），且可能随时修改本指南，本指南并不是永久性保证。 二、少量使用情形。 　　如果您仅合理使用本存储库中的少量内容，或是参考实现思路，您必须： -　　（一）给出适当的署名，且提供指向本存储库的链接。 -　　（二）不得以任何方式暗示开发者为您或您的使用作担保。 +　　1、给出适当的署名，且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。 +　　2、不得以任何方式暗示开发者为您或您的使用作担保。 三、大量使用情形。 -　　如果您基于该存储库进行衍生创作，或合理使用了本存储库中的较大量内容，您必须： -　　（一）给出适当的署名，且提供指向本存储库的链接。 -　　（二）不得以任何方式暗示开发者为您或您的使用作担保。 -　　（三）给出适当的说明，表示这是第三方内容。在 GitHub 上直接进行 Fork 是允许的。 -　　（四）使用本指南文件作为协议，不得附加额外条款。 -　　（五）不得分发编译后的可执行文件。唯一的例外是，你可以在明确禁止再次分发的前提下，在小于 100 人的 QQ 群内分发编译后的可执行文件。 +　　如果您基于该存储库创作衍生作品，或合理使用了本存储库中的较大量内容，您必须： +　　1、给出适当的署名，且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。 +　　2、不得以任何方式暗示开发者为您或您的使用作担保。 +　　3、给出适当的说明，以明确表示该衍生作品是非官方内容。 +　　4、使用本指南文件作为协议，不得附加额外条款。 +　　5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头，并在其后添加后缀。例如 “PCL 整合包优化版”、“PCL PR Collection”。 +　　6、该衍生作品不得包含 PCL 的赞助解锁功能，或与其用途相近的功能。包括但不限于：主题切换（自定义软件颜色/皮肤）、回声洞投稿等。 +　　7、以善意目的进行合理使用，不要用 PCL 来干坏事、恰烂钱、整烂活。开发者可能会将撤销所有授权作为最终手段。 ———————————— diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index eb34ceb..4233f8f 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -31,7 +31,7 @@ Public Class Application '内存优化 Dim Ram = My.Computer.Info.AvailablePhysicalMemory Try - PageOtherTest.MemoryOptimizeInternal() + PageOtherTest.MemoryOptimizeInternal(False) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败") Environment.Exit(-1) @@ -72,9 +72,17 @@ Public Class Application Directory.CreateDirectory(PathAppdata) '检测单例 #If Not DEBUG Then + Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出 + Dim WaitRetryCount As Integer = 0 +WaitRetry: Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher　") If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2　") If WindowHwnd <> IntPtr.Zero Then + If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒 + WaitRetryCount += 1 + Thread.Sleep(500) + GoTo WaitRetry + End If '将已有的 PCL 窗口拖出来 ShowWindowToTop(WindowHwnd) '播放提示音并退出 @@ -90,7 +98,7 @@ Public Class Application ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0)) ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0)) '设置初始窗口 - If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then + If Setup.Get("UiLauncherLogo") Then FrmStart = New SplashScreen("Images\icon.ico") FrmStart.Show(False, True) End If @@ -99,13 +107,17 @@ Public Class Application '日志初始化 LogStart() '添加日志 - Log($"[Start] 程序版本：{VersionDisplayName} ({VersionCode})") + Log($"[Start] 程序版本：{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})") Log($"[Start] 识别码：{UniqueAddress}{If(ThemeCheckOne(9), "，已解锁反馈主题", "")}") Log($"[Start] 程序路径：{PathWithName}") - Log($"[Start] 系统编码：{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") - '检测压缩包运行 + Log($"[Start] 系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") + Log($"[Start] 管理员权限：{IsAdmin()}") + '检测异常环境 If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then - MyMsgBox("PCL 正在临时文件夹运行，设置、游戏存档等很可能无法保存，且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压，或是更换文件夹后再继续使用！", "环境警告", "我知道了", IsWarn:=True) + MyMsgBox("请将 PCL 从压缩包中解压之后再使用！" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置，部分功能也可能无法使用！", "环境警告", "我知道了", IsWarn:=True) + End If + If Is32BitSystem Then + MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True) End If '设置初始化 Setup.Load("SystemDebugMode") @@ -158,7 +170,7 @@ Public Class Application ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析 ExceptionString.Contains("未能加载文件或程序集") Then OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer") - MsgBox("你的 .NET Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误") + MsgBox("你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.6.2！", MsgBoxStyle.Information, "运行环境错误") FormMain.EndProgramForce(Result.Cancel) Else FeedbackInfo() @@ -170,9 +182,12 @@ Public Class Application Private Shared AssemblyNAudio As Assembly Private Shared AssemblyJson As Assembly Private Shared AssemblyDialog As Assembly + Private Shared AssemblyImazenWebp As Assembly Private Shared ReadOnly AssemblyNAudioLock As New Object Private Shared ReadOnly AssemblyJsonLock As New Object Private Shared ReadOnly AssemblyDialogLock As New Object + Private Shared ReadOnly AssemblyImazenWebpLock As New Object + Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly If args.Name.StartsWithF("NAudio") Then SyncLock AssemblyNAudioLock @@ -198,6 +213,16 @@ Public Class Application End If Return AssemblyDialog End SyncLock + ElseIf args.Name.StartsWithF("Imazen.WebP") Then + SyncLock AssemblyImazenWebpLock + If AssemblyImazenWebp Is Nothing Then + Log("[Start] 加载 DLL：Imazen.WebP") + AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP")) + SetDllDirectory(PathPure.TrimEnd("\")) + WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64")) + End If + Return AssemblyImazenWebp + End SyncLock Else Return Nothing End If diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb index 8ae95ef..30c6588 100644 --- a/Plain Craft Launcher 2/Controls/MyCard.vb +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -293,26 +293,28 @@ Public Const SwapedHeight As Integer = 40 Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Dim Pos As Double = Mouse.GetPosition(Me).Y - If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 + If Not IsSwaped AndAlso + (SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 IsMouseDown = True End Sub Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp - If IsMouseDown Then + If Not IsMouseDown Then Return + IsMouseDown = False + + Dim Pos As Double = Mouse.GetPosition(Me).Y + If Not IsSwaped AndAlso + (SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 + + Dim ee = New RouteEventArgs(True) + RaiseEvent PreviewSwap(Me, ee) + If ee.Handled Then IsMouseDown = False - Dim Pos As Double = Mouse.GetPosition(Me).Y - If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 - - Dim ee = New RouteEventArgs(True) - RaiseEvent PreviewSwap(Me, ee) - If ee.Handled Then - IsMouseDown = False - Exit Sub - End If - - IsSwaped = Not IsSwaped - Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title)) - RaiseEvent Swap(Me, ee) + Return End If + + IsSwaped = Not IsSwaped + Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title)) + RaiseEvent Swap(Me, ee) End Sub Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave IsMouseDown = False diff --git a/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb index ca8f99d..d7103c6 100644 --- a/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb @@ -111,7 +111,16 @@ If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255) - If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0) + If Path.Fill Is Nothing Then + Select Case Theme + Case Themes.Red + Path.Fill = New MyColor(160, 255, 76, 76) + Case Themes.Black + Path.Fill = New MyColor(160, 0, 0, 0) + Case Themes.Custom + Path.Fill = New MyColor(160, Foreground) + End Select + End If If IsMouseOver Then '指向 Dim AnimList As New List(Of AniData) diff --git a/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb index 48a3f1b..a094029 100644 --- a/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb @@ -46,18 +46,18 @@ Black Highlight End Enum - Private _ColorType As ColorState = ColorState.Black Public Property ColorType As ColorState Get - Return _ColorType + Return GetValue(ColorTypeProperty) End Get Set(value As ColorState) - _ColorType = value + If ColorType = value Then Return + SetValue(ColorTypeProperty, value) RefreshColor() End Set End Property '颜色类别 Public Shared ReadOnly ColorTypeProperty As DependencyProperty = - DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata()) + DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata(ColorState.Black)) '点击事件 diff --git a/Plain Craft Launcher 2/Controls/MyImage.vb b/Plain Craft Launcher 2/Controls/MyImage.vb new file mode 100644 index 0000000..92ba1c0 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyImage.vb @@ -0,0 +1,189 @@ +Public Class MyImage + Inherits Image + +#Region "公开属性" + + ''' + ''' 网络图片的缓存有效期。 + ''' 在这个时间后，才会重新尝试下载图片。 + ''' + Public FileCacheExpiredTime As New TimeSpan(7, 0, 0, 0) '7 天 + + ''' + ''' 是否允许将网络图片存储到本地用作缓存。 + ''' + Public Property EnableCache As Boolean + Get + Return GetValue(EnableCacheProperty) + End Get + Set(value As Boolean) + SetValue(EnableCacheProperty, value) + End Set + End Property + Public Shared Shadows ReadOnly EnableCacheProperty As DependencyProperty = DependencyProperty.Register( + "EnableCache", GetType(Boolean), GetType(MyImage), New PropertyMetadata(True)) + + ''' + ''' 与 Image 的 Source 类似。 + ''' 若输入以 http 开头的字符串，则会尝试下载图片然后显示，图片会保存为本地缓存。 + ''' 支持 WebP 格式的图片。 + ''' + Public Shadows Property Source As String '覆写 Image 的 Source 属性 + Get + Return _Source + End Get + Set(value As String) + If value = "" Then value = Nothing + If _Source = value Then Exit Property + _Source = value + If Not IsInitialized Then Exit Property '属性读取顺序修正：在完成 XAML 属性读取后再触发图片加载（#4868） + Load() + End Set + End Property + Private _Source As String = "" + Public Shared Shadows ReadOnly SourceProperty As DependencyProperty = DependencyProperty.Register( + "Source", GetType(String), GetType(MyImage), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString()))) + + ''' + ''' 当 Source 首次下载失败时，会从该备用地址加载图片。 + ''' + Public Property FallbackSource As String + Get + Return _FallbackSource + End Get + Set(value As String) + _FallbackSource = value + End Set + End Property + Private _FallbackSource As String = Nothing + + ''' + ''' 正在下载网络图片时显示的本地图片。 + ''' + Public Property LoadingSource As String + Get + Return _LoadingSource + End Get + Set(value As String) + _LoadingSource = value + End Set + End Property + Private _LoadingSource As String = "pack://application:,,,/images/Icons/NoIcon.png" + +#End Region + + ''' + ''' 实际被呈现的图片地址。 + ''' + Public Property ActualSource As String + Get + Return _ActualSource + End Get + Set(value As String) + If value = "" Then value = Nothing + If _ActualSource = value Then Exit Property + _ActualSource = value + Try + Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件 + RunInUiWait(Sub() MyBase.Source = Bitmap) + Catch ex As Exception + Log(ex, $"加载图片失败（{value}）") + Try + If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value) + Catch + End Try + End Try + End Set + End Property + Private _ActualSource As String = Nothing + + Private Sub Load() _ + Handles Me.Initialized '属性读取顺序修正：在完成 XAML 属性读取后再触发图片加载（#4868） + '空 + If Source Is Nothing Then + ActualSource = Nothing + Exit Sub + End If + '本地图片 + If Not Source.StartsWithF("http") Then + ActualSource = Source + Exit Sub + End If + '从缓存加载网络图片 + Dim Url As String = Source + Dim Retried As Boolean = False + Dim TempPath As String = GetTempPath(Url) + Dim TempFile As New FileInfo(TempPath) + Dim EnableCache As Boolean = Me.EnableCache + If EnableCache AndAlso TempFile.Exists Then + ActualSource = TempPath + If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存 + End If + RunInNewThread( + Sub() + Dim TempDownloadingPath As String = Nothing + Try +RetryStart: + '下载 + ActualSource = LoadingSource '显示加载中图片 + TempDownloadingPath = TempPath & RandomInteger(0, 10000000) + Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载，以避免携带 Header（#5072） + Using Client As New Net.WebClient + Client.DownloadFile(Url, TempDownloadingPath) + End Using + If Url <> Source AndAlso Url <> FallbackSource Then + '已经更换了地址 + File.Delete(TempDownloadingPath) + ElseIf EnableCache Then + '保存缓存并显示 + If File.Exists(TempPath) Then File.Delete(TempPath) + Rename(TempDownloadingPath, TempPath) + RunInUi(Sub() ActualSource = TempPath) + Else + '直接显示 + RunInUiWait(Sub() ActualSource = TempDownloadingPath) + File.Delete(TempDownloadingPath) + End If + Catch ex As Exception + Try + If TempPath IsNot Nothing Then File.Delete(TempPath) + If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath) + Catch + End Try + If Not Retried Then + '更换备用地址 + Log(ex, $"下载图片可重试地失败（{Url}）", LogLevel.Developer) + Retried = True + Url = If(FallbackSource, Source) + '空 + If Url Is Nothing Then + ActualSource = Nothing + Exit Sub + End If + '本地图片 + If Not Url.StartsWithF("http") Then + ActualSource = Url + Exit Sub + End If + '从缓存加载网络图片 + TempPath = GetTempPath(Url) + TempFile = New FileInfo(TempPath) + If EnableCache AndAlso TempFile.Exists() Then + ActualSource = TempPath + If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存 + End If + '下载 + If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试 + GoTo RetryStart + Else + Log(ex, $"下载图片失败（{Url}）", LogLevel.Hint) + End If + End Try + End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal) + End Sub + Public Shared Function GetTempPath(Url As String) As String + Return $"{PathTemp}MyImage\{GetHash(Url)}.png" + End Function + +End Class \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb index a4015da..0d1f03d 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -212,33 +212,26 @@ If Not _Logo = "" Then If _Logo.StartsWithF("http", True) Then '网络图片 - PathLogo = New Image With { + PathLogo = New MyImage With { .Tag = Me, .IsHitTestVisible = LogoClickable, - .Source = New ImageSourceConverter().ConvertFromString(_Logo), + .Source = _Logo, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, .SnapsToDevicePixels = True, .UseLayoutRounding = False} RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear) - ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then + ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then '位图 - Dim Bitmap = New MyBitmap(_Logo) PathLogo = New Canvas With { .Tag = Me, .IsHitTestVisible = LogoClickable, - .Background = Bitmap, + .Background = New MyBitmap(_Logo), .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, - .SnapsToDevicePixels = True, .UseLayoutRounding = False} - 'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then - ' '使用最适合 16x16 物品图片显示的大小 - ' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor) - ' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center - ' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width - 'Else - PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch - RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality) - 'End If + .SnapsToDevicePixels = True, .UseLayoutRounding = False, + .HorizontalAlignment = HorizontalAlignment.Stretch, .VerticalAlignment = VerticalAlignment.Stretch + } + RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear) Else '矢量图 PathLogo = New Shapes.Path With { @@ -327,8 +320,8 @@ Private Sub OnSizeChanged() Handles Me.SizeChanged ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6)) ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4)) - If Not IsNothing(PathLogo) Then - If _Logo.EndsWithF(".png", True) Then + If PathLogo IsNot Nothing Then + If _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then PathLogo.Margin = New Thickness(4, 5, 3, 5) Else PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8) @@ -677,6 +670,8 @@ Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) Catch ex As Exception Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) + EventType = Nothing + EventData = Nothing End Try End If End Sub diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml index bf23281..282ecb2 100644 --- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml @@ -25,7 +25,7 @@ + VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7"> diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml index 5c21822..b4f75ba 100644 --- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml @@ -24,7 +24,7 @@ + VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7"> diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml index 10f2a92..0bbf157 100644 --- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml @@ -24,7 +24,7 @@ + VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7"> diff --git a/Plain Craft Launcher 2/Controls/MyPageLeft.vb b/Plain Craft Launcher 2/Controls/MyPageLeft.vb index b09897b..9c368a6 100644 --- a/Plain Craft Launcher 2/Controls/MyPageLeft.vb +++ b/Plain Craft Launcher 2/Controls/MyPageLeft.vb @@ -104,3 +104,7 @@ End Sub End Class + +Public Interface IRefreshable + Sub Refresh() +End Interface \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb index 3cb814c..ba5c05e 100644 --- a/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb @@ -157,9 +157,7 @@ End Set End Property '内容 Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback( - Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) - If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue - End Sub))) + Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioBox).LabText.Text = e.NewValue))) '点击事件 diff --git a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml index e5753e0..aa42f53 100644 --- a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml +++ b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml @@ -4,6 +4,6 @@ HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27"> - + diff --git a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb index c147a2f..8d9537b 100644 --- a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb @@ -117,9 +117,7 @@ End Set End Property '内容 Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback( - Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) - If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue - End Sub))) + Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioButton).LabText.Text = e.NewValue))) Public Enum ColorState White Highlight diff --git a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb index beaeb1c..42da890 100644 --- a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb +++ b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb @@ -1,7 +1,7 @@ Public Class MyScrollViewer Inherits ScrollViewer - Public Property DeltaMuity As Double = 1 + Public Property DeltaMult As Double = 1 Private RealOffset As Double @@ -25,10 +25,12 @@ Next End Sub Public Sub PerformVerticalOffsetDelta(Delta As Double) - AniStart(AaDouble(Sub(AnimDelta As Double) - RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight) - ScrollToVerticalOffset(RealOffset) - End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6))) + AniStart( + AaDouble( + Sub(AnimDelta As Double) + RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight) + ScrollToVerticalOffset(RealOffset) + End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6))) End Sub Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged RealOffset = VerticalOffset @@ -43,4 +45,7 @@ ScrollBar = GetTemplateChild("PART_VerticalScrollBar") End Sub + Private Sub MyScrollViewer_PreviewGotKeyboardFocus(sender As Object, e As KeyboardFocusChangedEventArgs) Handles Me.PreviewGotKeyboardFocus + If e.NewFocus IsNot Nothing AndAlso TypeOf e.NewFocus Is MySlider Then e.Handled = True '#3854，阻止获得焦点时自动滚动 + End Sub End Class diff --git a/Plain Craft Launcher 2/Controls/MyTextButton.vb b/Plain Craft Launcher 2/Controls/MyTextButton.vb index 3d8245f..58fcd6e 100644 --- a/Plain Craft Launcher 2/Controls/MyTextButton.vb +++ b/Plain Craft Launcher 2/Controls/MyTextButton.vb @@ -90,21 +90,21 @@ Get Return GetValue(EventTypeProperty) End Get - Set(value As String) SetValue(EventTypeProperty, value) End Set End Property - Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) + Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register( + "EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) Public Property EventData As String Get Return GetValue(EventDataProperty) End Get - Set(value As String) SetValue(EventDataProperty, value) End Set End Property - Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) + Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register( + "EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) End Class diff --git a/Plain Craft Launcher 2/FormMain.xaml b/Plain Craft Launcher 2/FormMain.xaml index 2dd9671..d0a3a5e 100644 --- a/Plain Craft Launcher 2/FormMain.xaml +++ b/Plain Craft Launcher 2/FormMain.xaml @@ -104,7 +104,7 @@ - + - + @@ -166,7 +166,7 @@ - + diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 4d9c04b..6dd23ef 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -10,6 +10,53 @@ Public Class FormMain Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) '统计更新日志条目 #If BETA Then + If LastVersion < 347 Then 'Release 2.8.12 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面添加下载 Mod、安装 Mod 选项")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 详情页面支持按加载器、游戏版本进行分类和筛选")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装同时包含 modpack 文件和启动器的懒人包")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化整合包导入流程")) + FeatureCount += 43 + BugCount += 37 + End If + If LastVersion < 342 Then 'Release 2.8.9 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug")) + FeatureCount += 17 + BugCount += 13 + End If + If LastVersion < 340 Then 'Release 2.8.8 + If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug")) + FeatureCount += 3 + BugCount += 7 + End If + If LastVersion < 338 Then 'Release 2.8.7 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式，以提高安全性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug")) + FeatureCount += 11 + BugCount += 21 + End If + If LastVersion < 336 Then 'Release 2.8.6 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug")) + FeatureCount += 19 + BugCount += 24 + End If + If LastVersion < 332 Then 'Release 2.8.3 + If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug")) + End If + If LastVersion < 330 Then 'Release 2.8.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码")) + FeatureCount += 15 + BugCount += 22 + End If If LastVersion < 326 Then 'Release 2.7.4 FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能")) @@ -37,84 +84,84 @@ Public Class FormMain FeatureCount += 10 BugCount += 10 End If - If LastVersion < 317 Then 'Release 2.6.15 - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug")) - FeatureCount += 2 - BugCount += 2 - End If - If LastVersion < 315 Then 'Release 2.6.14 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载，尝试解决各种导致 MC 下载失败的问题")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容")) - FeatureCount += 17 - BugCount += 16 - End If - If LastVersion < 313 Then 'Release 2.6.13 - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug")) - FeatureCount += 6 - BugCount += 10 - End If - If LastVersion < 311 Then 'Release 2.6.12 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug")) - FeatureCount += 27 - BugCount += 25 - End If - If LastVersion < 308 Then 'Release 2.6.10 - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug")) - FeatureCount += 31 - BugCount += 37 - End If - If LastVersion < 302 Then 'Release 2.6.7 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug")) - BugCount += 1 - End If - If LastVersion < 300 Then 'Release 2.6.6 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析，添加多种崩溃情况的判断")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存")) - FeatureCount += 40 - BugCount += 34 - End If - If LastVersion < 296 Then 'Release 2.6.3 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能，可以将所有程序的物理内存占用降低约 1/3")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析，添加多种崩溃情况的判断")) - FeatureCount += 21 - BugCount += 30 - End If - If LastVersion < 293 Then 'Release 2.6.1 - BugCount += 1 - End If - If LastVersion < 292 Then 'Release 2.6.0 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条")) - FeatureCount += 24 - BugCount += 24 - End If - If LastVersion < 286 Then 'Release 2.5.2 - FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、安装 Modrinth 的 Mod 与整合包")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API")) - FeatureCount += 35 - BugCount += 36 - End If #Else '5： FEAT+ '4： IMP+ FEAT* '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 346 Then 'Snapshot 2.8.12 + If LastVersion = 345 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复帮助页面报错的 Bug")) + End If + If LastVersion < 345 Then 'Snapshot 2.8.11 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面添加下载 Mod、安装 Mod 选项")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 详情页面支持按加载器、游戏版本进行分类和筛选")) + FeatureCount += 23 + BugCount += 21 + End If + If LastVersion < 343 Then 'Snapshot 2.8.10 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装同时包含 modpack 文件和启动器的懒人包")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化整合包导入流程")) + FeatureCount += 20 + BugCount += 16 + End If + If LastVersion < 341 Then 'Snapshot 2.8.9 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug")) + FeatureCount += 17 + BugCount += 13 + End If + If LastVersion < 339 Then 'Snapshot 2.8.8 + If LastVersion = 337 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug")) + FeatureCount += 3 + BugCount += 7 + End If + If LastVersion < 337 Then 'Snapshot 2.8.7 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式，以提高安全性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug")) + FeatureCount += 11 + BugCount += 21 + End If + If LastVersion < 335 Then 'Snapshot 2.8.6 + BugCount += 2 + End If + If LastVersion < 334 Then 'Snapshot 2.8.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod")) + If LastVersion = 333 Then + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug")) + End If + FeatureCount += 6 + BugCount += 7 + End If + If LastVersion < 333 Then 'Snapshot 2.8.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug")) + FeatureCount += 13 + BugCount += 17 + End If + If LastVersion < 331 Then 'Snapshot 2.8.3 + If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug")) + End If + If LastVersion < 329 Then 'Snapshot 2.8.2 + If LastVersion >= 327 Then + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Beta 版 NeoForge 的整合包的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复自动安装无法选择部分 OptiFine 的 Bug")) + End If + FeatureCount += 4 + BugCount += 8 + End If + If LastVersion < 328 Then 'Snapshot 2.8.1 + If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.12.2- 的 Bug")) + If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 Bug")) + If LastVersion = 327 Then BugCount += 1 + End If If LastVersion < 327 Then 'Snapshot 2.8.0 FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码")) @@ -151,117 +198,6 @@ Public Class FormMain FeatureCount += 10 BugCount += 10 End If - If LastVersion < 316 Then 'Snapshot 2.6.15 - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug")) - FeatureCount += 2 - BugCount += 2 - End If - If LastVersion < 314 Then 'Snapshot 2.6.14 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载，尝试解决各种导致 MC 下载失败的问题")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站，移除其相关内容")) - FeatureCount += 17 - BugCount += 16 - End If - If LastVersion < 312 Then 'Snapshot 2.6.13 - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug")) - FeatureCount += 6 - BugCount += 10 - End If - If LastVersion < 310 Then 'Snapshot 2.6.12 - If LastVersion = 309 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理页面添加启用、禁用单个 Mod 的快捷按钮")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug")) - FeatureCount += 13 - BugCount += 12 - End If - If LastVersion < 309 Then 'Snapshot 2.6.11 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式")) - FeatureCount += 15 - BugCount += 13 - End If - If LastVersion < 307 Then 'Snapshot 2.6.10 - FeatureCount += 2 - BugCount += 3 - End If - If LastVersion < 306 Then 'Snapshot 2.6.9 - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项")) - FeatureCount += 9 - BugCount += 11 - End If - If LastVersion < 305 Then 'Snapshot 2.6.8 - FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug")) - FeatureCount += 20 - BugCount += 25 - End If - If LastVersion < 303 Then 'Snapshot 2.6.7 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug")) - BugCount += 1 - End If - If LastVersion < 301 Then 'Snapshot 2.6.6 - FeatureCount += 4 - BugCount += 2 - End If - If LastVersion < 299 Then 'Snapshot 2.6.5 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存")) - FeatureCount += 18 - BugCount += 13 - End If - If LastVersion < 298 Then 'Snapshot 2.6.4 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析，添加多种崩溃情况的判断")) - FeatureCount += 18 - BugCount += 19 - End If - If LastVersion < 297 Then 'Snapshot 2.6.3 - FeatureCount += 12 - BugCount += 14 - End If - If LastVersion < 294 Then 'Snapshot 2.6.2 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能，可以将所有程序的物理内存占用降低约 1/3")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric")) - FeatureCount += 9 - BugCount += 16 - End If - If LastVersion < 291 Then 'Snapshot 2.6.0 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本")) - FeatureCount += 10 - BugCount += 2 - End If - If LastVersion < 289 Then 'Snapshot 2.5.4 - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录")) - FeatureCount += 6 - BugCount += 14 - End If - If LastVersion < 288 Then 'Snapshot 2.5.3 - FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条")) - FeatureCount += 8 - BugCount += 8 - End If - If LastVersion < 285 Then 'Snapshot 2.5.2 - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面")) - If LastVersion = 284 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复打开部分帮助报错的 Bug")) - FeatureCount += 8 - BugCount += 8 - End If - If LastVersion < 284 Then 'Snapshot 2.5.1 - If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API")) - FeatureCount += 22 - BugCount += 21 - End If - If LastVersion < 283 Then 'Snapshot 2.5.0 - FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页")) - FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包")) - FeatureCount += 5 - BugCount += 5 - End If #End If '整理更新日志文本 Dim ContentList As New List(Of String) @@ -282,17 +218,13 @@ Public Class FormMain RunInNewThread( Sub() If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then - OpenWebsite("https://afdian.net/a/LTCat?tab=feed") + OpenWebsite("https://afdian.com/a/LTCat?tab=feed") End If End Sub, "UpdateLog Output") End Sub '窗口加载 Private IsWindowLoadFinished As Boolean = False - ''' - ''' 是否为联机提权后自动重启。 - ''' - Public Shared IsLinkRestart As Boolean = False Public Sub New() ApplicationStartTick = GetTimeTick() '窗体参数初始化 @@ -308,9 +240,6 @@ Public Class FormMain '触发降级 DowngradeSub(LastVersion) End If - ''刷新语言 - 'Lang = ReadReg("Lang", "zh_CN") - 'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)} '刷新主题 ThemeCheckAll(False) Setup.Load("UiLauncherTheme") @@ -328,9 +257,10 @@ Public Class FormMain If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing) If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing) PanMainLeft.Child = FrmLaunchLeft + PageLeft = FrmLaunchLeft PanMainRight.Child = FrmLaunchRight + PageRight = FrmLaunchRight FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay - If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi) '模式提醒 #If DEBUG Then Hint("[开发者模式] PCL 正以开发者模式运行，这可能会造成严重的性能下降，请务必立即向开发者反馈此问题！", HintType.Critical) @@ -374,13 +304,17 @@ Public Class FormMain '加载窗口 ThemeRefreshMain() Try - Height = ReadReg("WindowHeight", MinHeight + 50) - Width = ReadReg("WindowWidth", MinWidth + 50) + Height = Setup.Get("WindowHeight") + Width = Setup.Get("WindowWidth") Catch ex As Exception '修复 #2019 Log(ex, "读取窗口默认大小失败", LogLevel.Hint) - Height = MinHeight + 50 - Width = MinWidth + 50 + Height = MinHeight + 100 + Width = MinWidth + 100 End Try + '#If DEBUG Then + ' MinHeight = 50 + ' MinWidth = 50 + '#End If Topmost = False If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed)) '更改窗口 @@ -399,7 +333,7 @@ Public Class FormMain Sub() PanBack.RenderTransform = Nothing IsWindowLoadFinished = True - Log($"[System] DPI：{DPI}，系统版本：{OsVersion}，PCL 位置：{PathWithName}") + Log($"[System] DPI：{DPI}，系统版本：{Environment.OSVersion.VersionString}，PCL 位置：{PathWithName}") End Sub, , True) }, "Form Show") 'Timer 启动 @@ -411,7 +345,7 @@ Public Class FormMain 'EULA 提示 If Not Setup.Get("SystemEula") Then Select Case MyMsgBox("在使用 PCL 前，请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", - Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) + Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) Case 1 Setup.Set("SystemEula", True) Case 2 @@ -514,6 +448,16 @@ Public Class FormMain Setup.Set("UiHiddenOtherHelp", False) Log("[Start] 已解除帮助页面的隐藏") End If + '单向迁移微软登录结果（#4836） + If Not Setup.Get("CacheMsV2Migrated") Then + Setup.Set("CacheMsV2Migrated", True) + Setup.Set("CacheMsV2OAuthRefresh", Setup.Get("CacheMsOAuthRefresh")) + Setup.Set("CacheMsV2Access", Setup.Get("CacheMsAccess")) + Setup.Set("CacheMsV2ProfileJson", Setup.Get("CacheMsProfileJson")) + Setup.Set("CacheMsV2Uuid", Setup.Get("CacheMsUuid")) + Setup.Set("CacheMsV2Name", Setup.Get("CacheMsName")) + Log("[Start] 已从老版本迁移微软登录结果") + End If '输出更新日志 If LastVersionCode = 0 Then Exit Sub If LowerVersionCode >= VersionCode Then Exit Sub @@ -545,7 +489,7 @@ Public Class FormMain RunInNewThread( Sub() Log("[System] 正在强行停止任务") - For Each Task As LoaderBase In LoaderTaskbar.ToArray + For Each Task As LoaderBase In LoaderTaskbar.ToList() Task.Abort() Next End Sub, "强行停止下载任务") @@ -555,35 +499,35 @@ Public Class FormMain End If '关闭 RunInUiWait( - Sub() - IsHitTestVisible = False - If PanBack.RenderTransform Is Nothing Then - Dim TransformPos As New TranslateTransform(0, 0) - Dim TransformRotate As New RotateTransform(0) - Dim TransformScale As New ScaleTransform(1, 1) - PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})} - AniStart({ - AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)), - AaDouble( - Sub(i) - TransformScale.ScaleX += i - TransformScale.ScaleY += i - End Sub, 0.88 - TransformScale.ScaleX, 180), - AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)), - AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)), - AaCode( - Sub() - IsHitTestVisible = False - Top = -10000 - ShowInTaskbar = False - End Sub, 210), - AaCode(AddressOf EndProgramForce, 230) - }, "Form Close") - Else - EndProgramForce() - End If - Log("[System] 收到关闭指令") - End Sub) + Sub() + IsHitTestVisible = False + If PanBack.RenderTransform Is Nothing Then + Dim TransformPos As New TranslateTransform(0, 0) + Dim TransformRotate As New RotateTransform(0) + Dim TransformScale As New ScaleTransform(1, 1) + PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})} + AniStart({ + AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)), + AaDouble( + Sub(i) + TransformScale.ScaleX += i + TransformScale.ScaleY += i + End Sub, 0.88 - TransformScale.ScaleX, 180), + AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)), + AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)), + AaCode( + Sub() + IsHitTestVisible = False + Top = -10000 + ShowInTaskbar = False + End Sub, 210), + AaCode(AddressOf EndProgramForce, 230) + }, "Form Close") + Else + EndProgramForce() + End If + Log("[System] 收到关闭指令") + End Sub) End Sub Private Shared IsLogShown As Boolean = False Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success) @@ -628,8 +572,8 @@ Public Class FormMain Public IsSizeSaveable As Boolean = False Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded If IsSizeSaveable Then - WriteReg("WindowHeight", Height) - WriteReg("WindowWidth", Width) + Setup.Set("WindowHeight", Height) + Setup.Set("WindowWidth", Width) End If RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight) PanForm.Width = BorderForm.ActualWidth + 0.001 @@ -658,7 +602,7 @@ Public Class FormMain Exit Sub ElseIf e.Key = Key.Escape Then Dim Msg As Object = PanMsg.Children(0) - If TypeOf Msg Is MyMsgText AndAlso Msg.Btn3.Visibility = Visibility.Visible Then + If TypeOf Msg IsNot MyMsgInput AndAlso TypeOf Msg IsNot MyMsgSelect AndAlso Msg.Btn3.Visibility = Visibility.Visible Then Msg.Btn3_Click() ElseIf Msg.Btn2.Visibility = Visibility.Visible Then Msg.Btn2_Click() @@ -687,6 +631,12 @@ Public Class FormMain PageSetupUI.HiddenRefresh() Exit Sub End If + '按 F5 刷新页面 + If e.Key = Key.F5 Then + If TypeOf PageLeft Is IRefreshable Then CType(PageLeft, IRefreshable).Refresh() + If TypeOf PageRight Is IRefreshable Then CType(PageRight, IRefreshable).Refresh() + Exit Sub + End If '调用启动游戏 If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then If IsAprilEnabled AndAlso Not IsAprilGiveup Then @@ -715,7 +665,7 @@ Public Class FormMain Try If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then 'Mod 管理自动刷新 - FrmVersionMod.RefreshList() + FrmVersionMod.ReloadModList() ElseIf PageCurrent = PageType.VersionSelect Then '版本选择自动刷新 LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") @@ -824,14 +774,14 @@ Public Class FormMain If FilePathList.Count > 1 Then '必须要求全部为 jar 文件 For Each File In FilePathList - If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then + If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then Hint("一次请只拖入一个文件！", HintType.Critical) Exit Sub End If Next End If '自定义主页 - Dim Extension As String = FilePath.After(".").ToLower + Dim Extension As String = FilePath.AfterLast(".").ToLower If Extension = "xaml" Then Log("[System] 文件后缀为 XAML，作为自定义主页加载") If File.Exists(Path & "PCL\Custom.xaml") Then @@ -840,51 +790,27 @@ Public Class FormMain End If End If CopyFile(FilePath, Path & "PCL\Custom.xaml") - RunInUi(Sub() - Setup.Set("UiCustomType", 1) - FrmLaunchRight.ForceRefresh() - Hint("已加载主页自定义文件！", HintType.Finish) - End Sub) - Exit Sub - End If - 'Mod 安装 - If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then - Log("[System] 文件为 jar/litemod 格式，尝试作为 Mod 安装") - '获取并检查目标版本 - Dim TargetVersion As McVersion = McVersionCurrent - If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version - If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then - '正在选择版本，或当前版本不能安装 Mod - Hint("若要安装 Mod，请先选择一个可以安装 Mod 的版本！") - ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then - '未处于 Mod 管理页面 - If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}？", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install - Else - '处于 Mod 管理页面 -Install: - Try - For Each ModFile In FilePathList - CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile)) - Next - If FilePathList.Count = 1 Then - Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}！", HintType.Finish) - Else - Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Finish) - End If - '刷新列表 - If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then - LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun) - End If - Catch ex As Exception - Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox) - End Try - End If + RunInUi( + Sub() + Setup.Set("UiCustomType", 1) + FrmLaunchRight.ForceRefresh() + Hint("已加载主页自定义文件！", HintType.Finish) + End Sub) Exit Sub End If + '安装 Mod + If PageVersionMod.InstallMods(FilePathList) Then Exit Sub '安装整合包 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试 Log("[System] 文件为压缩包，尝试作为整合包安装") - If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub + Try + ModpackInstall(FilePath) + Exit Sub + Catch ex As CancelledException + Exit Sub '用户主动取消 + Catch ex As Exception + '安装失败，继续往后尝试 + End Try End If 'RAR 处理 If Extension = "rar" Then @@ -958,18 +884,19 @@ Install: ''' 把当前窗口拖到最前面。 ''' Public Sub ShowWindowToTop() - RunInUi(Sub() - '这一坨乱七八糟的，别改，改了指不定就炸了，自己电脑还复现不出来 - Visibility = Visibility.Visible - ShowInTaskbar = True - WindowState = WindowState.Normal - Hidden = False - Topmost = True '偶尔 SetForegroundWindow 失效 - Topmost = False - SetForegroundWindow(Handle) - Focus() - Log("[System] 窗口已置顶，位置：(" & Left & ", " & Top & "), " & Width & " x " & Height) - End Sub) + RunInUi( + Sub() + '这一坨乱七八糟的，别改，改了指不定就炸了，自己电脑还复现不出来 + Visibility = Visibility.Visible + ShowInTaskbar = True + WindowState = WindowState.Normal + Hidden = False + Topmost = True '偶尔 SetForegroundWindow 失效 + Topmost = False + SetForegroundWindow(Handle) + Focus() + Log($"[System] 窗口已置顶，位置：({Left}, {Top}), {Width} x {Height}") + End Sub) End Sub #End Region @@ -1114,9 +1041,6 @@ Install: Case PageType.Download If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft Return FrmDownloadLeft.PageID - Case PageType.Link - If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft - Return FrmLinkLeft.PageID Case PageType.Setup If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft Return FrmSetupLeft.PageID @@ -1185,9 +1109,6 @@ Install: CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "") IsChangingPage = False Select Case Stack.Page - Case PageType.Link - If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft - CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) Case PageType.Download If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) @@ -1216,14 +1137,6 @@ Install: If IsChangingPage Then Exit Sub PageChangeActual(Val(sender.Tag)) End Sub - Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick - If MyMsgBox("由于联机提供商要求新联机强制付费，且高度商业化，PCL 将暂时关闭联机功能，不再使用该联机模块。" & vbCrLf & - "PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能，在开发结束后将同步开放，请各位多多理解。", - "联机功能已暂时关闭", "查看详情", "确定") = 1 Then - OpenWebsite("https://www.bilibili.com/read/cv19845645") - End If - e.Handled = True - End Sub ''' ''' 通过点击返回按钮或手动触发返回来改变页面。 ''' @@ -1254,9 +1167,9 @@ Install: If PageStack.Any Then '子页面 → 另一个子页面，更新 AniStart({ - AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130), - AaCode(Sub() LabTitleInner.Text = PageName,, True), - AaOpacity(LabTitleInner, 1, 150, 30) + AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130), + AaCode(Sub() LabTitleInner.Text = PageName,, True), + AaOpacity(LabTitleInner, 1, 150, 30) }, "FrmMain Titlebar SubLayer") If PageStack.Contains(Stack) Then '返回到更上层的子页面 @@ -1350,37 +1263,41 @@ Install: AniControlEnabled -= 1 '执行动画 AniStart({ - AaCode(Sub() - AniControlEnabled += 1 - '把新页面添加进容器 - PanMainLeft.Child = PageLeft - PageLeft.Opacity = 0 - PanMainLeft.Background = Nothing - AniControlEnabled -= 1 - RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True) - End Sub, 130), - AaCode(Sub() - '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 - PageLeft.Opacity = 1 - PageLeft.TriggerShowAnimation() - End Sub, 30, True) + AaCode( + Sub() + AniControlEnabled += 1 + '把新页面添加进容器 + PanMainLeft.Child = PageLeft + PageLeft.Opacity = 0 + PanMainLeft.Background = Nothing + AniControlEnabled -= 1 + RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True) + End Sub, 130), + AaCode( + Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + PageLeft.Opacity = 1 + PageLeft.TriggerShowAnimation() + End Sub, 30, True) }, "FrmMain PageChangeLeft") AniStart({ - AaCode(Sub() - AniControlEnabled += 1 - CType(PanMainRight.Child, MyPageRight).PageOnForceExit() - '把新页面添加进容器 - PanMainRight.Child = PageRight - PageRight.Opacity = 0 - PanMainRight.Background = Nothing - AniControlEnabled -= 1 - RunInUi(Sub() BtnExtraBack.ShowRefresh(), True) - End Sub, 130), - AaCode(Sub() - '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 - PageRight.Opacity = 1 - PageRight.PageOnEnter() - End Sub, 30, True) + AaCode( + Sub() + AniControlEnabled += 1 + CType(PanMainRight.Child, MyPageRight).PageOnForceExit() + '把新页面添加进容器 + PanMainRight.Child = PageRight + PageRight.Opacity = 0 + PanMainRight.Background = Nothing + AniControlEnabled -= 1 + RunInUi(Sub() BtnExtraBack.ShowRefresh(), True) + End Sub, 130), + AaCode( + Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + PageRight.Opacity = 1 + PageRight.PageOnEnter() + End Sub, 30, True) }, "FrmMain PageChangeRight") End Sub ''' @@ -1393,12 +1310,12 @@ Install: PanTitleMain.IsHitTestVisible = True PanTitleInner.IsHitTestVisible = False AniStart({ - AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150), - AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent), - AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200), - AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)), - AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True) - }, "FrmMain Titlebar FirstLayer") + AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150), + AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent), + AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200), + AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True) + }, "FrmMain Titlebar FirstLayer") PageStack.Clear() Else '主页面 → 主页面，无事发生 @@ -1417,16 +1334,16 @@ Install: 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) + 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) + AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent), + AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200), + AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170) }, "FrmMain LeftChange", True) End If Else diff --git a/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png b/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png deleted file mode 100644 index 803e812..0000000 Binary files a/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png and /dev/null differ diff --git a/Plain Craft Launcher 2/Images/Heads/z0z0r4.png b/Plain Craft Launcher 2/Images/Heads/z0z0r4.png new file mode 100644 index 0000000..622a0bf Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/z0z0r4.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/Unavaliable.png b/Plain Craft Launcher 2/Images/Icons/Unavailable.png similarity index 100% rename from Plain Craft Launcher 2/Images/Icons/Unavaliable.png rename to Plain Craft Launcher 2/Images/Icons/Unavailable.png diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 4e3d9bb..3ff1d81 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -1,4 +1,5 @@ -Imports System.IO.Compression +Imports System.Globalization +Imports System.IO.Compression Imports System.Runtime.CompilerServices Imports System.Security.Cryptography Imports System.Security.Principal @@ -11,12 +12,13 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.8.0" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.8.0." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.8.12" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.8.12." & VersionBranchCode '标准格式的四段式版本号 + Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换 #If BETA Then - Public Const VersionCode As Integer = 326 'Release + Public Const VersionCode As Integer = 347 'Release #Else - Public Const VersionCode As Integer = 327 'Snapshot + Public Const VersionCode As Integer = 346 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -64,7 +66,7 @@ Public Module ModBase ''' Public ApplicationOpenTime As Date = Date.Now ''' - ''' 设备唯一标识符。 + ''' 识别码。 ''' Public UniqueAddress As String = SecretGetUniqueAddress() ''' @@ -80,13 +82,9 @@ Public Module ModBase ''' Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936 ''' - ''' 操作系统版本。Win10 为 10.0。 - ''' - Public OsVersion As Version = Environment.OSVersion.Version - ''' ''' 系统盘盘符，以 \ 结尾。例如 “C:\”。 ''' - Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\" + Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799 ''' ''' 程序的缓存文件夹路径，以 \ 结尾。 ''' @@ -178,6 +176,10 @@ Public Module ModBase ''' Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z" ''' + ''' 图标，服务端，1x + ''' + Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z" + ''' ''' 图标，向右箭头，1x ''' Public Const IconButtonRight As String = "M757.792745 435.407215L419.597482 96.904967c-40.010393-40.010393-104.886579-40.010393-144.896972 0-40.010393 40.010393-40.010393 104.988908 0 144.9993L540.344959 507.855701 274.70051 773.807135c-40.010393 40.112721-40.010393 104.988908 0 144.9993 40.010393 40.010393 104.886579 40.010393 144.896972 0l338.092935-338.39992c40.112721-40.010393 40.112721-104.988908 0.102328-144.9993z" @@ -704,7 +706,7 @@ Public Module ModBase If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" WriteFile(FileName, FileContent.ToString) Catch ex As Exception - Log(ex, $"写入文件失败（{FileName} -> {Key}:{Value}）") + Log(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogLevel.Hint) End Try End Sub @@ -778,10 +780,10 @@ Public Module ModBase End Try End Sub ''' - ''' 读取文件，如果失败则返回空字符串。 + ''' 读取文件，如果失败则返回空数组。 ''' ''' 文件完整或相对路径。 - Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String + Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte() Try '还原文件路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath @@ -791,17 +793,25 @@ Public Module ModBase ReDim FileBytes(ReadStream.Length - 1) ReadStream.Read(FileBytes, 0, ReadStream.Length) End Using - ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes)) + Return FileBytes Else - Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath) - Return "" + Log("[System] 欲读取的文件不存在，已返回空内容：" & FilePath) + Return {} End If Catch ex As Exception Log(ex, "读取文件出错：" & FilePath) - Return "" + Return {} End Try End Function ''' + ''' 读取文件，如果失败则返回空字符串。 + ''' + ''' 文件完整或相对路径。 + Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String + Dim FileBytes = ReadFileBytes(FilePath) + ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes)) + End Function + ''' ''' 读取流中的所有文本。 ''' Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String @@ -826,50 +836,39 @@ Public Module ModBase ''' 文件完整或相对路径。 ''' 文件内容。 ''' 是否将文件内容追加到当前文件，而不是覆盖它。 - Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean - Try - '还原文件路径 - If Not FilePath.Contains(":\") Then FilePath = Path & FilePath - '确保目录存在 - Directory.CreateDirectory(GetPathFromFullPath(FilePath)) - '写入文件 - If File.Exists(FilePath) Then - '如果文件存在，刷新目前文件 - Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath))) - writer.Write(Text) - writer.Flush() - writer.Close() - End Using - Else - '如果文件不存在，则新建并写入 - File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) - End If - Return True - Catch ex As Exception - Log(ex, "写入文件时出错：" & FilePath) - Return False - End Try - End Function + Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(FilePath)) + '写入文件 + If File.Exists(FilePath) Then + '如果文件存在，刷新目前文件 + Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath)))) + writer.Write(Text) + writer.Flush() + writer.Close() + End Using + Else + '如果文件不存在，则新建并写入 + File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) + End If + End Sub ''' ''' 写入文件。 + ''' 如果 CanThrow 设置为 False，返回是否写入成功。 ''' ''' 文件完整或相对路径。 ''' 文件内容。 ''' 是否将文件内容追加到当前文件，而不是覆盖它。 - Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean - Try - '还原文件路径 - If Not FilePath.Contains(":\") Then FilePath = Path & FilePath - '确保目录存在 - Directory.CreateDirectory(GetPathFromFullPath(FilePath)) - '写入文件 - File.WriteAllBytes(FilePath, Content) - Return True - Catch ex As Exception - Log(ex, "写入文件时出错：" & FilePath) - Return False - End Try - End Function + Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(FilePath)) + '写入文件 + File.WriteAllBytes(FilePath, Content) + End Sub ''' ''' 将流写入文件。 ''' @@ -899,21 +898,11 @@ Public Module ModBase '文件编码 ''' - ''' 获取文件编码。 - ''' - ''' 文件完整或相对路径。 - Public Function GetEncoding(FilePath As String) As Encoding - '还原文件路径 - If Not FilePath.Contains(":\") Then FilePath = Path & FilePath - '获取编码 - GetEncoding = GetEncoding(File.ReadAllBytes(FilePath)) - End Function - ''' - ''' 获取 Bytes 的编码。 + ''' 根据字节数组分析其编码。 ''' Public Function GetEncoding(Bytes As Byte()) As Encoding Dim Length As Integer = Bytes.Count - If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8 + If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8 '根据 BOM 判断编码 If Bytes(0) >= &HEF Then '有 BOM 类型 @@ -986,7 +975,7 @@ Public Module ModBase End Using End Function ''' - ''' 弹出选取文件对话框并且要求选取文件。 + ''' 弹出选取文件对话框，要求选择一个文件。 ''' ''' 要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。 ''' 弹窗的标题。 @@ -1000,12 +989,32 @@ Public Module ModBase fileDialog.Title = Title fileDialog.ValidateNames = True fileDialog.ShowDialog() - SelectFile = fileDialog.FileName - Log("[UI] 选择文件返回：" & SelectFile) + Log("[UI] 选择单个文件返回：" & fileDialog.FileName) + Return fileDialog.FileName End Using End Function ''' - ''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。 + ''' 弹出选取文件对话框，要求选择多个文件。 + ''' + ''' 要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。 + ''' 弹窗的标题。 + Public Function SelectFiles(FileFilter As String, Title As String) As String() + Using fileDialog As New Forms.OpenFileDialog + fileDialog.AddExtension = True + fileDialog.AutoUpgradeEnabled = True + fileDialog.CheckFileExists = True + fileDialog.Filter = FileFilter + fileDialog.Multiselect = True + fileDialog.Title = Title + fileDialog.ValidateNames = True + fileDialog.ShowDialog() + Log("[UI] 选择多个文件返回：" & fileDialog.FileNames.Join(",")) + Return fileDialog.FileNames + End Using + End Function + ''' + ''' 弹出选取文件夹对话框，要求选取文件夹。 + ''' 返回以 \ 结尾的完整路径，如果没有选择则返回空字符串。 ''' Public Function SelectFolder(Optional Title As String = "选择文件夹") As String Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True} @@ -1020,7 +1029,7 @@ Public Module ModBase ''' Public Function CheckPermission(Path As String) As Boolean Try - If Path = "" Then Return False + If String.IsNullOrEmpty(Path) Then Return False If Not Path.EndsWithF("\") Then Path += "\" If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False If Not Directory.Exists(Path) Then Return False @@ -1112,8 +1121,6 @@ Re: Dim Retry As Boolean = False Re: Try - ''检测该文件是否在下载中，若在下载则放弃检测 - 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return "" '获取 SHA1 Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) Dim sha1 As SHA1 = New SHA1CryptoServiceProvider() @@ -1224,7 +1231,8 @@ Re: ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。 ''' 会尝试创建，但不会清空目标文件夹。 ''' - Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) + Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing, + Optional ProgressIncrementHandler As Action(Of Double) = Nothing) Directory.CreateDirectory(DestDirectory) If CompressFilePath.EndsWithF(".gz", True) Then '以 gz 方式解压 @@ -1240,7 +1248,9 @@ Re: Else '以 zip 方式解压 Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030"))) + Dim TotalCount As Integer = Archive.Entries.Count For Each Entry As ZipArchiveEntry In Archive.Entries + If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / TotalCount) Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then Continue For '不创建空文件夹 @@ -1259,28 +1269,47 @@ Re: Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer If Not Directory.Exists(Path) Then Return 0 Dim DeletedCount As Integer = 0 - Dim Temp As String() - Temp = Directory.GetFiles(Path) - For Each str As String In Temp + Dim Files As String() + Try + Files = Directory.GetFiles(Path) + Catch ex As DirectoryNotFoundException '#4549 + Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer) + Directory.Delete(Path) + Return 0 + End Try + For Each FilePath As String In Files + Dim RetriedFile As Boolean = False +RetryFile: Try - File.Delete(str) + File.Delete(FilePath) DeletedCount += 1 Catch ex As Exception - If IgnoreIssue Then + If Not RetriedFile Then + RetriedFile = True + Log(ex, $"删除文件失败，将在 0.3s 后重试（{FilePath}）") + Thread.Sleep(300) + GoTo RetryFile + ElseIf IgnoreIssue Then Log(ex, "删除单个文件可忽略地失败") Else Throw End If End Try Next - Temp = Directory.GetDirectories(Path) - For Each str As String In Temp + For Each str As String In Directory.GetDirectories(Path) DeleteDirectory(str, IgnoreIssue) Next + Dim RetriedDir As Boolean = False +RetryDir: Try Directory.Delete(Path, True) Catch ex As Exception - If IgnoreIssue Then + If Not RetriedDir Then + RetriedDir = True + Log(ex, $"删除文件夹失败，将在 0.3s 后重试（{Path}）") + Thread.Sleep(300) + GoTo RetryDir + ElseIf IgnoreIssue Then Log(ex, "删除单个文件夹可忽略地失败") Else Throw @@ -1291,13 +1320,16 @@ Re: ''' ''' 复制文件夹，失败会抛出异常。 ''' - Public Sub CopyDirectory(FromPath As String, ToPath As String) + Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing) FromPath = FromPath.Replace("/", "\") If Not FromPath.EndsWithF("\") Then FromPath &= "\" ToPath = ToPath.Replace("/", "\") If Not ToPath.EndsWithF("\") Then ToPath &= "\" - For Each File In EnumerateFiles(FromPath) + Dim AllFiles = EnumerateFiles(FromPath).ToList + Dim FileCount As Integer = AllFiles.Count + For Each File In AllFiles CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath)) + If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / FileCount) Next End Sub ''' @@ -1346,8 +1378,8 @@ Re: '常见错误（记得同时修改下面的） Dim CommonReason As String = Nothing - If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" + If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then + CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。" ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then CommonReason = "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。" ElseIf TypeOf InnerEx Is OutOfMemoryException Then @@ -1366,7 +1398,7 @@ Re: If CommonReason Is Nothing Then Return Desc & Stack & TypeDesc Else - Dim Result As String = DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf + Dim Result As String = CommonReason & vbCrLf & DescList.First & vbCrLf & "————————————" & vbCrLf DescList(0) = "详细错误信息：" Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc End If @@ -1394,8 +1426,8 @@ Re: '常见错误（记得同时修改上面的） Dim CommonReason As String = Nothing - If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。" + If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then + CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。" ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then CommonReason = "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。" ElseIf TypeOf InnerEx Is OutOfMemoryException Then @@ -1409,7 +1441,7 @@ Re: '构造输出信息 If CommonReason IsNot Nothing Then - Return DescList.First & "：" & CommonReason + Return CommonReason & "详细错误：" & DescList.First Else DescList.Reverse() '让最深层错误在最左边 Return Join(DescList, " → ") @@ -1449,14 +1481,14 @@ Re: End Function ''' - ''' 获取 Json 对象。 + ''' 获取 JSON 对象。 ''' Public Function GetJson(Data As String) Try Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local}) Catch ex As Exception Dim Length As Integer = If(Data, "").Length - Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data)) + Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data)) End Try End Function @@ -1550,10 +1582,10 @@ Re: End Function ''' - ''' 获取在子字符串之前的部分。 - ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。 + ''' 获取在子字符串第一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024。 + ''' 如果未找到子字符串则不裁切。 ''' - Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Public Function BeforeFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase)) If Pos >= 0 Then Return Str.Substring(0, Pos) @@ -1562,10 +1594,34 @@ Re: End If End Function ''' - ''' 获取在子字符串之后的部分。 - ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。 + ''' 获取在子字符串最后一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024/11。 + ''' 如果未找到子字符串则不裁切。 ''' - Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Public Function BeforeLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase)) + If Pos >= 0 Then + Return Str.Substring(0, Pos) + Else + Return Str + End If + End Function + ''' + ''' 获取在子字符串第一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 11/08。 + ''' 如果未找到子字符串则不裁切。 + ''' + Public Function AfterFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String + Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase)) + If Pos >= 0 Then + Return Str.Substring(Pos + Text.Length) + Else + Return Str + End If + End Function + ''' + ''' 获取在子字符串最后一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 08。 + ''' 如果未找到子字符串则不裁切。 + ''' + Public Function AfterLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase)) If Pos >= 0 Then Return Str.Substring(Pos + Text.Length) @@ -1574,17 +1630,17 @@ Re: End If End Function ''' - ''' 获取处于两个子字符串之间的部分。 - ''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。 + ''' 获取处于两个子字符串之间的部分，裁切尽可能多的内容。 + ''' 如果未找到子字符串则不裁切。 ''' - Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String - Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase)) + Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String + Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase)) If StartPos >= 0 Then - StartPos += Before.Length + StartPos += After.Length Else StartPos = 0 End If - Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase)) + Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase)) If EndPos >= 0 Then Return Str.Substring(StartPos, EndPos - StartPos) ElseIf StartPos > 0 Then @@ -1645,10 +1701,15 @@ Re: End Function ''' - ''' 输入 And 字符不会报错的 Val。 + ''' 不会报错的 Val。 + ''' 如果输入有误，返回 0。 ''' Public Function Val(Str As Object) As Double - Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str)) + Try + Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str)) + Catch + Return 0 + End Try End Function '转义 @@ -1656,7 +1717,10 @@ Re: ''' 为字符串进行 XML 转义。 ''' Public Function EscapeXML(Str As String) As String - Return Str.Replace("&", "&").Replace("<", "<").Replace(">", ">").Replace("'", "'").Replace("""", """).Replace(vbCrLf, " ") + If Str.StartsWithF("{") Then Str = "{}" & Str '#4187 + Return Str. + Replace("&", "&").Replace("<", "<").Replace(">", ">").Replace("'", "'"). + Replace("""", """).Replace(vbCrLf, " ") End Function '正则 @@ -1802,10 +1866,10 @@ Re: '进行搜索，获取相似信息 For Each Entry In Entries Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query) - Entry.AbsoluteRight = False - For Each Pair In Entry.SearchSource - If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True - Next + Entry.AbsoluteRight = + Query.Split(" ").All( '对于按空格分割的每一段 + Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配，则标记为完全匹配项 + Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True))) Next '按照相似度进行排序 Entries = Sort(Entries, @@ -1834,6 +1898,68 @@ Re: #Region "系统" + ''' + ''' 线程安全的，可以直接使用 For Each 的 List。 + ''' 在使用 For Each 循环时，列表的结果可能并非最新，但不会抛出异常。 + ''' + Public Class SafeList(Of T) + Inherits SynchronizedCollection(Of T) + Implements IEnumerable, IEnumerable(Of T) + '构造函数 + Public Sub New() + MyBase.New() + End Sub + Public Sub New(Data As IEnumerable(Of T)) + MyBase.New(New Object, Data) + End Sub + Public Shared Widening Operator CType(Data As List(Of T)) As SafeList(Of T) + Return New SafeList(Of T)(Data) + End Operator + Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T) + Return New List(Of T)(Data) + End Operator + '基于 SyncLock 覆写 + Public Overloads Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator + SyncLock SyncRoot + Return Items.ToList.GetEnumerator() + End SyncLock + End Function + Private Overloads Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator + SyncLock SyncRoot + Return Items.ToList.GetEnumerator() + End SyncLock + End Function + End Class + + ''' + ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。 + ''' + Public PathPure As String = GetPureASCIIDir() + Private Function GetPureASCIIDir() As String + If (Path & "PCL").IsASCII() Then + Return Path & "PCL\" + ElseIf PathAppdata.IsASCII() Then + Return PathAppdata + ElseIf PathTemp.IsASCII() Then + Return PathTemp + Else + Return OsDrive & "ProgramData\PCL\" + End If + End Function + + ''' + ''' 指示接取到这个异常的函数进行重试。 + ''' + Public Class RestartException + Inherits Exception + End Class + ''' + ''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。 + ''' + Public Class CancelledException + Inherits Exception + End Class + ''' ''' 当前程序是否拥有管理员权限。 ''' @@ -1852,6 +1978,13 @@ Re: Return NewProcess.ExitCode End Function + ''' + ''' 判断当前系统语言是否为中文。 + ''' + Public Function IsSystemLanguageChinese() As Boolean + Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh" + End Function + Private Uuid As Integer = 1 Private UuidLock As Object ''' @@ -1943,10 +2076,10 @@ NextElement: '12~60 月，“1 年 2 个月” GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "") ElseIf TotalMonthes >= 4 Then - '4~11 月，“5 月” - GetTimeSpanString = TotalMonthes & " 月" + '4~11 月，“5 个月” + GetTimeSpanString = TotalMonthes & " 个月" ElseIf TotalMonthes >= 1 Then - '1~4 月，“2 月 13 天” + '1~4 月，“2 个月 13 天” GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "") ElseIf Span.TotalDays >= 4 Then '4~30 天，“23 天” @@ -2068,7 +2201,7 @@ NextElement: ''' ''' 在新的工作线程中执行代码。 ''' - Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread + Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread Dim th As New Thread( Sub() Try @@ -2078,7 +2211,7 @@ NextElement: Catch ex As Exception Log(ex, Name & "：线程执行失败", LogLevel.Feedback) End Try - End Sub) With {.Name = Name, .Priority = Priority} + End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority} th.Start() Return th End Function @@ -2417,6 +2550,14 @@ Retry: Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight) End Function + ''' + ''' 控件是否受到 TextTrimming 属性影响，导致内容被截取。 + ''' + Public Function IsTextTrimmed(Control As TextBlock) As Boolean + Control.Measure(New Size(Double.MaxValue, Double.MaxValue)) + Return Control.DesiredSize.Width > Control.ActualWidth + End Function + #End Region #Region "Debug" @@ -2657,7 +2798,11 @@ Retry: End Sub Public Function CanFeedback(ShowHint As Boolean) As Boolean If False.Equals(PageSetupSystem.IsLauncherNewest) Then - If ShowHint Then MyMsgBox("你的 PCL 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈") + If ShowHint Then + If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then + UpdateCheckByButton() + End If + End If Return False Else Return True @@ -2669,7 +2814,7 @@ Retry: Public Sub FeedbackInfo() On Error Resume Next Log("[System] 诊断信息：" & vbCrLf & - "操作系统：" & My.Computer.Info.OSFullName & vbCrLf & + "操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf & "剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf & "DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf & "MC 文件夹：" & If(PathMcFolder, "Nothing") & vbCrLf & diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb index 18ed602..f069882 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb @@ -91,17 +91,18 @@ _State = value Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value)) '实现 ILoadingTrigger 接口与 OnStateChanged 回调 - RunInUi(Sub() - Select Case value - Case LoadState.Loading - LoadingState = MyLoading.MyLoadingState.Run - Case LoadState.Failed - LoadingState = MyLoading.MyLoadingState.Error - Case Else - LoadingState = MyLoading.MyLoadingState.Stop - End Select - RaiseEvent OnStateChangedUi(Me, value, OldState) - End Sub) + RunInUi( + Sub() + Select Case value + Case LoadState.Loading + LoadingState = MyLoading.MyLoadingState.Run + Case LoadState.Failed + LoadingState = MyLoading.MyLoadingState.Error + Case Else + LoadingState = MyLoading.MyLoadingState.Stop + End Select + RaiseEvent OnStateChangedUi(Me, value, OldState) + End Sub) If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState)) End Set End Property @@ -287,15 +288,13 @@ End SyncLock End Try '检验输入以确定情况 - If (Not IsForceRestart) AndAlso '不要求强行重启 - ((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同 - (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功 + If IsForceRestart Then Return True '强制要求重启 + If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同 + If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束 (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时 - '如果输入相同且未出错则不重试 - Return False + Return False '则不重试 Else - '需要开始 - Return True + Return True '需要开始 End If End Function Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) @@ -316,7 +315,7 @@ Sub() Try IsForceRestarting = IsForceRestart - If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动") + If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已" & If(IsForceRestarting, "强制", "") & "启动") LoadDelegate(Me) If IsAborted Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束，输出被弃用（最新线程：" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & "）", LogLevel.Developer) @@ -440,12 +439,13 @@ Exit Sub End If End SyncLock - RunInThread(Sub() - '中断加载器 - For Each Loader In Loaders - Loader.Abort() - Next - End Sub) + RunInThread( + Sub() + '中断加载器 + For Each Loader In Loaders + Loader.Abort() + Next + End Sub) End Sub ''' @@ -484,7 +484,7 @@ Private Sub Update() If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub Dim IsFinished As Boolean = True - Dim Ignore As Boolean = False + Dim Blocked As Boolean = False Dim Input As Object = Me.Input For Each Loader In Loaders Select Case Loader.State @@ -492,28 +492,30 @@ '检查是否需要重启 If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then - If ModeDebug Then Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name) + Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name) GoTo Restart End If '更新下一个加载器的输入 Input = CType(Loader, Object).Output End If + '如果不让继续启动，且已有加载器正在加载中，就不继续启动 + If Loader.Block AndAlso Not IsFinished Then Blocked = True Case LoadState.Loading '检查是否需要重启 If Loader.GetType.Name.StartsWithF("LoaderTask") Then If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then - If ModeDebug Then Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, LogLevel.Developer) + Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, LogLevel.Developer) GoTo Restart End If End If '已经有正在加载中的了，不需要再启动了 IsFinished = False - Ignore = True + Blocked = True Case Else Restart: '未启动，则启动加载器 IsFinished = False - If Ignore Then Continue For + If Blocked Then Continue For If Input IsNot Nothing Then '若输入类型与下一个加载器相同才继续 Dim LoaderType As String = Loader.GetType.Name @@ -527,8 +529,8 @@ Restart: Else Loader.Start(IsForceRestart:=IsForceRestarting) End If - '如果不让继续启动，那就不启动呗 - If Loader.Block Then Ignore = True + '阻止继续 + If Loader.Block Then Blocked = True End Select Next If IsFinished Then @@ -566,38 +568,33 @@ Restart: End Class '任务栏进度条 - Public LoaderTaskbarLock As New Object - Public LoaderTaskbar As New List(Of LoaderBase) + Public LoaderTaskbar As New SafeList(Of LoaderBase) Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T)) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) - SyncLock LoaderTaskbarLock - LoaderTaskbar.Add(Loader) - Log($"[Taskbar] {Loader.Name} 已加入任务列表") - End SyncLock + LoaderTaskbar.Add(Loader) + Log($"[Taskbar] {Loader.Name} 已加入任务列表") End Sub Public Sub LoaderTaskbarProgressRefresh() Try Dim NewState As Shell.TaskbarItemProgressState Dim NewProgress As Double = LoaderTaskbarProgressGet() '检查任务是否完成，若完成则移除 - SyncLock LoaderTaskbarLock - '外显任务是否已经全部完成 - Dim IsAllDownloadTaskCompleted As Boolean = True - For Each Loader In LoaderTaskbar - 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 Then - If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) - LoaderTaskbar.Remove(Task) - Log($"[Taskbar] {Task.Name} 已移出任务列表") - End If - Next - End SyncLock + '外显任务是否已经全部完成 + Dim IsAllDownloadTaskCompleted As Boolean = True + For Each Loader In LoaderTaskbar.ToList() + 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 Then + If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) + LoaderTaskbar.Remove(Task) + Log($"[Taskbar] {Task.Name} 已移出任务列表") + End If + Next '更新平滑后的进度 If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then LoaderTaskbarProgress = NewProgress @@ -625,15 +622,8 @@ Restart: End Sub Public Function LoaderTaskbarProgressGet() As Double Try - Dim Total As Double = 0, Count As Integer = 0 - SyncLock LoaderTaskbarLock - For Each Task In LoaderTaskbar.ToList - Total += Task.Progress - Count += 1 '避免多线程影响导致计数出错 - Next - End SyncLock - If Count = 0 Then Return 1 - Return MathClamp(Total / Count, 0, 1) + If Not LoaderTaskbar.Any Then Return 1 + Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1) Catch ex As Exception Log(ex, "获取任务栏进度出错", LogLevel.Feedback) Return 0.5 diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index 8929ea2..f046d34 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -1,5 +1,4 @@ Imports System.Net -Imports PCL.ModNet Public Module ModNet Public Const NetDownloadEnd As String = ".PCLDownloading" @@ -141,7 +140,7 @@ Retry: ''' ''' 网页的 Url。 ''' 网页的编码，通常为 UTF-8。 - Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False) + Public Function NetGetCodeByRequestMultiple(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False) Dim Threads As New List(Of Thread) Dim RequestResult = Nothing Dim RequestEx As Exception = Nothing @@ -207,10 +206,10 @@ RequestFinished: Catch ex As ThreadInterruptedException Throw Catch ex As Exception - If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then - Throw New TimeoutException("连接服务器超时，已接收 " & Result.Count & " B（" & Url & "）") + If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then + Throw New TimeoutException($"获取结果失败（{CType(ex, WebException).Status}，{ex.Message}，{Url}）", ex) Else - Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex) + Throw New WebException($"获取结果失败（{If(TypeOf ex Is WebException, CType(ex, WebException).Status & "，", "")}{ex.Message}，{Url}）", ex) End If Finally Request.Abort() @@ -269,12 +268,7 @@ RequestFinished: '下载 Using Client As New WebClient Try - If UseBrowserUserAgent Then - Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" - Else - Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode - End If - Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/" + SecretHeadersSign(Url, Client, UseBrowserUserAgent) Client.DownloadFile(Url, LocalFile) Catch ex As Exception File.Delete(LocalFile) @@ -316,7 +310,7 @@ Retry: Catch ex As ThreadInterruptedException Throw Catch ex As Exception - If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999 + If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then Throw Select Case RetryCount Case 0 If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败（" & Url & "）") @@ -335,7 +329,7 @@ Retry: ''' ''' 同时发送多个网络请求并要求返回内容。 ''' - Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing) + Public Function NetRequestMultiple(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) Dim Threads As New List(Of Thread) Dim RequestResult = Nothing Dim RequestEx As Exception = Nothing @@ -344,7 +338,7 @@ Retry: Dim th As New Thread( Sub() Try - RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers) + RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog) Catch ex As Exception FailCount += 1 RequestEx = ex @@ -419,7 +413,7 @@ RequestFinished: Throw Catch ex As WebException If ex.Status = WebExceptionStatus.Timeout Then - Throw New WebException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex) + ex = New WebException($"连接服务器超时，请检查你的网络环境是否良好（{ex.Message}，{Url}）", ex) Else '获取请求失败的返回 Dim Res As String = "" @@ -433,15 +427,34 @@ RequestFinished: End Using Catch End Try - Throw New WebException("网络请求失败（" & Url & "，" & ex.Message & "）" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex) + If Res = "" Then + ex = New WebException($"网络请求失败（{ex.Status}，{ex.Message}，{Url}）", ex) + Else + ex = New ResponsedWebException($"服务器返回错误（{ex.Status}，{ex.Message}，{Url}）{vbCrLf}{Res}", Res, ex) + End If End If + If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer) + Throw ex Catch ex As Exception - Throw New WebException("网络请求失败（" & Url & "）", ex) + ex = New WebException("网络请求失败（" & Url & "）", ex) + If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer) + Throw ex Finally If DataStream IsNot Nothing Then DataStream.Dispose() If Resp IsNot Nothing Then Resp.Dispose() End Try End Function + Public Class ResponsedWebException + Inherits WebException + ''' + ''' 远程服务器给予的回复。 + ''' + Public Overloads Property Response As String + Public Sub New(Message As String, Response As String, InnerException As Exception) + MyBase.New(Message, InnerException) + Me.Response = Response + End Sub + End Class ''' ''' 最大线程数。 @@ -688,8 +701,7 @@ RequestFinished: ''' ''' 所属的文件列表任务。 ''' - Public Tasks As New List(Of LoaderDownload) - + Public Tasks As New SafeList(Of LoaderDownload) ''' ''' 所有下载源。 ''' @@ -881,7 +893,6 @@ RequestFinished: Public ReadOnly LockState As New Object Public ReadOnly LockChain As New Object Public ReadOnly LockSource As New Object - Public ReadOnly LockTasks As New Object Public ReadOnly Uuid As Integer = GetUuid() Public Overrides Function Equals(obj As Object) As Boolean @@ -919,7 +930,7 @@ RequestFinished: '条件检测 If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse - (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing + (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 @@ -928,7 +939,6 @@ RequestFinished: Dim StartPosition As Long, StartSource As NetSource = Nothing Dim Th As Thread, ThreadInfo As NetThread SyncLock LockChain - '获取线程起点与下载源 '不分割 If IsNoSplit Then GoTo Capture @@ -964,7 +974,8 @@ Capture: Next '是否禁用多线程，以及规定碎片大小 Dim TargetUrl As String = GetSource().Url - If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing + If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("mcimirror") OrElse TargetUrl.Contains("github.com") OrElse + TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing '寻找最大碎片 'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程 Dim FilePieceMax As NetThread = Threads @@ -980,10 +991,8 @@ StartThread: 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 Nothing '由于中断，已没有可用任务 - Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal} - End SyncLock + If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务 + Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal} ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} '链表处理 If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then @@ -1040,6 +1049,15 @@ StartThread: If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.ResponseUri.OriginalString}") End If + ''从响应头获取文件名 + 'If Info.IsFirstThread Then + ' Dim FileName As String = GetFileNameFromResponse(HttpResponse) + ' If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#：远程文件名：{If(FileName, "未提供")}") + ' If FileName IsNot Nothing AndAlso LocalName = "待定" Then + ' LocalName = FileName + ' Log($"[Download] {LocalName} {Info.Uuid}#：从响应头获取到文件名") + ' End If + 'End If '文件大小校验 ContentLength = HttpResponse.ContentLength If ContentLength = -1 Then @@ -1124,7 +1142,7 @@ NotSupportRange: If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount End SyncLock Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime - If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值 + If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值 If RealDataCount > 0 Then '有数据 If Info.DownloadDone = 0 Then @@ -1140,11 +1158,9 @@ NotSupportRange: End If SyncLock LockCount Info.Source.FailCount = 0 - SyncLock LockTasks - For Each Task In Tasks - Task.FailCount = 0 - Next - End SyncLock + For Each Task In Tasks + Task.FailCount = 0 + Next End SyncLock NetManager.DownloadDone += RealDataCount SyncLock LockDone @@ -1167,7 +1183,7 @@ NotSupportRange: ResultStream.Write(HttpData, 0, RealDataCount) End If '检查速度是否过慢 - If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s，且速度小于 1K/s + If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1.5s，且速度小于 1.5K/s Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。") End If Info.LastReceiveTime = GetTimeTick() @@ -1198,11 +1214,9 @@ SourceBreak: '状态变更 SyncLock LockCount Info.Source.FailCount += 1 - SyncLock LockTasks - For Each Task In Tasks - Task.FailCount += 1 - Next - End SyncLock + For Each Task In Tasks + Task.FailCount += 1 + Next End SyncLock Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "") Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse @@ -1281,6 +1295,17 @@ Wrong: If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge() End Try End Sub + ''' + ''' 从 HTTP 响应头中获取文件名。 + ''' 如果没有，返回 Nothing。 + ''' + Private Function GetFileNameFromResponse(response As HttpWebResponse) As String + Dim header As String = response.Headers("Content-Disposition") + If String.IsNullOrEmpty(header) Then Return Nothing + 'attachment; filename="filename.ext" + If Not header.Contains("filename=") Then Return Nothing + Return header.AfterLast("filename=").Trim(""""c, " "c).BeforeFirst(";") + End Function '下载文件的最终收束事件 ''' @@ -1307,7 +1332,7 @@ Retry: '合并文件 If IsNoSplit Then '仅有一个线程，从缓存中输出 - If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件") + If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件，长度：" & SmailFileCache.Count) MergeFile = New FileStream(LocalPath, FileMode.Create) AddWriter = New BinaryWriter(MergeFile) AddWriter.Write(SmailFileCache.ToArray) @@ -1338,13 +1363,13 @@ Retry: If Check.ActualSize = -1 Then Check.ActualSize = FileSize ElseIf Check.ActualSize <> FileSize Then - Throw New Exception("文件大小不一致：任务要求为 " & Check.ActualSize & " B，网络获取结果为 " & FileSize & "B") + Throw New Exception($"文件大小不一致：任务要求为 {Check.ActualSize} B，网络获取结果为 {FileSize}B") End If End If '检查文件 Dim CheckResult As String = Check?.Check(LocalPath) If CheckResult IsNot Nothing Then - Log($"[Download] {LocalName} 合并文件失败，下载线程细节：") + Log($"[Download] {LocalName} 文件校验失败，下载线程细节：") For Each Th As NetThread In Threads Log($"[Download] {Th.Uuid}#，状态 {GetStringFromEnum(Th.State)}，范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone}，完成 {Th.DownloadDone}，剩余 {Th.DownloadUndone}") Next @@ -1397,10 +1422,8 @@ Retry: ''' Public Sub Abort(CausedByTask As LoaderDownload) '从特定任务中移除，如果它还属于其他任务，则继续下载 - SyncLock LockTasks - Tasks.Remove(CausedByTask) - If Tasks.Any Then Exit Sub - End SyncLock + Tasks.Remove(CausedByTask) + If Tasks.Any Then Exit Sub '确认中断 SyncLock LockState If State >= NetState.Finish Then Exit Sub @@ -1430,11 +1453,9 @@ Retry: NetManager.FileRemain -= 1 If PrintLog Then Log("[Download] " & LocalName & "：已完成，剩余文件 " & NetManager.FileRemain) End SyncLock - SyncLock LockTasks - For Each Task In Tasks - Task.OnFileFinish(Me) - Next - End SyncLock + For Each Task In Tasks + Task.OnFileFinish(Me) + Next End Sub End Class @@ -1449,8 +1470,7 @@ Retry: ''' ''' 需要下载的文件。 ''' - Public Files As List(Of NetFile) - Private ReadOnly FilesLock As New Object + Public Files As SafeList(Of NetFile) ''' ''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用） ''' @@ -1463,9 +1483,7 @@ Retry: Public Overrides Property Progress As Double Get If State >= LoadState.Finished Then Return 1 - SyncLock FilesLock - If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了 - End SyncLock + If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了 Return _Progress End Get Set(value As Double) @@ -1487,16 +1505,14 @@ Retry: Log("[Download] 由于同加载器中失败次数过多引发强制失败：连续失败了 " & value & " 次", LogLevel.Debug) On Error Resume Next Dim ExList As New List(Of Exception) - SyncLock FilesLock - For Each File In Files - For Each Source In File.Sources - If Source.Ex IsNot Nothing Then - ExList.Add(Source.Ex) - If ExList.Count > 10 Then GoTo FinishExCatch - End If - Next + For Each File In Files + For Each Source In File.Sources + If Source.Ex IsNot Nothing Then + ExList.Add(Source.Ex) + If ExList.Count > 10 Then GoTo FinishExCatch + End If Next - End SyncLock + Next FinishExCatch: OnFail(ExList) End If @@ -1513,17 +1529,15 @@ FinishExCatch: '计算进度 Dim NewProgress As Double = 0 Dim TotalProgress As Double = 0 - SyncLock FilesLock - For Each File In Files - If File.IsCopy Then - NewProgress += File.Progress * 0.2 - TotalProgress += 0.2 - Else - NewProgress += File.Progress - TotalProgress += 1 - End If - Next - End SyncLock + For Each File In Files + If File.IsCopy Then + NewProgress += File.Progress * 0.2 + TotalProgress += 0.2 + Else + NewProgress += File.Progress + TotalProgress += 1 + End If + Next If TotalProgress > 0 Then NewProgress /= TotalProgress '刷新进度 If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况 @@ -1532,27 +1546,25 @@ FinishExCatch: Public Sub New(Name As String, FileTasks As List(Of NetFile)) Me.Name = Name - Files = FileTasks + Files = New SafeList(Of NetFile)(FileTasks) End Sub Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) - SyncLock FilesLock - If Input IsNot Nothing Then Files = Input - '去重 - Dim ResultArray As New List(Of NetFile) - For i = 0 To Files.Count - 1 - For ii = i + 1 To Files.Count - 1 - If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement - Next - ResultArray.Add(Files(i)) + If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input) + '去重 + Dim ResultArray As New SafeList(Of NetFile) + For i = 0 To Files.Count - 1 + For ii = i + 1 To Files.Count - 1 + If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement + Next + ResultArray.Add(Files(i)) NextElement: - Next i - Files = ResultArray - '设置剩余文件数 - SyncLock FileRemainLock - For Each File In Files - If File.State <> NetState.Finish Then FileRemain += 1 - Next - End SyncLock + Next + Files = ResultArray + '设置剩余文件数 + SyncLock FileRemainLock + For Each File In Files + If File.State <> NetState.Finish Then FileRemain += 1 + Next End SyncLock State = LoadState.Loading '开始执行 @@ -1595,25 +1607,23 @@ NextElement: 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 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 - End SyncLock + 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 Catch ex As Exception OnFail(New List(Of Exception) From {ex}) End Try @@ -1652,6 +1662,9 @@ NextElement: '复制已存在的文件 For Each FileToken In ExistFiles Dim File As NetFile = FileToken.Key + SyncLock LockState + If File.State > NetState.WaitForCopy Then Exit Sub + End SyncLock Dim LocalPath As String = FileToken.Value Dim RetryCount As Integer = 0 Retry: @@ -1705,24 +1718,20 @@ Retry: Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList [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 & "）")), vbCrLf), [Error]) - Exit For - End If - Next - End SyncLock + 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 & "）")), vbCrLf), [Error]) + Exit For + End If + Next '在设置 Error 对象后再更改为失败，避免 WaitForExit 无法捕获错误 State = LoadState.Failed End SyncLock '中断所有文件 - SyncLock FilesLock - For Each TaskFile In Files - If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error - Next - End SyncLock + For Each TaskFile In Files + If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error + Next '在退出同步锁后再进行日志输出 Dim ErrOutput As New List(Of String) For Each Ex As Exception In ExList @@ -1737,11 +1746,9 @@ Retry: End SyncLock Log("[Download] " & Name & " 已取消！") '中断所有文件 - SyncLock FilesLock - For Each TaskFile In Files - TaskFile.Abort(Me) - Next - End SyncLock + For Each TaskFile In Files + TaskFile.Abort(Me) + Next End Sub End Class @@ -1763,8 +1770,7 @@ Retry: ''' ''' 当前的所有下载任务。 ''' - Public Tasks As New List(Of LoaderDownload) - Private ReadOnly LockTasks As New Object + Public Tasks As New SafeList(Of LoaderDownload) ''' ''' 已下载完成的大小。 @@ -1837,11 +1843,9 @@ Retry: End If #End Region #Region "刷新下载任务属性" - SyncLock LockTasks - For Each Task In Tasks - Task.RefreshStat() - Next - End SyncLock + For Each Task In Tasks + Task.RefreshStat() + Next #End Region Catch ex As Exception Log(ex, "刷新下载公开属性失败") @@ -1880,7 +1884,7 @@ Retry: 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 + If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests Next '为进行中的文件追加线程 If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增 @@ -1900,7 +1904,7 @@ Retry: '新增线程 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 + If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests Next End While Catch ex As Exception @@ -1961,9 +1965,7 @@ Retry: If Files(File.LocalPath).State >= NetState.Finish Then '该文件已经下载过一次，且下载完成 '将已下载的文件替换成当前文件，重新下载 - SyncLock File.LockTasks - File.Tasks.Add(Task) - End SyncLock + File.Tasks.Add(Task) Files(File.LocalPath) = File SyncLock LockRemain FileRemain += 1 @@ -1974,15 +1976,11 @@ Retry: '该文件正在下载中 '将当前文件替换成下载中的文件，即两个任务指向同一个文件 File = Files(File.LocalPath) - SyncLock File.LockTasks - File.Tasks.Add(Task) - End SyncLock + File.Tasks.Add(Task) End If Else '没有该文件 - SyncLock File.LockTasks - File.Tasks.Add(Task) - End SyncLock + File.Tasks.Add(Task) Files.Add(File.LocalPath, File) SyncLock LockRemain FileRemain += 1 @@ -1993,9 +1991,7 @@ Retry: Task.Files(i) = File '回设 Next End SyncLock - SyncLock LockTasks - Tasks.Add(Task) - End SyncLock + Tasks.Add(Task) End Sub End Class @@ -2004,14 +2000,12 @@ Retry: ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？ ''' Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean - SyncLock LoaderTaskbarLock - For Each Task In LoaderTaskbar - If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso - (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then - Return True - End If - Next - End SyncLock + For Each Task In LoaderTaskbar.ToList() + If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso + (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then + Return True + End If + Next Return False End Function diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb index 9dd8a4c..fbbc2f8 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -233,6 +233,8 @@ Public Class ValidateFolderName '检查特殊字符串 Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str) If Not InvalidStrCheck = "" Then Return InvalidStrCheck + '检查 NTFS 8.3 文件名（#4505） + If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！" '检查文件夹重名 Dim Arr As New List(Of String) If PathIgnore IsNot Nothing Then @@ -289,6 +291,8 @@ Public Class ValidateFileName '检查特殊字符串 Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %！", True).Validate(Str) If Not InvalidStrCheck = "" Then Return InvalidStrCheck + '检查 NTFS 8.3 文件名（#4505） + If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！" '检查文件重名 If ParentFolder IsNot Nothing Then Dim DirInfo As New DirectoryInfo(ParentFolder) @@ -355,6 +359,8 @@ Fin: '检查特殊字符串 Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr) If Not InvalidStrCheck = "" Then Return InvalidStrCheck + '检查 NTFS 8.3 文件名（#4505） + If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！" Next Return "" End Function diff --git a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb index 0b074e6..c5303d6 100644 --- a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb +++ b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb @@ -7,7 +7,7 @@ Public Class MyBitmap ''' ''' 位图缓存。 ''' - Public Shared BitmapCache As New Dictionary(Of String, MyBitmap) + Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap) ''' ''' 存储的图片 @@ -17,15 +17,19 @@ Public Class MyBitmap '自动类型转换 '支持的类：Image，ImageSource，Bitmap，ImageBrush，BitmapSource Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap + If Image Is Nothing Then Return Nothing Return New MyBitmap(Image) End Operator Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image + If Image Is Nothing Then Return Nothing Return Image.Pic End Operator Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap + If Image Is Nothing Then Return Nothing Return New MyBitmap(Image) End Operator Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource + If Image Is Nothing Then Return Nothing Dim Bitmap = Image.Pic Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height) Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb) @@ -37,15 +41,19 @@ Public Class MyBitmap End Try End Operator Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap + If Image Is Nothing Then Return Nothing Return New MyBitmap(Image) End Operator Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap + If Image Is Nothing Then Return Nothing Return Image.Pic End Operator Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap + If Image Is Nothing Then Return Nothing Return New MyBitmap(Image) End Operator Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush + If Image Is Nothing Then Return Nothing Return New ImageBrush(New MyBitmap(Image.Pic)) End Operator @@ -61,23 +69,32 @@ Public Class MyBitmap Pic = BitmapCache(FilePathOrResourceName).Pic Else Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource)) - BitmapCache.Add(FilePathOrResourceName, Pic) + BitmapCache.TryAdd(FilePathOrResourceName, Pic) End If Else '使用这种自己接管 FileStream 的方法加载才能解除文件占用 Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open) - Pic = New System.Drawing.Bitmap(InputStream) - InputStream.Dispose() + '判断是否为 WebP 文件头 + Dim Header(1) As Byte + InputStream.Read(Header, 0, 2) + InputStream.Seek(0, SeekOrigin.Begin) + If Header(0) = 82 AndAlso Header(1) = 73 Then + '读取 WebP + Dim FileBytes(InputStream.Length - 1) As Byte + InputStream.Read(FileBytes, 0, FileBytes.Length) + Pic = WebPDecoder.DecodeFromBytes(FileBytes) '将代码隔离在另外一个类中，这样只要不走进这个分支就不会加载 Imazen.WebP.dll + Else + Pic = New System.Drawing.Bitmap(InputStream) + End If End Using End If Catch ex As Exception Pic = My.Application.TryFindResource(FilePathOrResourceName) If Pic Is Nothing Then Pic = New System.Drawing.Bitmap(1, 1) - Log(ex, $"加载位图失败（{FilePathOrResourceName}）") - Throw + Throw New Exception($"加载 MyBitmap 失败（{FilePathOrResourceName}）", ex) Else - Log(ex, $"指定类型有误的位图加载（{FilePathOrResourceName}）", LogLevel.Developer) + Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", LogLevel.Developer) Exit Try End If End Try @@ -104,6 +121,13 @@ Public Class MyBitmap Pic = New System.Drawing.Bitmap(MS) End Using End Sub + Private Class WebPDecoder '将代码隔离在另外一个类中，这样只要不调用这个方法就不会加载 Imazen.WebP.dll + Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap + If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。") + Dim Decoder As New Imazen.WebP.SimpleDecoder() + Return Decoder.DecodeFromBytes(Bytes, Bytes.Length) + End Function + End Class ''' ''' 获取裁切的图片，这个方法不会导致原对象改变且会返回一个新的对象。 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index 5d32043..36cc7ee 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -247,7 +247,13 @@ Website = Data("links")("websiteUrl").ToString.TrimEnd("/") LastUpdate = Data("dateReleased") '#1194 DownloadCount = Data("downloadCount") - If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl") + If Data("logo").Count > 0 Then + If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then + LogoUrl = Data("logo")("url") + Else + LogoUrl = Data("logo")("thumbnailUrl") + End If + End If 'FileIndexes / GameVersions / ModLoaders ModLoaders = New List(Of CompModLoaderType) Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions @@ -265,7 +271,7 @@ Next CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")). - Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0). + Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList 'Type @@ -278,7 +284,8 @@ End If 'Tags Tags = New List(Of String) - For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) + For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段：https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831 + Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) Select Case Category 'Mod Case 406 : Tags.Add("世界元素") @@ -342,7 +349,7 @@ '搜索结果的键为 versions，获取特定工程的键为 game_versions GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")). - Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0). + Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList 'Type Select Case Data("project_type").ToString @@ -385,9 +392,9 @@ Case "technology" : Tags.Add("科技") Case "magic" : Tags.Add("魔法") Case "adventure" : Tags.Add("冒险") - Case "kitchen-sink" : Tags.Add("烹饪") + Case "kitchen-sink" : Tags.Add("大杂烩") Case "lightweight" : Tags.Add("轻量") - 'FUTURE: Res + 'FUTURE: Res End Select Next If Not Tags.Any() Then Tags.Add("杂项") @@ -416,7 +423,7 @@ Json("DownloadCount") = DownloadCount 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 Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions) Json("CacheTime") = Date.Now '用于检查缓存时间 Return Json @@ -451,14 +458,14 @@ If StartVersion = EndVersion Then SpaVersions.Add("1." & StartVersion) ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then - If EndVersion <= 10 Then + If EndVersion < 10 Then SpaVersions.Clear() SpaVersions.Add("全版本") Exit For Else SpaVersions.Add("1." & EndVersion & "+") End If - ElseIf EndVersion <= 10 Then + ElseIf EndVersion < 10 Then SpaVersions.Add("1." & StartVersion & "-") Exit For ElseIf StartVersion - EndVersion = 1 Then @@ -471,25 +478,31 @@ End If '获取 Mod 加载器描述 Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String - Select Case ModLoaders.Count + Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders) + If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt) + Select Case ModLoadersForDesc.Count Case 0 - ModLoaderDescriptionFull = "未知" - ModLoaderDescriptionPart = "" + If ModLoaders.Count = 1 Then + ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString + ModLoaderDescriptionPart = ModLoaders.Single.ToString + Else + ModLoaderDescriptionFull = "未知" + ModLoaderDescriptionPart = "" + End If Case 1 - ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString - ModLoaderDescriptionPart = ModLoaders.Single.ToString - Case 2, 3 - If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso - ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then + ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString + ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString + Case Else + If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso + (GameVersions.Max < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso + (GameVersions.Max < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso + (GameVersions.Max < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then ModLoaderDescriptionFull = "任意" ModLoaderDescriptionPart = "" Else - ModLoaderDescriptionFull = ModLoaders.Join(" / ") - ModLoaderDescriptionPart = ModLoaders.Join(" / ") + ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ") + ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ") End If - Case Else - ModLoaderDescriptionFull = "任意" - ModLoaderDescriptionPart = "" End Select '实例化 UI Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()} @@ -535,7 +548,7 @@ Return NewItem End Function Public Function GetControlLogo() As String - If LogoUrl Is Nothing Then + If String.IsNullOrEmpty(LogoUrl) Then Return PathImage & "Icons/NoIcon.png" Else Return LogoUrl @@ -576,9 +589,9 @@ '有中文翻译 '尝试将文本分为三段：Title (EnglishName) - Suffix '检查时注意 Carpet：它没有中文译名，但有 Suffix - Title = TranslatedName.Before(" (").Before(" - ") + Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ") Dim Suffix As String = "" - If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ") + If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ") Dim EnglishName As String = TranslatedName If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) @@ -629,19 +642,19 @@ NoSubtitle: If Id = Project.Id Then Return True '相同实例 '提取字符串中的字母和数字 Dim GetRaw = - Function(Data As String) As String - Dim Result As New StringBuilder() - For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) - Result.Append(r) - Next - Return Result.ToString.ToLower - End Function + Function(Data As String) As String + Dim Result As New StringBuilder() + For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) + Result.Append(r) + Next + Return Result.ToString.ToLower + End Function '来自不同的网站 If FromCurseForge = Project.FromCurseForge Then Return False 'Mod 加载器一致 - If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False + If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False 'MC 版本一致 - If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False + If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 If TranslatedName = Project.TranslatedName OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse @@ -751,7 +764,7 @@ NoSubtitle: Case CompType.ResourcePack 'FUTURE: Res End Select - Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/")) + Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/")) If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText) @@ -772,7 +785,7 @@ NoSubtitle: 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]] Dim Facets As New List(Of String) Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]") - If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]") + If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]") If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") Address += "&facets=[" & String.Join(",", Facets) & "]" @@ -880,7 +893,7 @@ NoSubtitle: If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " " - SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - "). + SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - "). Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " " Next Log("[Comp] 中文搜索原始关键词：" & SearchResult, LogLevel.Developer) @@ -943,30 +956,30 @@ Retry: Dim CurseForgeFailed As Boolean = False If CurseForgeUrl IsNot Nothing Then CurseForgeThread = RunInNewThread( - Sub() - Try - '获取工程列表 - Log("[Comp] 开始从 CurseForge 获取工程列表：" & CurseForgeUrl) - Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8) - Task.Progress += 0.2 - Dim ProjectList As New List(Of CompProject) - For Each JsonEntry As JObject In RequestResult("data") - ProjectList.Add(New CompProject(JsonEntry)) - Next - '更新结果 - SyncLock ResultsLock - RawResults.AddRange(ProjectList) - End SyncLock - Storage.CurseForgeOffset += ProjectList.Count - Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) - Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）") - Catch ex As Exception - Log(ex, "从 CurseForge 获取工程列表失败") - Storage.CurseForgeTotal = Storage.CurseForgeOffset - [Error] = ex - CurseForgeFailed = True - End Try - End Sub, "CurseForge Project Request") + Sub() + Try + '获取工程列表 + Log("[Comp] 开始从 CurseForge 获取工程列表：" & CurseForgeUrl) + Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True) + Task.Progress += 0.2 + Dim ProjectList As New List(Of CompProject) + For Each JsonEntry As JObject In RequestResult("data") + ProjectList.Add(New CompProject(JsonEntry)) + Next + '更新结果 + SyncLock ResultsLock + RawResults.AddRange(ProjectList) + End SyncLock + Storage.CurseForgeOffset += ProjectList.Count + Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) + Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）") + Catch ex As Exception + Log(ex, "从 CurseForge 获取工程列表失败") + Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset + [Error] = ex + CurseForgeFailed = True + End Try + End Sub, "CurseForge Project Request") End If '启动 Modrinth 线程 @@ -974,32 +987,32 @@ Retry: Dim ModrinthFailed As Boolean = False If ModrinthUrl IsNot Nothing Then ModrinthThread = RunInNewThread( - Sub() - Try - Log("[Comp] 开始从 Modrinth 获取工程列表：" & ModrinthUrl) - Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8) - Task.Progress += 0.2 - Dim ProjectList As New List(Of CompProject) - For Each JsonEntry As JObject In RequestResult("hits") - ProjectList.Add(New CompProject(JsonEntry)) + Sub() + Try + Log("[Comp] 开始从 Modrinth 获取工程列表：" & ModrinthUrl) + Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True) + Task.Progress += 0.2 + Dim ProjectList As New List(Of CompProject) + For Each JsonEntry As JObject In RequestResult("hits") + ProjectList.Add(New CompProject(JsonEntry)) + Next + '更新结果 + SyncLock ResultsLock + For Each Project In ProjectList + If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件（#2458） + RawResults.Add(Project) Next - '更新结果 - SyncLock ResultsLock - For Each Project In ProjectList - If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件（#2458） - RawResults.Add(Project) - Next - End SyncLock - Storage.ModrinthOffset += ProjectList.Count - Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) - Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）") - Catch ex As Exception - Log(ex, "从 Modrinth 获取工程列表失败") - Storage.ModrinthTotal = Storage.ModrinthOffset - [Error] = ex - ModrinthFailed = True - End Try - End Sub, "Modrinth Project Request") + End SyncLock + Storage.ModrinthOffset += ProjectList.Count + Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) + Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）") + Catch ex As Exception + Log(ex, "从 Modrinth 获取工程列表失败") + Storage.ModrinthTotal = -1 'Storage.ModrinthOffset + [Error] = ex + ModrinthFailed = True + End Try + End Sub, "Modrinth Project Request") End If '等待线程结束 @@ -1021,7 +1034,7 @@ Retry: ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then Throw New Exception("Modrinth 不兼容所选的类型") Else - Throw New Exception("没有符合条件的结果") + Throw New Exception("没有搜索结果") End If End If ElseIf [Error] IsNot Nothing Then @@ -1076,7 +1089,7 @@ Retry: If String.IsNullOrEmpty(Task.Input.SearchText) Then '如果没有搜索文本，按下载量将结果排序 For Each Result As CompProject In RealResults - Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30)) + Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10)) Next Else '如果有搜索文本，按关联度将结果排序 @@ -1084,7 +1097,7 @@ Retry: Dim Entry As New List(Of SearchEntry(Of CompProject)) For Each Result As CompProject In RealResults Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + - Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9) + Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9) Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) @@ -1149,7 +1162,7 @@ Retry: ''' Public ReadOnly ModLoaders As List(Of CompModLoaderType) ''' - ''' 支持的游戏版本列表。类型包括："1.18.5"，"1.18"，"1.18 快照"，"21w15a"，"未知版本"。 + ''' 支持的游戏版本列表。类型包括："1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。 ''' Public ReadOnly GameVersions As List(Of String) ''' @@ -1253,7 +1266,9 @@ Retry: DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), Url.Replace("://edge", "://media"), - Url}).Distinct().ToList() + Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正 + DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面 + DownloadUrls = DownloadUrls.Distinct.ToList '最终去重 'Dependencies If Type = CompType.Mod Then RawDependencies = Data("dependencies"). @@ -1263,7 +1278,7 @@ Retry: End If 'GameVersions Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList - GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList + GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList If GameVersions.Count > 1 Then GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} @@ -1287,11 +1302,10 @@ Retry: ReleaseDate = Data("date_published") Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) DownloadCount = Data("downloads") - '可能为空 - If CType(Data("files"), JArray).Any() Then + If CType(Data("files"), JArray).Any() Then '可能为空 Dim File As JToken = Data("files")(0) FileName = File("filename") - DownloadUrls = New List(Of String) From {File("url")} + DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源 Hash = File("hashes")("sha1") End If 'Dependencies @@ -1305,7 +1319,7 @@ Retry: 'GameVersions Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). - Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList + Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList If GameVersions.Count > 1 Then GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} @@ -1354,28 +1368,26 @@ Retry: Optional BadDisplayName As Boolean = False) As MyListItem '获取描述信息 - Dim Info As String = "" + Dim Title As String = If(BadDisplayName, FileName, DisplayName) + Dim Info As New List(Of String) + If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast(".")) Select Case Type Case CompType.Mod - Info += If(ModLoaders.Any, - "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "，", "") - Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod，", "") + If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod") Case CompType.ModPack - If GameVersions.All(Function(v) v.Contains("w")) Then - Info += $"游戏版本 {Join(GameVersions, "、")}，" - End If + If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}") End Select If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0 - Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载，", DownloadCount & " 次下载，") + Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次")) End If - Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新" - Info += If(Status = CompFileStatus.Release, "", "，" & StatusDescription) + Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False)) + If Status <> CompFileStatus.Release Then Info.Add(StatusDescription) '建立控件 Dim NewItem As New MyListItem With { - .Title = If(BadDisplayName, FileName, DisplayName), + .Title = Title, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, - .Info = Info + .Info = Info.Join("，") } Select Case Status Case CompFileStatus.Release @@ -1414,54 +1426,52 @@ Retry: ''' ''' 已知文件信息的缓存。 ''' - Private CompFilesCache As New Dictionary(Of String, List(Of CompFile)) + Public CompFilesCache As New Dictionary(Of String, List(Of CompFile)) ''' ''' 获取某个工程下的全部文件列表。 ''' 必须在工作线程执行，失败会抛出异常。 ''' Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile) - '使用缓存 - If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId) '获取工程对象 Dim TargetProject As CompProject If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存 TargetProject = CompProjectCache(ProjectId) ElseIf FromCurseForge Then 'CurseForge - TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data")) + TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data")) Else 'Modrinth - TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)) + TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True)) End If '获取工程对象的文件列表 - Log("[Comp] 开始获取文件列表：" & ProjectId) - Dim ResultJsonArray As JArray - If FromCurseForge Then - 'CurseForge - If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 - ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") - Else '否则使用全部文件 - ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data") + If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回，这时候前置 Mod 可能没获取（#5173） + Log("[Comp] 开始获取文件列表：" & ProjectId) + Dim ResultJsonArray As JArray + If FromCurseForge Then + 'CurseForge + If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 + ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") + Else '否则使用全部文件 + ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data") + End If + Else + 'Modrinth + ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True) End If - Else - 'Modrinth - ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True) + CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). + Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330） End If - CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). - Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330） '获取前置 Mod 列表 If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId) - Dim Deps As List(Of String) = CompFilesCache(ProjectId). - SelectMany(Function(f) f.RawDependencies).Distinct().ToList + Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList '获取前置 Mod 工程信息 If UndoneDeps.Any Then Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod：{Join(UndoneDeps, "，")}") Dim Projects As JArray If TargetProject.FromCurseForge Then - Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", + Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data") Else - Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", - Accept:="application/json", IsJson:=True) + Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True) End If For Each Project In Projects Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存 @@ -1469,7 +1479,7 @@ Retry: End If '更新前置 Mod 信息 If Deps.Any Then - For Each DepProject In Deps.Select(Function(id) CompProjectCache(id)) + For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id)) For Each File In CompFilesCache(ProjectId) If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then File.Dependencies.Add(DepProject.Id) @@ -1489,10 +1499,11 @@ Retry: Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList() Deps.Sort() If Not Deps.Any() Then Exit Sub - Deps = Deps.Where(Function(dep) - If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug) - Return CompProjectCache.ContainsKey(dep) - End Function).ToList + Deps = Deps.Where( + Function(dep) + If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug) + Return CompProjectCache.ContainsKey(dep) + End Function).ToList '添加开头间隔 Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)}) '添加前置 Mod 列表 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 3f9aab0..a3b3c61 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -381,6 +381,7 @@ Extracted: 没有可用的分析文件 使用32位Java导致JVM无法分配足够多的内存 Mod重复安装 + Mod互不兼容 OptiFine与Forge不兼容 Fabric报错 Fabric报错并给出解决方案 @@ -389,7 +390,7 @@ Extracted: 版本Json中存在多个Forge Mod过多导致超出ID限制 NightConfig的Bug - ShadersMod与Optifine同时安装 + ShadersMod与OptiFine同时安装 Forge安装不完整 Mod需要Java11 Mod缺少前置或MC版本错误 @@ -413,7 +414,7 @@ Extracted: '崩溃日志 If LogCrash IsNot Nothing Then Log("[Crash] 开始进行崩溃日志堆栈分析") - Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details"))) + Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details"))) End If 'Minecraft 日志 If LogMc IsNot Nothing Then @@ -516,7 +517,7 @@ Done: If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失) If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足) - If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装) + If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装) If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) @@ -525,6 +526,7 @@ Done: If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容) If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug) If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整) + If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整) If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符) If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11) If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11) @@ -540,12 +542,14 @@ Done: End If '确定的 Mod 导致崩溃 If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray))) - 'Mod 重复安装 + 'Mod 重复 / 前置问题 If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) - 'Mod 缺少前置 + If LogMc.Contains("Incompatible mods found!") Then '#5006 + AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "")) + End If If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then AppendReason(CrashReason.Mod缺少前置或MC版本错误, RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase). @@ -591,40 +595,57 @@ Done: ''' Private Sub AnalyzeCrit2() + 'Mixin 分析 + Dim MixinAnalyze = + Function(LogText As String) As Boolean + Dim IsMixin As Boolean = + LogText.Contains("Mixin prepare failed ") OrElse LogText.Contains("Mixin apply failed ") OrElse + LogText.Contains("MixinApplyError") OrElse LogText.Contains("MixinTransformerError") OrElse + LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )") + If Not IsMixin Then Return False + 'Mod 名称匹配 + Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)") + If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)") + If ModName IsNot Nothing Then + AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray))) + Return True + End If + 'JSON 名称匹配 + For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline) + AppendReason(CrashReason.ModMixin失败, + TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", ""))) + Return True + Next + '没有明确匹配 + AppendReason(CrashReason.ModMixin失败) + Return True + End Function + '游戏日志分析 If LogMc IsNot Nothing Then + 'Mixin 崩溃 + Dim IsMixin As Boolean = MixinAnalyze(LogMc) '常规信息 If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) - 'Mixin 崩溃 - If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse - LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then - Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)") - If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)") - '兜底名称判断 - 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))) + If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 + AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) End If End If '崩溃报告分析 If LogCrash IsNot Nothing Then + 'Mixin 崩溃 + MixinAnalyze(LogCrash) + '常规信息 If LogCrash.Contains("Suspected Mod") Then - Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+") - If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects)) + Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace") + If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None + Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+") + If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects)) + End If End If End If @@ -640,6 +661,8 @@ Done: If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then AppendReason(CrashReason.极短的程序输出, LogMc) End If + 'Mod 解析错误（常见于 Fabric 前置校验失败） + If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错) 'Mixin 失败可以导致大量 Mod 实例创建失败 If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf))) '注意：Fabric 的 Warnings were found! 不一定是崩溃原因，它可能是单纯的警报 @@ -695,7 +718,7 @@ NextStack: If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", - "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", + "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill" @@ -738,13 +761,13 @@ NextStack: Details = Details.Replace("Fabric Mods", "¨") Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式") End If - Details = Details.After("¨") + Details = Details.AfterLast("¨") '[Forge] 获取所有包含 .jar 的行 '[Fabric] 获取所有包含 Mod 信息的行 Dim ModNameLines As New List(Of String) For Each Line In Details.Split(vbLf) - If Line.ContainsF(".jar", True) OrElse + If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar (IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line) Next Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") @@ -844,8 +867,11 @@ NextStack: Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) '弹窗提示 FrmMain.ShowWindowToTop() - Dim ShowLog As Action = + Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), + "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), + Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, Sub() + '弹窗选择：查看日志 If File.Exists(DirectFile.Value.Key) Then ShellOnly("notepad", DirectFile.Value.Key) Else @@ -853,11 +879,9 @@ NextStack: WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) ShellOnly(FilePath) End If - End Sub - Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), - "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), - Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog)) + End Sub)) Case 3 + '弹窗选择：导出错误报告 Dim FileAddress As String = Nothing Try '获取文件路径 @@ -872,16 +896,23 @@ NextStack: If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles) For Each OutputFile In OutputFiles Dim FileName As String = GetFileNameFromPath(OutputFile) + Dim FileEncoding As Encoding = Nothing Select Case FileName Case "LatestLaunch.bat" FileName = "启动脚本.bat" Case "Log1.txt" FileName = "PCL 启动器日志.txt" + FileEncoding = Encoding.UTF8 Case "RawOutput.log" FileName = "游戏崩溃前的输出.txt" + FileEncoding = Encoding.UTF8 End Select If File.Exists(OutputFile) Then - WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*"))) + If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile)) + WriteFile(TempFolder & "Report\" & FileName, + SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")), + Encoding:=FileEncoding) + Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}") End If Next '导出报告 @@ -905,7 +936,7 @@ NextStack: If IsHandAnalyze Then Return "很抱歉，PCL 无法确定错误原因。" Else - Return $"很抱歉，你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助，请导出错误报告并发给他人，而不是发送这个窗口的截图。" + Return $"很抱歉，你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。" End If End If @@ -938,9 +969,9 @@ NextStack: End If Case CrashReason.Mod缺少前置或MC版本错误 If Additional.Any Then - Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n未满足的依赖项：\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") + Results.Add("由于未安装正确的前置 Mod，导致游戏退出。\n缺失的依赖项：\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else - Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") + Results.Add("由于未安装正确的前置 Mod，导致游戏退出。\n请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") End If Case CrashReason.堆栈分析发现关键字 If Additional.Count = 1 Then @@ -961,7 +992,9 @@ NextStack: Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.ModMixin失败 - If Additional.Count = 1 Then + If Additional.Count = 0 Then + Results.Add("部分 Mod 注入失败，导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试逐步禁用 Mod，然后观察游戏是否还会崩溃，以此定位导致崩溃的 Mod。\n\e\h") + ElseIf Additional.Count = 1 Then Results.Add("名为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") @@ -976,7 +1009,7 @@ NextStack: If Additional.Count = 1 Then Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h") Else - Results.Add("以下 Mod 初始化失败，导致游戏无法继续加载：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") + Results.Add("以下 Mod 初始化失败，导致游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h") End If Case CrashReason.特定方块导致崩溃 If Additional.Count = 1 Then @@ -988,7 +1021,7 @@ NextStack: If Additional.Count >= 2 Then Results.Add("你重复安装了多个相同的 Mod：\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。") Else - Results.Add("你可能重复安装了多个相同的 Mod，导致游戏无法继续加载。\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。\e\h") + Results.Add("你可能重复安装了多个相同的 Mod，导致游戏出错。\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。\e\h") End If Case CrashReason.特定实体导致崩溃 If Additional.Count = 1 Then @@ -998,12 +1031,12 @@ NextStack: End If Case CrashReason.OptiFine与Forge不兼容 Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容，导致了游戏崩溃。\n\n请前往 OptiFine 官网（https://optifine.net/downloads）查看 OptiFine 所兼容的 Forge 版本，并严格按照对应版本重新安装游戏。") - Case CrashReason.ShadersMod与Optifine同时安装 - Results.Add("无需同时安装 Optifine 和 Shaders Mod，Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后，游戏即可正常运行。") + Case CrashReason.ShadersMod与OptiFine同时安装 + Results.Add("无需同时安装 Optifine 和 Shaders Mod，OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后，游戏即可正常运行。") Case CrashReason.低版本Forge与高版本Java不兼容 Results.Add("由于低版本 Forge 与当前 Java 不兼容，导致了游戏崩溃。\n\n请尝试以下解决方案：\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java") Case CrashReason.版本Json中存在多个Forge - Results.Add("可能由于使用其他启动器修改了 Forge 版本，当前版本的文件存在异常，导致了游戏崩溃。\n请尝试重新全新安装 Forge，而非使用其他启动器修改 Forge 版本。") + Results.Add("可能由于其他启动器修改了 Forge 版本，当前版本的文件存在异常，导致了游戏崩溃。\n请尝试重新全新安装 Forge，而非使用其他启动器修改 Forge 版本。") Case CrashReason.玩家手动触发调试崩溃 Results.Add("* 事实上，你的游戏没有任何问题，这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗？") Case CrashReason.Mod需要Java11 @@ -1029,30 +1062,36 @@ NextStack: Case CrashReason.文件或内容校验失败 Results.Add("部分文件或内容校验失败，导致游戏出现了问题。\n\n请尝试删除游戏（包括 Mod）并重新下载，或尝试在重新下载时使用 VPN。\h") Case CrashReason.Forge安装不完整 - Results.Add("由于 Forge 安装不完整，导致游戏无法正常运行。\n请尝试重新安装 Forge。\h") + Results.Add("由于安装的 Forge 文件丢失，导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge，然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h") Case CrashReason.Fabric报错 If Additional.Count = 1 Then Results.Add("Fabric 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else - Results.Add("Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h") + Results.Add("Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") + End If + Case CrashReason.Mod互不兼容 + If Additional.Count = 1 Then + Results.Add("你所安装的 Mod 不兼容：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") + Else + Results.Add("你所安装的 Mod 不兼容，Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") End If Case CrashReason.Mod加载器报错 If Additional.Count = 1 Then Results.Add("Mod 加载器提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else - Results.Add("Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h") + Results.Add("Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") End If Case CrashReason.Fabric报错并给出解决方案 If Additional.Count = 1 Then Results.Add("Fabric 提供了以下解决方案：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else - Results.Add("Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h") + Results.Add("Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") End If Case CrashReason.Forge报错 If Additional.Count = 1 Then Results.Add("Forge 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。") Else - Results.Add("Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h") + Results.Add("Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h") End If Case CrashReason.没有可用的分析文件 Results.Add("你的游戏出现了一些问题，但 PCL 未能找到相关记录文件，因此无法进行分析。\h") @@ -1068,7 +1107,7 @@ NextStack: Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf). Trim(vbCrLf.ToCharArray) & If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "", - vbCrLf & "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。" & + vbCrLf & "如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。" & If(If(PageSetupSystem.IsLauncherNewest(), True), "", vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) End Function diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index 1ded676..81c1a66 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -8,21 +8,20 @@ ''' Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile '获取底层继承版本 - Do While Not String.IsNullOrEmpty(Version.InheritVersion) - Version = New McVersion(Version.InheritVersion) - Loop + Try + Do While Not String.IsNullOrEmpty(Version.InheritVersion) + Version = New McVersion(Version.InheritVersion) + Loop + Catch ex As Exception + Log(ex, "获取底层继承版本失败") + End Try '检查 Json 是否标准 If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息") End If '检查文件 Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1")) - If ReturnNothingOnFileUseable Then - '是否跳过 - Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version) - If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验 - If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验 - End If + If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验 '返回下载信息 Dim JarUrl As String = Version.JsonObject("downloads")("client")("url") Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker) @@ -52,7 +51,7 @@ ''' ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' - Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase) + Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase) #Region "下载支持库文件" @@ -65,9 +64,9 @@ #End Region #Region "下载资源文件" - Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version) - If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载") - If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then + If ShouldIgnoreFileCheck(Version) Then + Log("[Download] 已跳过所有 Assets 检查") + Else Dim LoadersAssets As New List(Of LoaderBase) '获取资源文件索引地址 LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址", @@ -100,7 +99,7 @@ Task.Output = New List(Of NetFile) From {BackAssetsFile} '检查是否需要更新：每天只更新一次 If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then - Log("[Download] 无需更新资源文件索引") + Log("[Download] 无需更新资源文件索引，取消") Task.Abort() End If End Sub)) @@ -117,7 +116,7 @@ '获取资源文件地址 LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) - Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task) + Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task) End Sub) With {.ProgressWeight = 3}) '下载资源文件 LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25}) @@ -168,24 +167,25 @@ End Structure ''' ''' Minecraft 客户端 版本列表，主加载器。 + ''' 若要求镜像源必须包含某个版本，则将该版本 ID 作为输入（#5195）。 ''' - Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) - Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) + Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult)) Select Case Setup.Get("ToolDownloadVersion") Case 0 - DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60) + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 - DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35) + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5), + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else - DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60) + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60), + New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -194,9 +194,9 @@ ''' ''' Minecraft 客户端 版本列表，Mojang 官方源加载器。 ''' - Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) + Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Private IsNewClientVersionHinted As Boolean = False - Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult)) Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True) Try Dim Versions As JArray = Json("versions") @@ -226,14 +226,21 @@ ''' ''' Minecraft 客户端 版本列表，BMCLAPI 源加载器。 ''' - Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) - Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) + Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult)) Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True) Try Dim Versions As JArray = Json("versions") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）") '添加 PCL 特供项 If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) + '检查是否有要求的版本（#5195） + If Not String.IsNullOrEmpty(Loader.Input) Then + Dim Id = Loader.Input + If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then + Throw New Exception("BMCLAPI 源未包含目标版本 " & Id) + End If + End If '返回 Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json} Catch ex As Exception @@ -246,26 +253,31 @@ ''' Public Function DlClientListGet(Id As String) Try - '确认 Minecraft 版本列表已完成获取 - Select Case DlClientListLoader.State - Case LoadState.Loading - DlClientListLoader.WaitForExit() - Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting - DlClientListLoader.WaitForExit(IsForceRestart:=True) - End Select '确认版本格式标准 Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4 If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题，显示版本为 1.8.0 - '查找版本并开始 + '获取 Minecraft 版本列表 + Select Case DlClientListLoader.State + Case LoadState.Finished + '从当前的结果获取目标版本… + For Each Version As JObject In DlClientListLoader.Output.Value("versions") + If Version("id") = Id Then Return Version("url").ToString + Next + '…如果没有，则重新尝试获取（在版本刚更新时可能出现这种情况，#5195） + DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) + Case LoadState.Loading + DlClientListLoader.WaitForExit(Id) + Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting + DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) + End Select + '重新查找版本 For Each Version As JObject In DlClientListLoader.Output.Value("versions") - If Version("id") = Id Then - Return Version("url").ToString - End If + If Version("id") = Id Then Return Version("url").ToString Next - Log("未发现版本 " & Id & " 的 json 下载地址，版本列表返回为：" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug) + Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug) Return Nothing Catch ex As Exception - Log(ex, "获取版本 " & Id & " 的 json 下载地址失败") + Log(ex, $"获取版本 {Id} 的 json 下载地址失败") Return Nothing End Try End Function @@ -338,17 +350,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -444,17 +456,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -589,17 +601,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -610,7 +622,9 @@ Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Dim Result As String Try - Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True) + Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & + Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057 + ".html", UseBrowserUserAgent:=True) Catch ex As Exception If GetExceptionSummary(ex).Contains("(404)") Then Throw New Exception("没有可用版本") @@ -679,7 +693,9 @@ ''' Forge 版本列表，BMCLAPI。 ''' Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) - Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True) + Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & + Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4，#4057 + IsJson:=True) Dim Versions As New List(Of DlForgeVersionEntry) Try Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) @@ -777,7 +793,7 @@ Inherit = "1.20.1" Else '20.4.30-beta VersionName = ApiName - Version = New Version(ApiName.Before("-")) + Version = New Version(ApiName.BeforeFirst("-")) Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor) End If End Sub @@ -792,17 +808,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -828,8 +844,8 @@ ''' ''' NeoForge 版本列表，BMCLAPI。 ''' - Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListOfficialMain) - Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) + Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain) + Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) '获取版本列表 JSON Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) @@ -917,17 +933,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -1016,17 +1032,17 @@ Case 0 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30), - New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60) }, Loader.IsForceRestarting) Case 1 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5), - New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35) + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30) }, Loader.IsForceRestarting) Case Else DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60), - New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60) + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60) }, Loader.IsForceRestarting) End Select End Sub @@ -1075,29 +1091,155 @@ #End Region +#Region "DlMod | Mod 镜像源请求" + + ''' + ''' 对可能涉及 Mod 镜像源的请求进行处理，返回字符串或 JObject。 + ''' 调用 NetGetCodeByRequest。 + ''' + Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object + Dim McimUrl As String = DlSourceModGet(Url) + Dim Urls As New List(Of KeyValuePair(Of String, Integer)) + If McimUrl <> Url Then + Select Case Setup.Get("ToolDownloadMod") + 'TODO: 在 MCIM 源稳定后回调 + Case 0 + If ModeDebug Then + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + End If + Case 1 + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Case Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + End Select + End If + Dim Exs As String = "" + For Each Source In Urls + Try + Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True) + Catch ex As Exception + Exs += ex.Message + vbCrLf + End Try + Next + Throw New Exception(Exs) + End Function + + ''' + ''' 对可能涉及 Mod 镜像源的请求进行处理。 + ''' 调用 NetRequest。 + ''' + Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String + Dim McimUrl As String = DlSourceModGet(Url) + Dim Urls As New List(Of KeyValuePair(Of String, Integer)) + If McimUrl <> Url Then + Select Case Setup.Get("ToolDownloadMod") + 'TODO: 在 MCIM 源稳定后回调 + Case 0 + If ModeDebug Then + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + End If + Case 1 + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Case Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) + End Select + End If + Dim Exs As String = "" + For Each Source In Urls + Try + Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000) + Catch ex As Exception + Exs += ex.Message + vbCrLf + End Try + Next + Throw New Exception(Exs) + End Function + +#End Region + #Region "DlSource | 镜像下载源" - Public Function DlSourceResourceGet(MojangBase As String) As String() - MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net") + Public Function DlSourceResourceGet(Original As String) As String() + Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net") Return { - MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"), - MojangBase + Original. + Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets"). + Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets"). + Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"), + Original } End Function - Public Function DlSourceLibraryGet(MojangBase As String) As String() + Public Function DlSourceLibraryGet(Original As String) As String() Return { - MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), - MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"), - MojangBase + Original. + Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven"). + Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven"). + Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), + Original. + Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries"). + Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries"). + Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"), + Original } End Function - Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String() - If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址") + Public Function DlSourceModGet(Original As String) As String + Return Original. + Replace("api.modrinth.com", "mod.mcimirror.top/modrinth"). + Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth"). + Replace("cdn.modrinth.com", "mod.mcimirror.top"). + Replace("api.curseforge.com", "mod.mcimirror.top/curseforge"). + Replace("edge.forgecdn.net", "mod.mcimirror.top"). + Replace("mediafilez.forgecdn.net", "mod.mcimirror.top"). + Replace("media.forgecdn.net", "mod.mcimirror.top") + End Function + + Public Function DlSourceLauncherOrMetaGet(Original As String) As String() + If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址") Return { - MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"), - MojangBase + Original. + Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com"). + Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com"). + Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com"). + Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"), + Original } End Function @@ -1106,71 +1248,63 @@ Optional IsForceRestart As Boolean = False) Dim WaitCycle As Integer = 0 Do While True - '检查加载结束 - Dim IsAllFailed As Boolean = True + '检查状态 + Dim BeforeLoadersAllFailed As Boolean = True For Each SubLoader In LoaderList - If WaitCycle = 0 Then - '如果要强制刷新，就不使用已经加载好的值 - If IsForceRestart Then Exit For - '如果输入不一样，就不使用已经加载好的值 + If WaitCycle = 0 Then '判断是否可以不加载，直接使用已经加载好的结果 + If IsForceRestart Then Continue For '强制刷新，不行 If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse - (SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For + (SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样，也不行 End If - If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False + If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False If SubLoader.Key.State = LoadState.Finished Then + '检查加载器成功 MainLoader.Output = SubLoader.Key.Output DlSourceLoaderAbort(LoaderList) Exit Sub - ElseIf IsAllFailed Then + ElseIf BeforeLoadersAllFailed Then + '此前的加载器全部失败，直接启动后续加载器 If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100 End If - '由于 Forge BMCLAPI 没有可用版本导致强制失败 - '在没有可用版本时，官方源会一直卡住，直接使用 BMCLAPI 判定失败即可 - If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then - For Each SubLoader2 In LoaderList - If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100 - Next - End If Next - '启动加载源 + '第一轮时：既然不直接使用已经加载好的结果，那就启动第一个加载器 If WaitCycle = 0 Then - '启动第一个源 - LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart) - '将其他源标记为未启动，以确保可以切换下载源（#184） - For i = 1 To LoaderList.Count - 1 - LoaderList(i).Key.State = LoadState.Waiting + LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart) + For Each Loader In LoaderList.Skip(1) + Loader.Key.State = LoadState.Waiting '将其他源标记为未启动，以确保可以切换下载源（#184） Next End If + '检查加载器失败或超时 For i = 0 To LoaderList.Count - 1 - If WaitCycle = LoaderList(i).Value * 100 Then - If i < LoaderList.Count - 1 Then - '启动下一个源 - LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart) - Else - '失败 - Dim ErrorInfo As Exception = Nothing - For ii = 0 To LoaderList.Count - 1 - LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败 - If LoaderList(ii).Key.Error IsNot Nothing Then - If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then - ErrorInfo = LoaderList(ii).Key.Error - End If + If WaitCycle <> LoaderList(i).Value * 100 Then Continue For + If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then + '若还有下一个源，则启动下一个源 + LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart) + Else + '若没有，则失败 + Dim ErrorInfo As Exception = Nothing + For ii = 0 To LoaderList.Count - 1 + LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败 + If LoaderList(ii).Key.Error IsNot Nothing Then + If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then + ErrorInfo = LoaderList(ii).Key.Error End If - Next - If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") - DlSourceLoaderAbort(LoaderList) - Throw ErrorInfo - End If - Exit For + End If + Next + If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") + DlSourceLoaderAbort(LoaderList) + Throw ErrorInfo End If + Exit For Next '计时 + Thread.Sleep(10) + WaitCycle += 1 + '检查父加载器中断 If MainLoader.IsAborted Then DlSourceLoaderAbort(LoaderList) Exit Sub End If - Thread.Sleep(10) - WaitCycle += 1 Loop End Sub Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer))) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index 3bf5ef3..d11075e 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -1,5 +1,5 @@ Public Module ModJava - Public JavaListCacheVersion As Integer = 6 + Public JavaListCacheVersion As Integer = 7 ''' ''' 目前所有可用的 Java。 @@ -216,10 +216,12 @@ '添加特定的 Java Dim JavaPreList As New Dictionary(Of String, Boolean) - If PathMcFolder.Split("\").Count > 3 Then - JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录的话） + If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then + JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话） End If JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 + JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")). + ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java（#4286） If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 Dim TargetJavaList As New List(Of JavaEntry) For Each Entry In JavaPreList @@ -487,16 +489,18 @@ NoUserJava: Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2} Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer)) If FrmSetupLaunch IsNot Nothing Then - RunInUiWait(Sub() - FrmSetupLaunch.ComboArgumentJava.Items.Clear() - FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) - End Sub) + RunInUiWait( + Sub() + FrmSetupLaunch.ComboArgumentJava.Items.Clear() + FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) + End Sub) End If If FrmVersionSetup IsNot Nothing Then - RunInUiWait(Sub() - FrmVersionSetup.ComboArgumentJava.Items.Clear() - FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) - End Sub) + RunInUiWait( + Sub() + FrmVersionSetup.ComboArgumentJava.Items.Clear() + FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) + End Sub) End If Try @@ -518,6 +522,7 @@ NoUserJava: Next '查找磁盘中的 Java For Each Disk As DriveInfo In DriveInfo.GetDrives() + If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器（#3705） JavaSearchFolder(Disk.Name, JavaPreList, False) Next '查找 APPDATA 文件夹中的 Java @@ -550,7 +555,7 @@ NoUserJava: '若不全为特殊引用，则清除特殊引用的地址 Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) For Each Pair In JavaPreList - If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then + If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用") Else Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用") @@ -679,8 +684,8 @@ Wait: For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 - If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse - Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then + If IsFullSearch OrElse + FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then JavaSearchFolder(FolderInfo, Results, Source) End If Next diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 4d130d4..62e457f 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -4,6 +4,7 @@ Public Module ModLaunch #Region "开始" + Public CurrentLaunchOptions As McLaunchOptions = Nothing Public Class McLaunchOptions ''' ''' 强制指定在启动后进入的服务器 IP。 @@ -20,32 +21,34 @@ Public Module ModLaunch ''' 默认值：Nothing。使用 McVersionCurrent。 ''' Public Version As McVersion = Nothing + ''' + ''' 额外的启动参数。 + ''' + Public ExtraArgs As New List(Of String) End Class ''' ''' 尝试启动 Minecraft。必须在 UI 线程调用。 ''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。 ''' Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean - Options = If(Options, New McLaunchOptions) + CurrentLaunchOptions = If(Options, New McLaunchOptions) '预检查 - If Not RunInUi() Then - Throw New Exception("McLaunchStart 必须在 UI 线程调用！") - End If + If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用！") If McLaunchLoader.State = LoadState.Loading Then Hint("已有游戏正在启动中！", HintType.Critical) Return False End If '强制切换需要启动的版本 - If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then - McLaunchLog("在启动前切换到版本 " & Options.Version.Name) + If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then + McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name) '检查版本 - Options.Version.Load() - If Options.Version.State = McVersionState.Error Then - Hint("无法启动 Minecraft：" & Options.Version.Info, HintType.Critical) + CurrentLaunchOptions.Version.Load() + If CurrentLaunchOptions.Version.State = McVersionState.Error Then + Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical) Return False End If '切换版本 - McVersionCurrent = Options.Version + McVersionCurrent = CurrentLaunchOptions.Version Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) FrmLaunchLeft.RefreshButtonsUI() FrmLaunchLeft.RefreshPage(False, False) @@ -95,7 +98,7 @@ Public Module ModLaunch McLaunchPrecheck() McLaunchLog("预检测已通过") Catch ex As Exception - Hint(ex.Message, HintType.Critical) + If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical) Throw End Try '正式加载 @@ -103,8 +106,8 @@ Public Module ModLaunch '构造主加载器 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}, + McLoginLoader, '.ProgressWeight = 15, .Block = False + New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) 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}, @@ -144,7 +147,7 @@ Public Module ModLaunch Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish) Case LoadState.Aborted If AbortHint Is Nothing Then - Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info) + Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info) Else Hint(AbortHint, HintType.Finish) End If @@ -159,7 +162,7 @@ NextInner: If CurrentEx.Message.StartsWithF("$") Then '若有以 $ 开头的错误信息，则以此为准显示提示 '若错误信息为 $$，则不提示 - If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) + If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) Throw ElseIf CurrentEx.InnerException IsNot Nothing Then '检查下一级错误 @@ -168,7 +171,9 @@ NextInner: Else '没有特殊处理过的错误信息 McLaunchLog("错误：" & GetExceptionDetail(ex)) - Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) + Log(ex, + If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, + If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) Throw End If End Try @@ -211,36 +216,45 @@ NextInner: If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info) '检查输入信息 Dim CheckResult As String = "" - RunInUiWait(Sub() - Dim LoginInput As McLoginData = McLoginInput() - CheckResult = McLoginAble(LoginInput) - End Sub) + RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput())) If CheckResult <> "" Then Throw New ArgumentException(CheckResult) #If BETA Then '求赞助 - RunInNewThread(Sub() - Select Case Setup.Get("SystemLaunchCount") - Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500 - If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf & - "如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf & - "毕竟一个人开发也不容易（悲）……", - "求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then - OpenWebsite("https://afdian.net/a/LTCat") - End If - End Select - End Sub, "Donate") + RunInNewThread( + Sub() + Select Case Setup.Get("SystemLaunchCount") + Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000 + If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf & + "如果 PCL 还算好用的话，能不能考虑赞助一下 PCL……" & vbCrLf & + "如果没有大家的支持，PCL 很难在免费、无任何广告的情况下维持数年的更新（磕头）……！", + Setup.Get("SystemLaunchCount") & " 次启动！", "支持 PCL！", "但是我拒绝") = 1 Then + OpenWebsite("https://afdian.com/a/LTCat") + End If + End Select + End Sub, "Donate") #End If '正版购买提示 If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then - Select Case Setup.Get("SystemLaunchCount") - Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400 - If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf & - "如果觉得 Minecraft 还不错，也可以考虑购买正版支持一下，毕竟开发游戏也很不容易……" & vbCrLf & - "在你登录一次正版账号后，就不会再出现这个提示了。", - "考虑一下正版？", "购买正版游戏", "下次一定") = 1 Then - OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") - End If - End Select + If IsSystemLanguageChinese() Then + Select Case Setup.Get("SystemLaunchCount") + Case 3, 8, 15, 30, 50, 70, 90, 110, 130, 180, 220, 280, 330, 380, 450, 550, 660, 750, 880, 950, 1100, 1300, 1500, 1700, 1900 + If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf & + "如果觉得 Minecraft 还不错，可以购买正版支持一下，毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf & + "在登录一次正版账号后，就不会再出现这个提示了！", + "考虑一下正版？", "支持正版游戏！", "下次一定") = 1 Then + OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") + End If + End Select + ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then + Select Case MyMsgBox("你必须先登录正版账号，才能进行离线登录！", "正版验证", "购买正版", "试玩", "返回", + Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")) + Case 2 + Hint("游戏将以试玩模式启动！", HintType.Critical) + CurrentLaunchOptions.ExtraArgs.Add("--demo") + Case 3 + Throw New Exception("$$") + End Select + End If End If End Sub @@ -364,19 +378,19 @@ NextInner: '根据当前登录方式优先返回 Select Case Setup.Get("LoginType") Case McLoginType.Ms - If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") + If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name") Case McLoginType.Legacy - If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨") + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨") Case McLoginType.Nide If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") Case McLoginType.Auth If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") End Select '查找所有可能的项 - If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") + If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name") If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") - If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨") + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨") Return Nothing End Function ''' @@ -385,7 +399,7 @@ NextInner: Public Function McLoginAble() As String Select Case Setup.Get("LoginType") Case McLoginType.Ms - If Setup.Get("CacheMsOAuthRefresh") = "" Then + If Setup.Get("CacheMsV2OAuthRefresh") = "" Then Return FrmLoginMs.IsVaild() Else Return "" @@ -436,7 +450,7 @@ NextInner: Case McLoginType.Legacy LoginData = PageLoginLegacy.GetLoginData() Case McLoginType.Ms - If Setup.Get("CacheMsOAuthRefresh") = "" Then + If Setup.Get("CacheMsV2OAuthRefresh") = "" Then LoginData = PageLoginMs.GetLoginData() Else LoginData = PageLoginMsSkin.GetLoginData() @@ -487,19 +501,22 @@ NextInner: #Region "分方式登录模块" '各个登录方式的主对象与输入构造 - Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000} + Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 1} Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart) - Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} - Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} + Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10} + Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10} '主加载函数，返回所有需要的登录信息 + Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间 Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult)) Dim Input As McLoginMs = Data.Input Dim LogUsername As String = Input.UserName McLaunchLog("登录方式：正版（" & If(LogUsername = "", "尚未登录", LogUsername) & "）") Data.Progress = 0.05 '检查是否已经登录完成 - If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then + If Not Data.IsForceRestarting AndAlso '不要求强行重启 + Input.AccessToken <> "" AndAlso '已经登录过了 + (McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内 Data.Output = New McLoginResult With {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson} GoTo SkipLogin @@ -509,49 +526,47 @@ NextInner: If Input.OAuthRefreshToken = "" Then '无 RefreshToken Relogin: - Dim OAuthCode As String = MsLoginStep1(Data) - If Data.IsAborted Then Throw New ThreadInterruptedException - Data.Progress = 0.2 - OAuthTokens = MsLoginStep2(OAuthCode, False) + OAuthTokens = MsLoginStep1New(Data) Else '有 RefreshToken - OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True) + OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) + If OAuthTokens(0) = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证 End If - '要求重新打开登录网页认证 - If OAuthTokens(0) = "Relogin" Then GoTo Relogin - Data.Progress = 0.35 + If Data.IsAborted Then Throw New ThreadInterruptedException + Data.Progress = 0.25 If Data.IsAborted Then Throw New ThreadInterruptedException Dim OAuthAccessToken As String = OAuthTokens(0) Dim OAuthRefreshToken As String = OAuthTokens(1) - Dim XBLToken As String = MsLoginStep3(OAuthAccessToken) - Data.Progress = 0.5 + Dim XBLToken As String = MsLoginStep2(OAuthAccessToken) + Data.Progress = 0.4 If Data.IsAborted Then Throw New ThreadInterruptedException - Dim Tokens = MsLoginStep4(XBLToken) - Data.Progress = 0.65 + Dim Tokens = MsLoginStep3(XBLToken) + Data.Progress = 0.55 If Data.IsAborted Then Throw New ThreadInterruptedException - Dim AccessToken As String = MsLoginStep5(Tokens) - Data.Progress = 0.8 + Dim AccessToken As String = MsLoginStep4(Tokens) + Data.Progress = 0.7 If Data.IsAborted Then Throw New ThreadInterruptedException - MsLoginStep6(AccessToken) - Data.Progress = 0.9 + MsLoginStep5(AccessToken) + Data.Progress = 0.85 If Data.IsAborted Then Throw New ThreadInterruptedException - Dim Result = MsLoginStep7(AccessToken) + Dim Result = MsLoginStep6(AccessToken) + Data.Progress = 0.98 '输出登录结果 - Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken) - Setup.Set("CacheMsAccess", AccessToken) - Setup.Set("CacheMsUuid", Result(0)) - Setup.Set("CacheMsName", Result(1)) - Setup.Set("CacheMsProfileJson", Result(2)) + Setup.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken) + Setup.Set("CacheMsV2Access", AccessToken) + Setup.Set("CacheMsV2Uuid", Result(0)) + Setup.Set("CacheMsV2Name", Result(1)) + Setup.Set("CacheMsV2ProfileJson", Result(2)) Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) MsJson.Remove(Input.UserName) '如果更改了玩家名…… MsJson(Result(1)) = OAuthRefreshToken Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)} - '解锁主题 -SkipLogin: + '结束 + McLoginMsRefreshTime = GetTimeTick() McLaunchLog("微软登录完成") +SkipLogin: Setup.Set("HintBuy", True) '关闭正版购买提示 - Data.Progress = 0.98 If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示") End Sub Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult)) @@ -668,6 +683,7 @@ LoginFinish: Url:=Data.Input.BaseUrl & "/validate", Method:="POST", Data:=RequestData.ToString(0), + Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}}, ContentType:="application/json; charset=utf-8") '没有返回值的 '将登录结果输出 Data.Output.AccessToken = AccessToken @@ -691,6 +707,7 @@ LoginFinish: ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & " ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """, ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}", + Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}}, ContentType:="application/json; charset=utf-8")) '将登录结果输出 If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效！") @@ -721,6 +738,7 @@ LoginFinish: Url:=Data.Input.BaseUrl & "/authenticate", Method:="POST", Data:=RequestData.ToString(0), + Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}}, ContentType:="application/json; charset=utf-8")) '检查登录结果 If LoginJson("availableProfiles").Count = 0 Then @@ -780,6 +798,28 @@ LoginFinish: Catch ex As Exception Dim AllMessage As String = GetExceptionSummary(ex) Log(ex, "登录失败原始错误信息", LogLevel.Normal) + '读取服务器返回的错误 + If TypeOf ex Is ResponsedWebException Then + Dim ErrorMessage As String = Nothing + Try + ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage") + Catch + End Try + If Not String.IsNullOrWhiteSpace(ErrorMessage) Then + If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then + '密码错误，退出登录 (#5090) + McLaunchLog("密码错误，退出登录") + Select Case Data.Input.Type + Case McLoginType.Auth + RunInUi(AddressOf PageLoginAuthSkin.ExitLogin) + Case McLoginType.Nide + RunInUi(AddressOf PageLoginNideSkin.ExitLogin) + End Select + End If + Throw New Exception("$登录失败：" & ErrorMessage) + End If + End If + '通用关键字检测 If AllMessage.Contains("403") Then Select Case Data.Input.Type Case McLoginType.Auth @@ -805,90 +845,48 @@ LoginFinish: End Try End Function - '微软登录步骤 1：打开网页认证，获取 OAuth Code - Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String - McLaunchLog("开始微软登录步骤 1") - If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849，WebBrowser 已经无法正常加载微软登录网页了 -SystemBrowser: - 'Windows 7 或老版 Windows 10 登录 - OpenWebsite(FormLoginOAuth.LoginUrl1) - Dim Result As String = - MyMsgBoxInput("等待网页登录", - "登录完成后，网页会变得完全空白，把那个空白网页的网址复制到下面的框中就行了！" & vbCrLf & - "如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。", - ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, - HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX") - If Result Is Nothing Then - McLaunchLog("微软登录已在步骤 1 被取消") - Throw New ThreadInterruptedException("$$") + '微软登录步骤 1，原始登录：获取 DeviceCode 并开启登录网页 + Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String() + '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code + + '初始请求 +Retry: + McLaunchLog("开始微软登录步骤 1/6（原始登录）") + Dim PrepareJson As JObject = GetJson(NetRequestRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST", + $"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded")) + McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString) + + '弹窗 + Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login} + WaitingMyMsgBox.Add(Converter) + While Converter.Result Is Nothing + Thread.Sleep(100) + End While + If TypeOf Converter.Result Is RestartException Then + If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ}，然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项，请选择 {vbLQ}设置密码{vbRQ}，设置完毕后再登录。", + "需要使用密码登录", "重新登录", "设置密码", "取消", + Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then + GoTo Retry Else - Return RegexSeek(Result, "(?<=code\=)[^&]+") + Throw New Exception("$$") End If - Hint("网页登录成功，你可以关闭浏览器啦！", HintType.Finish) + ElseIf TypeOf Converter.Result Is Exception Then + Throw CType(Converter.Result, Exception) Else - 'Windows 10 登录 - Dim ReturnCode As String = Nothing - Dim ReturnEx As Exception = Nothing - Dim IsFinished As LoadState = LoadState.Loading - Dim LoginForm As FormLoginOAuth = Nothing - Dim IsSwitchToSystemBrowser As Boolean = False - RunInUi(Sub() - Try - LoginForm = New FormLoginOAuth - LoginForm.Show() - AddHandler LoginForm.OnLoginSuccess, Sub(Code As String) - ReturnCode = Code - IsFinished = LoadState.Finished - End Sub - AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean) - IsFinished = LoadState.Aborted - IsSwitchToSystemBrowser = IsSwitch - End Sub - Catch ex As Exception - ReturnEx = ex - IsFinished = LoadState.Failed - End Try - End Sub) - Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted - Thread.Sleep(20) - Loop - RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close()) - If IsFinished = LoadState.Finished Then - Return ReturnCode - ElseIf IsFinished = LoadState.Failed Then - Throw ReturnEx - ElseIf IsSwitchToSystemBrowser Then - McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器") - GoTo SystemBrowser - Else - McLaunchLog("微软登录已在步骤 1 被取消") - Throw New ThreadInterruptedException("$$") - End If + Return Converter.Result End If End Function - '微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken} - Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String() - McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）") + '微软登录步骤 1，刷新登录：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken} + Private Function MsLoginStep1Refresh(Code As String) As String() + McLaunchLog("开始微软登录步骤 1/6（刷新登录）") - Dim Request As String - If IsRefresh Then - Request = "client_id=00000000402b5328" & "&" & - "refresh_token=" & Uri.EscapeDataString(Code) & "&" & - "grant_type=refresh_token" & "&" & - "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" & - "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL") - Else - Request = "client_id=00000000402b5328" & "&" & - "code=" & Uri.EscapeDataString(Code) & "&" & - "grant_type=authorization_code" & "&" & - "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" & - "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL") - End If Dim Result As String Try - Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2) + Result = NetRequestMultiple("https://login.live.com/oauth20_token.srf", "POST", + $"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access", + "application/x-www-form-urlencoded", 2) Catch ex As Exception - If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269 + If ex.Message.Contains("must sign in again") OrElse (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269 Return {"Relogin", ""} Else Throw @@ -900,28 +898,28 @@ SystemBrowser: Dim RefreshToken As String = ResultJson("refresh_token").ToString Return {AccessToken, RefreshToken} End Function - '微软登录步骤 3：从 OAuth AccessToken 获取 XBLToken - Private Function MsLoginStep3(AccessToken As String) As String - McLaunchLog("开始微软登录步骤 3") + '微软登录步骤 2：从 OAuth AccessToken 获取 XBLToken + Private Function MsLoginStep2(AccessToken As String) As String + McLaunchLog("开始微软登录步骤 2/6") Dim Request As String = "{ - ""Properties"": { - ""AuthMethod"": ""RPS"", - ""SiteName"": ""user.auth.xboxlive.com"", - ""RpsTicket"": """ & AccessToken & """ - }, - ""RelyingParty"": ""http://auth.xboxlive.com"", - ""TokenType"": ""JWT"" - }" - Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3) + ""Properties"": { + ""AuthMethod"": ""RPS"", + ""SiteName"": ""user.auth.xboxlive.com"", + ""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """ + }, + ""RelyingParty"": ""http://auth.xboxlive.com"", + ""TokenType"": ""JWT"" + }" + Dim Result As String = NetRequestMultiple("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3) Dim ResultJson As JObject = GetJson(Result) Dim XBLToken As String = ResultJson("Token").ToString Return XBLToken End Function - '微软登录步骤 4：从 XBLToken 获取 {XSTSToken, UHS} - Private Function MsLoginStep4(XBLToken As String) As String() - McLaunchLog("开始微软登录步骤 4") + '微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS} + Private Function MsLoginStep3(XBLToken As String) As String() + McLaunchLog("开始微软登录步骤 3/6") Dim Request As String = "{ ""Properties"": { @@ -935,7 +933,7 @@ SystemBrowser: }" Dim Result As String Try - Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3) + Result = NetRequestMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3) Catch ex As Net.WebException '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js If ex.Message.Contains("2148916227") Then @@ -971,14 +969,14 @@ SystemBrowser: Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString Return {XSTSToken, UHS} End Function - '微软登录步骤 5：从 {XSTSToken, UHS} 获取 Minecraft AccessToken - Private Function MsLoginStep5(Tokens As String()) As String - McLaunchLog("开始微软登录步骤 5") + '微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken + Private Function MsLoginStep4(Tokens As String()) As String + McLaunchLog("开始微软登录步骤 4/6") Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0) Dim Result As String Try - Result = NetRequestMulty("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2) + Result = NetRequestRetry("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json") Catch ex As Net.WebException Dim Message As String = GetExceptionSummary(ex) If Message.Contains("(429)") Then @@ -996,11 +994,11 @@ SystemBrowser: Dim AccessToken As String = ResultJson("access_token").ToString Return AccessToken End Function - '微软登录步骤 6：验证微软账号是否持有 MC，这也会刷新 XGP - Private Sub MsLoginStep6(AccessToken As String) - McLaunchLog("开始微软登录步骤 6") + '微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP + Private Sub MsLoginStep5(AccessToken As String) + McLaunchLog("开始微软登录步骤 5/6") - Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) + Dim Result As String = NetRequestMultiple("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Try Dim ResultJson As JObject = GetJson(Result) If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then @@ -1015,13 +1013,13 @@ SystemBrowser: Throw End Try End Sub - '微软登录步骤 7：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} - Private Function MsLoginStep7(AccessToken As String) As String() - McLaunchLog("开始微软登录步骤 7") + '微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} + Private Function MsLoginStep6(AccessToken As String) As String() + McLaunchLog("开始微软登录步骤 6/6") Dim Result As String Try - Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) + Result = NetRequestMultiple("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Catch ex As Net.WebException Dim Message As String = GetExceptionSummary(ex) If Message.Contains("(429)") Then @@ -1069,7 +1067,7 @@ SystemBrowser: Case 3 '使用正版用户名 Try - If Not SkinName = "" Then + If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项（#3746） Log("[Skin] 由于离线皮肤设置，使用正版 UUID：" & SkinName) Uuid = McLoginMojangUuid(SkinName, False) End If @@ -1199,7 +1197,7 @@ SystemBrowser: '统一通行证检测 If Setup.Get("LoginType") = McLoginType.Nide Then '至少 Java 8u101 - MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) + MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer) End If SyncLock JavaLock @@ -1226,12 +1224,12 @@ SystemBrowser: ElseIf MaxVer < New Version(1, 8, 0, 0) Then JavaCode = 7 If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$") - ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then - JavaCode = "8u101" - If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") - ElseIf MinVer > New Version(1, 8, 0, 100) Then - JavaCode = "8u101" - If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$") + ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then + JavaCode = "8u141" + If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$") + ElseIf MinVer > New Version(1, 8, 0, 140) Then + JavaCode = "8u141" + If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$") ElseIf MaxVer < New Version(1, 8, 0, 321) Then JavaCode = 8 If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$") @@ -1276,28 +1274,35 @@ SystemBrowser: ''' 释放 Java Wrapper 并返回完整文件路径。 ''' Public Function ExtractJavaWrapper() As String - Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar" + Dim WrapperPath As String = PathPure & "JavaWrapper.jar" + Log("[Java] 选定的 Java Wrapper 路径：" & WrapperPath) SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 - WriteFile(WrapperPath, GetResources("JavaWrapper")) + Try + WriteFile(WrapperPath, GetResources("JavaWrapper")) + Catch ex As Exception + If File.Exists(WrapperPath) Then + '因为未知原因 Java Wrapper 可能变为只读文件（#4243） + Log(ex, "Java Wrapper 文件释放失败，但文件已存在，将在删除后尝试重新生成", LogLevel.Developer) + Try + File.Delete(WrapperPath) + WriteFile(WrapperPath, GetResources("JavaWrapper")) + Catch ex2 As Exception + Log(ex2, "Java Wrapper 文件重新释放失败，将尝试更换文件名重新生成", LogLevel.Developer) + WrapperPath = PathPure & "JavaWrapper2.jar" + Try + WriteFile(WrapperPath, GetResources("JavaWrapper")) + Catch ex3 As Exception + Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3) + End Try + End Try + Else + Throw New FileNotFoundException("释放 Java Wrapper 失败", ex) + End If + End Try End SyncLock - Log("[Java] 已释放 Java Wrapper：" & WrapperPath) Return WrapperPath End Function Private ExtractJavaWrapperLock As New Object - ''' - ''' 获取 Java Wrapper 所在的文件夹，不以 \ 结尾。 - ''' - Public Function GetJavaWrapperDir() As String - If PathAppdata.IsASCII() Then - Return PathAppdata.TrimEnd("\") - ElseIf PathTemp.IsASCII() Then - Log("[Java] Wrapper：AppData 路径中包含非 ASCII 字符，换用 Temp 目录") - Return PathTemp.TrimEnd("\") - Else - Log("[Java] Wrapper：AppData 路径与 Temp 路径中均包含非 ASCII 字符，换用 ProgramData 目录") - Return OsDrive & "ProgramData\PCL" - End If - End Function '主方法，合并 Jvm、Game、Replace 三部分的参数数据 Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken))) @@ -1339,8 +1344,12 @@ SystemBrowser: Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""") '全屏 If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen" + '由 Option 传入的额外参数 + For Each Arg In CurrentLaunchOptions.ExtraArgs + Arguments += " " & Arg.Trim + Next '进服 - Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp) + Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp) If Server.Length > 0 Then If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then 'QuickPlay @@ -1394,7 +1403,7 @@ SystemBrowser: Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) Try Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8) - DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server & + DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server & " -Dauthlibinjector.side=client" & " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response))) Catch ex As Exception @@ -1404,7 +1413,7 @@ SystemBrowser: '添加 Java Wrapper 作为主 Jar If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") - DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """") + DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") DataList.Add("-jar """ & ExtractJavaWrapper() & """") '添加 MainClass @@ -1461,7 +1470,7 @@ NextVersion: Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) Try Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8) - DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server & + DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server & " -Dauthlibinjector.side=client" & " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response))) Catch ex As Exception @@ -1471,7 +1480,7 @@ NextVersion: '添加 Java Wrapper 作为主 Jar If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") - DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """") + DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") DataList.Add("-jar """ & ExtractJavaWrapper() & """") '将 "-XXX" 与后面 "XXX" 合并到一起 @@ -1646,8 +1655,11 @@ NextVersion: GameSize = New Size(875 - 2, 540 - 2) End Select GameSize.Height -= 29.5 * DPI / 96 '标题栏高度 - If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso - Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍 + If McVersionCurrent.Version.McCodeMain <= 12 AndAlso + McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso + Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then + '修复 #3463：1.12.2-，JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍 + McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）") GameSize.Width /= DPI / 96 GameSize.Height /= DPI / 96 End If @@ -1770,7 +1782,6 @@ NextVersion: { ""authenticationDatabase"": { ""00000111112222233333444445555566"": { - ""accessToken"": """ & McLoginLoader.Output.AccessToken & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""profiles"": { ""66666555554444433333222221111100"": { @@ -1801,7 +1812,6 @@ NextVersion: { ""authenticationDatabase"": { ""00000111112222233333444445555566"": { - ""accessToken"": """ & McLoginLoader.Output.AccessToken & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""profiles"": { ""66666555554444433333222221111100"": { @@ -1877,16 +1887,12 @@ NextVersion: End Try '离线皮肤 Alex 警告 - Try - If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2 + If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7 McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录 (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤 - Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical) - End If - Catch ex As Exception - Log(ex, "检查离线皮肤失效失败") - End Try + Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical) + End If '离线皮肤资源包 Try @@ -2046,18 +2052,18 @@ IgnoreCustomSkin: """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & "echo 游戏已退出。" & vbCrLf & "pause" - WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"), + WriteFile(If(CurrentLaunchOptions.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 + If CurrentLaunchOptions.SaveBatch IsNot Nothing Then McLaunchLog("导出启动脚本完成，强制结束启动过程") AbortHint = "导出启动脚本成功！" - OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """") + OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """") Loader.Parent.Abort() Exit Sub '导出脚本完成 End If Catch ex As Exception Log(ex, "输出启动脚本失败") - If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败 + If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败 End Try '执行自定义命令 @@ -2128,6 +2134,8 @@ IgnoreCustomSkin: StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";") '设置其他参数 + StartInfo.StandardErrorEncoding = Encoding.UTF8 + StartInfo.StandardOutputEncoding = Encoding.UTF8 StartInfo.WorkingDirectory = McVersionCurrent.PathIndie StartInfo.UseShellExecute = False StartInfo.RedirectStandardOutput = True diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index 4afbfd0..2d87c22 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -85,7 +85,7 @@ Public Module ModMinecraft Next If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom}) Else - Hint("无效的 Minecraft 文件夹：" & Path, HintType.Critical) + Hint("无法访问 Minecraft 文件夹：" & Path, HintType.Critical) End If Next @@ -475,22 +475,27 @@ VersionSearchFinish: ''' Public Property JsonText As String Get + '快速检查 JSON 是否以 { 开头、} 结尾；忽略空白字符 + Dim FastJsonCheck = + Function(Json As String) As Boolean + Dim TrimedJson As String = Json.Trim() + Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}") + End Function If _JsonText Is Nothing Then - If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件：" & Path & Name & ".json") + If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件：{Path}{Name}.json") _JsonText = ReadFile(Path & Name & ".json") '如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试 - If _JsonText.Length = 0 Then + If Not FastJsonCheck(_JsonText) Then If RunInUi() Then - Log("[Minecraft] 版本 json 文件为空或读取失败，由于代码在主线程运行，将不再进行重试", LogLevel.Debug) - Throw New Exception("版本 Json 文件为空或读取失败") + Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", LogLevel.Debug) + GetJson(_JsonText) '触发异常 Else - Log("[Minecraft] 版本 json 文件为空或读取失败，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug) + Log("[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug) Thread.Sleep(2000) _JsonText = ReadFile(Path & Name & ".json") - If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败") + If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常 End If End If - If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误，内容为：" & _JsonText) End If Return _JsonText End Get @@ -562,10 +567,10 @@ Recheck: GoTo Recheck End If Catch ex As Exception - Log(ex, "合并版本依赖项 json 失败（" & If(InheritVersion, "null").ToString & "）") + Log(ex, "合并版本依赖项 JSON 失败（" & If(InheritVersion, "null").ToString & "）") End Try Catch ex As Exception - Throw New Exception("版本 json 不规范（" & If(Name, "null") & "）", ex) + Throw New Exception("初始化版本 JSON 时失败（" & If(Name, "null") & "）", ex) End Try Try '处理 JumpLoader @@ -665,7 +670,7 @@ Recheck: Try Dim JsonObjCheck = JsonObject Catch ex As Exception - Log(ex, "版本 json 可用性检查失败（" & Path & "）") + Log(ex, "版本 JSON 可用性检查失败（" & Path & "）") JsonText = "" JsonObject = Nothing Info = ex.Message @@ -1029,21 +1034,21 @@ ExitDataLoad: Public Function GetMcFoolName(Name As String) As String Name = Name.ToLower If Name.StartsWithF("2.0") Then - Return "这个秘密计划了两年的更新将游戏推向了一个新高度！" - ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then - Return "我们加入了 20 亿个新的维度，让无限的想象变成了现实！" + Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度！" ElseIf Name = "15w14a" Then - Return "作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。" + Return "2015 | 作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。" ElseIf Name = "1.rv-pre1" Then - Return "是时候将现代科技带入 Minecraft 了！" + Return "2016 | 是时候将现代科技带入 Minecraft 了！" ElseIf Name = "3d shareware v1.34" Then - Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作！" + Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作！" + ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then + Return "2020 | 我们加入了 20 亿个新的维度，让无限的想象变成了现实！" ElseIf Name = "22w13oneblockatatime" Then - Return "一次一个方块更新！迎接全新的挖掘、合成与骑乘玩法吧！" + Return "2022 | 一次一个方块更新！迎接全新的挖掘、合成与骑乘玩法吧！" ElseIf Name = "23w13a_or_b" Then - Return "研究表明：玩家喜欢作出选择——越多越好！" + Return "2023 | 研究表明：玩家喜欢作出选择——越多越好！" ElseIf Name = "24w14potato" Then - Return "毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！" + Return "2024 | 毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！" Else Return "" End If @@ -1251,9 +1256,8 @@ OnLoaded: Dim VersionList As New List(Of McVersion) #Region "循环加载每个版本的信息" - Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories - For Each Folder As DirectoryInfo In Dirs - If Not Folder.EnumerateFiles.Any Then + For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories + If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then Log("[Minecraft] 跳过空文件夹：" & Folder.FullName) Continue For End If @@ -1287,8 +1291,11 @@ OnLoaded: '单独列出收藏的版本 Dim StaredVersions As New List(Of McVersion) - For Each Version As McVersion In VersionList - If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version) + For Each Version As McVersion In VersionList.ToList + If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then + StaredVersions.Add(Version) + VersionList.Remove(Version) + End If Next If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) @@ -1523,7 +1530,7 @@ OnLoaded: ''' 要求玩家选择一个皮肤文件，并进行相关校验。 ''' Public Function McSkinSelect() As McSkinInfo - Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件") + Dim FileName As String = SelectFile("皮肤文件(*.png;*.jpg;*.webp)|*.png;*.jpg;*.webp", "选择皮肤文件") '验证有效性 If FileName = "" Then Return New McSkinInfo With {.IsVaild = False} @@ -1930,7 +1937,7 @@ OnLoaded: ''' ''' 获取版本缺失的支持库文件所对应的 NetTaskFile。 ''' - Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile) + Public Function McLibFix(Version As McVersion) As List(Of NetFile) If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json Dim Result As New List(Of NetFile) @@ -1943,91 +1950,99 @@ OnLoaded: Catch ex As Exception Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer) End Try - If CoreJarOnly Then Return Result - - '是否跳过校验 - Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version) 'Library 文件 - Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip)) + Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\")) '统一通行证文件 If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then Dim TargetFile = PathAppdata & "nide8auth.jar" - If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then - Dim DownloadInfo As JObject = Nothing - '获取下载信息 - Try - Log("[Minecraft] 开始获取统一通行证下载信息") - '测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/ - DownloadInfo = GetJson(NetGetCodeByDownload({ + Dim DownloadInfo As JObject = Nothing + '获取下载信息 + Try + Log("[Minecraft] 开始获取统一通行证下载信息") + '测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/ + DownloadInfo = GetJson(NetGetCodeByDownload({ "https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True)) - Catch ex As Exception - Log(ex, "获取统一通行证下载信息失败") - End Try - '校验文件 - If DownloadInfo IsNot Nothing Then - Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString) - If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then - '开始下载 - Log("[Minecraft] 统一通行证需要更新：Hash - " & Checker.Hash, LogLevel.Developer) - Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker)) - End If + Catch ex As Exception + Log(ex, "获取统一通行证下载信息失败") + End Try + '校验文件 + If DownloadInfo IsNot Nothing Then + Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString) + If Checker.Check(TargetFile) IsNot Nothing Then + '开始下载 + Log("[Minecraft] 统一通行证需要更新：Hash - " & Checker.Hash, LogLevel.Developer) + Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker)) End If End If End If 'Authlib-Injector 文件 - If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse - (PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接 - Dim TargetFile = PathAppdata & "authlib-injector.jar" - If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then - Dim DownloadInfo As JObject = Nothing - '获取下载信息 - Try - Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") - DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True)) - Catch ex As Exception - Log(ex, "获取 Authlib-Injector 下载信息失败") - End Try - '校验文件 - If DownloadInfo IsNot Nothing Then - Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString) - If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then - '开始下载 - Dim DownloadAddress As String = DownloadInfo("download_url") - Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress, LogLevel.Developer) - Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString))) - End If + If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then + Dim TargetFile = PathPure & "\authlib-injector.jar" + Dim DownloadInfo As JObject = Nothing + '获取下载信息 + Try + Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") + DownloadInfo = GetJson(NetGetCodeByDownload({ + "https://authlib-injector.yushi.moe/artifact/latest.json", + "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json" + }, IsJson:=True)) + Catch ex As Exception + Log(ex, "获取 Authlib-Injector 下载信息失败") + End Try + '校验文件 + If DownloadInfo IsNot Nothing Then + Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString) + If Checker.Check(TargetFile) IsNot Nothing Then + '开始下载 + Dim DownloadAddress As String = DownloadInfo("download_url").ToString. + Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe") + Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress, LogLevel.Developer) + Result.Add(New NetFile({ + DownloadAddress, + DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector") + }, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString))) End If End If End If + '跳过校验 + If ShouldIgnoreFileCheck(Version) Then + Log("[Minecraft] 用户要求尽量忽略文件检查，这可能会保留有误的文件") + Result = Result.Where( + Function(f) + If File.Exists(f.LocalPath) Then + Log("[Minecraft] 跳过下载的支持库文件：" & f.LocalPath, LogLevel.Debug) + Return False + Else + Return True + End If + End Function).ToList + End If + Return Result End Function ''' ''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。 ''' - Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile) + Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile) CustomMcFolder = If(CustomMcFolder, PathMcFolder) Dim Result As New List(Of NetFile) '获取 For Each Token As McLibToken In Libs '检查文件 - Dim Checker As FileChecker - If AllowUnsameFile Then '只要文件存在则通过检查，用于放宽完整性校验的情况 - Checker = New FileChecker(MinSize:=1) - Else - Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1) - End If + Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1) If Checker.Check(Token.LocalPath) Is Nothing Then Continue For '文件不符合，添加下载 Dim Urls As New List(Of String) If Token.Url IsNot Nothing Then '获取 Url 的真实地址 Urls.Add(Token.Url) - If Token.Url.Contains("launcher.mojang.com/v1/objects") Then - Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings + If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse + Token.Url.Contains(".tsrg") Then + Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings（#4425） End If If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/"). @@ -2049,7 +2064,7 @@ OnLoaded: '普通文件 Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/"))) End If - Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker)) + Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker)) Next '去重并返回 Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath) @@ -2157,77 +2172,50 @@ OnLoaded: ''' Public Size As Long ''' - ''' 是否为 Virtual 资源文件。 - ''' - Public IsVirtual As Boolean - ''' ''' 文件的 Hash 校验码。 ''' Public Hash As String Public Overrides Function ToString() As String - Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath + Return GetString(Size) & " | " & LocalPath End Function End Structure ''' ''' 获取 Minecraft 的资源文件列表。失败会抛出异常。 ''' - ''' 版本的资源名称，如“1.13.1”。 - Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken) + Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken) + Dim IndexName = McAssetsGetIndexName(Version) Try '初始化 - If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json") - McAssetsListGet = New List(Of McAssetsToken) - Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json")) + If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json") + Dim Result As New List(Of McAssetsToken) + Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json")) - '确认 Virtual 与 Map 状态 - Dim IsVirtual As Boolean = False - If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True - If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then - IsVirtual = True - '刷新 resources 文件夹符号链接（#2182） - 'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta") - 'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then - If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then - Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug) - Try - DeleteDirectory(PathMcFolder & "resources\", True) - Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\") - Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""") - Log($"[Minecraft] 符号链接创建结果：{Result}") - If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果（{Result}）") - Catch ex As Exception - Log(ex, "创建资源文件夹链接失败，游戏可能会没有声音", LogLevel.Msgbox) - End Try + '读取列表 + For Each File As JProperty In Json("objects").Children + Dim LocalPath As String + If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then + 'Remap + LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\") + ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then + 'Virtual + LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\") + Else + '正常 + LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString End If - End If - - '加载列表 - If IsVirtual Then - For Each File As JProperty In Json("objects").Children - McAssetsListGet.Add(New McAssetsToken With { - .IsVirtual = True, - .LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"), - .SourcePath = File.Name, - .Hash = File.Value("hash").ToString, - .Size = File.Value("size").ToString - }) - Next - Else - For Each File As JProperty In Json("objects").Children - McAssetsListGet.Add(New McAssetsToken With { - .IsVirtual = False, - .LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString, - .SourcePath = File.Name, - .Hash = File.Value("hash").ToString, - .Size = File.Value("size").ToString - }) - Next - End If + Result.Add(New McAssetsToken With { + .LocalPath = LocalPath, + .SourcePath = File.Name, + .Hash = File.Value("hash").ToString, + .Size = File.Value("size").ToString + }) + Next + Return Result Catch ex As Exception - Log(ex, "获取资源文件列表失败：" & Name) + Log(ex, "获取资源文件列表失败：" & IndexName) Throw End Try End Function @@ -2236,12 +2224,12 @@ OnLoaded: ''' ''' 获取版本缺失的资源文件所对应的 NetTaskFile。 ''' - Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile) + Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile) Dim Result As New List(Of NetFile) Dim AssetsList As List(Of McAssetsToken) Try - AssetsList = McAssetsListGet(IndexAddress) + AssetsList = McAssetsListGet(Version) Dim Token As McAssetsToken If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04 For i = 0 To AssetsList.Count - 1 @@ -2320,8 +2308,8 @@ OnLoaded: End If Left = Left.ToLowerInvariant Right = Right.ToLowerInvariant - Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") - Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") + Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+") + Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+") Dim i As Integer = 0 While True '两边均缺失，感觉是一个东西 @@ -2370,15 +2358,11 @@ NextEntry: ''' ''' 比较两个版本名的排序器。 ''' - Public Class VersionSorter + Public Class VersionComparer Implements IComparer(Of String) - Public IsDecreased As Boolean = True Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare - Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1) + Return VersionSortInteger(x, y) End Function - Public Sub New(Optional IsDecreased As Boolean = True) - Me.IsDecreased = IsDecreased - End Sub End Class ''' diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 1ed28d6..44ab4fa 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -1,6 +1,7 @@ Imports System.IO.Compression Public Module ModMod + Private Const LocalModCacheVersion As Integer = 7 Public Class McMod @@ -47,7 +48,7 @@ Public Module ModMod Get Load() If Not IsFileAvailable Then - Return McModState.Unavaliable + Return McModState.Unavailable ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then Return McModState.Disabled Else @@ -58,7 +59,7 @@ Public Module ModMod Public Enum McModState As Integer Fine = 0 Disabled = 1 - Unavaliable = 2 + Unavailable = 2 End Enum #End Region @@ -687,7 +688,7 @@ Finished: ''' Public ReadOnly Property CanUpdate As Boolean Get - Return ChangelogUrls.Any() + Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any() End Get End Property @@ -701,13 +702,13 @@ Finished: Dim Info As New FileInfo(Path) Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C") Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey) - If Cached <> "" Then + If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062 _CurseForgeHash = Cached Return _CurseForgeHash End If '读取文件 Dim data As New List(Of Byte) - For Each b As Byte In File.ReadAllBytes(Path) + For Each b As Byte In ReadFileBytes(Path) If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For data.Add(b) Next @@ -814,7 +815,7 @@ Finished: '等待 Mod 更新完成 If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then - Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表") + Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input) Try RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod") Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input) @@ -824,6 +825,7 @@ Finished: Finally RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表") End Try + FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly) End If '获取 Mod 文件夹下的可用文件列表 @@ -852,7 +854,7 @@ Finished: Dim Cache As New JObject Try Dim CacheContent As String = ReadFile(CachePath) - If CacheContent <> "" Then + If Not String.IsNullOrWhiteSpace(CacheContent) Then Cache = GetJson(CacheContent) If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息", LogLevel.Debug) @@ -861,6 +863,7 @@ Finished: End If Catch ex As Exception Log(ex, "读取本地 Mod 信息缓存失败，已重置") + Cache = New JObject End Try Cache("version") = LocalModCacheVersion @@ -886,7 +889,7 @@ Finished: End If ModList.Add(ModEntry) '读取 Comp 缓存 - If ModEntry.State = McMod.McModState.Unavaliable Then Continue For + If ModEntry.State = McMod.McModState.Unavailable Then Continue For Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("") If Cache.ContainsKey(CacheKey) Then ModEntry.FromJson(Cache(CacheKey)) @@ -901,8 +904,8 @@ Finished: '排序 ModList = Sort(ModList, Function(Left As McMod, Right As McMod) As Boolean - If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then - Return Left.State = McMod.McModState.Unavaliable + If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then + Return Left.State = McMod.McModState.Unavailable Else Return Not Right.FileName.CompareTo(Left.FileName) End If @@ -924,7 +927,6 @@ Finished: End Try End Sub '联网加载 Mod 详情 - Private Const LocalModCacheVersion As Integer = 5 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 @@ -944,7 +946,7 @@ Finished: 'McVersions = McVersions.Distinct().ToList() '开始网络获取 Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}") - Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0 + Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False Dim MainThread As Thread = Thread.CurrentThread '从 Modrinth 获取信息 RunInNewThread( @@ -952,7 +954,7 @@ Finished: Try '步骤 1：获取 Hash 与对应的工程 ID Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() - Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST", + Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST", $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系 @@ -973,19 +975,18 @@ Finished: Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") '步骤 3：获取工程信息 If Not ModrinthMapping.Any() Then Exit Sub - Dim ModrinthProject = CType(GetJson(NetRequestRetry( + Dim ModrinthProject = CType(GetJson(DlModRequest( $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]", "GET", "", "application/json")), JArray) For Each ProjectJson In ModrinthProject Dim Project As New CompProject(ProjectJson) For Each Entry In ModrinthMapping(Project.Id) - If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片，如果可能，使用 CurseForge 的 Logo Entry.Comp = Project Next Next Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息") '步骤 4：获取更新信息 - Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", + Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject) For Each Entry In Mods @@ -1005,9 +1006,9 @@ Finished: End If Next Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束") - SucceedThreadCount += 1 Catch ex As Exception Log(ex, "从 Modrinth 获取本地 Mod 信息失败") + IsFailed = True Finally EndedThreadCount += 1 End Try @@ -1022,8 +1023,8 @@ Finished: CurseForgeHashes.Add(Entry.CurseForgeHash) If Loader.IsAbortedWithThread(MainThread) Then Exit Sub Next - Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", - $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) + Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST", + $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系 If Not CurseForgeRaw.Any() Then Exit Sub @@ -1045,17 +1046,16 @@ Finished: Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") '步骤 3：获取工程信息 If Not CurseForgeMapping.Any() Then Exit Sub - Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", - $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") + Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST", + $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表 Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) For Each ProjectJson In CurseForgeProject - If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For + If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For '设置 Entry 中的工程信息 Dim Project As New CompProject(ProjectJson) For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then - Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来 Entry.Comp = Entry.Comp '再次触发修改事件 Continue For End If @@ -1066,9 +1066,9 @@ Finished: Dim NewestVersion As String = Nothing Dim NewestFileIds As New List(Of Integer) For Each IndexEntry In ProjectJson("latestFilesIndexes") - If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 + If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 Dim IndexVersion As String = IndexEntry("gameVersion") - If McVersion <> IndexVersion Then Continue For 'MC 版本匹配 + If IndexVersion <> McVersion Then Continue For 'MC 版本匹配 '由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件 If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 If NewestVersion <> IndexVersion Then @@ -1087,7 +1087,7 @@ Finished: Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息") '步骤 4：获取更新文件信息 If Not UpdateFileIds.Any() Then Exit Sub - Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", + Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data") Dim UpdateFiles As New Dictionary(Of McMod, CompFile) For Each FileJson In CurseForgeFiles @@ -1113,9 +1113,9 @@ Finished: End If Next Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束") - SucceedThreadCount += 1 Catch ex As Exception Log(ex, "从 CurseForge 获取本地 Mod 信息失败") + IsFailed = True Finally EndedThreadCount += 1 End Try @@ -1129,11 +1129,13 @@ Finished: Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存") If Not Mods.Any() Then Exit Sub - For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 - Entry.CompLoaded = SucceedThreadCount = 2 + For Each Entry In Mods + Entry.CompLoaded = Not IsFailed Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Next WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) + '刷新边栏 + RunInUi(Sub() FrmVersionMod?.RefreshBars()) End Sub Public Function GetTargetModLoaders() As List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType) @@ -1275,4 +1277,4 @@ Finished: End Function #End If -End Module +End Module \ No newline at end of file diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index ac4fd7f..79bbefa 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -1,4 +1,5 @@ Imports System.IO.Compression +Imports System.Linq.Expressions Public Module ModModpack @@ -10,12 +11,22 @@ Public Module ModModpack Public Sub ModpackInstall() Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件 If String.IsNullOrEmpty(File) Then Exit Sub - RunInThread(Sub() ModpackInstall(File)) + RunInThread( + Sub() + Try + ModpackInstall(File) + Catch ex As CancelledException + Catch ex As Exception + Log(ex, "手动安装整合包失败", LogLevel.Msgbox) + End Try + End Sub) End Sub ''' - ''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。 + ''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。 + ''' 必须在工作线程执行。 ''' - Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean + ''' + Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Log("[ModPack] 整合包安装请求：" & If(File, "null")) Dim Archive As ZipArchive = Nothing Dim ArchiveBaseFolder As String = "" @@ -23,9 +34,10 @@ Public Module ModModpack '获取整合包种类与关键 Json Dim PackType As Integer = -1 Try - Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) + Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read)) '从根目录判断整合包类型 If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） + If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194） If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包 If Archive.GetEntry("manifest.json") IsNot Nothing Then Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8)) @@ -36,16 +48,16 @@ Public Module ModModpack End If End If If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包 - If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包 + If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包 '从一级目录判断整合包类型 For Each Entry In Archive.Entries Dim FullNames As String() = Entry.FullName.Split("/") ArchiveBaseFolder = FullNames(0) & "/" - If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包 '确定为一级目录下 If FullNames.Count <> 2 Then Continue For '判断是否为关键文件 If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） + If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194） If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包 If FullNames(1) = "manifest.json" Then Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) @@ -56,54 +68,41 @@ Public Module ModModpack End If End If If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 - If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包 + If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包 Next Catch ex As Exception If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then - Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) - Return False + Throw New Exception("打开整合包文件失败", ex) ElseIf File.EndsWithF(".rar", True) Then - Log(ex, "PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) - Return False + Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex) Else - Log(ex, "打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) - Return False + Throw New Exception("打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", ex) End If End Try '执行对应的安装方法 Select Case PackType Case 0 Log("[ModPack] 整合包种类：CurseForge") - InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) + Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) Case 1 Log("[ModPack] 整合包种类：HMCL") - InstallPackHMCL(File, Archive, ArchiveBaseFolder) + Return InstallPackHMCL(File, Archive, ArchiveBaseFolder) Case 2 Log("[ModPack] 整合包种类：MMC") - InstallPackMMC(File, Archive, ArchiveBaseFolder) + Return InstallPackMMC(File, Archive, ArchiveBaseFolder) Case 3 Log("[ModPack] 整合包种类：MCBBS") - InstallPackMCBBS(File, Archive, ArchiveBaseFolder) + Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName) Case 4 Log("[ModPack] 整合包种类：Modrinth") - InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) + Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Case 9 - Log("[ModPack] 整合包种类：压缩包") - Archive.Dispose() - Archive = Nothing - InstallPackCompress(File, ArchiveBaseFolder) + Log("[ModPack] 整合包种类：带启动器的压缩包") + Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder) Case Else - If ShowHint Then - Hint("未能识别该整合包的种类，无法安装！", HintType.Critical) - Else - Log("[ModPack] 未能识别该整合包的种类，无法安装！") - End If - Return False + Log("[ModPack] 整合包种类：未能识别，假定为压缩包") + Return InstallPackCompress(File, Archive) End Select - Return True - Catch ex As Exception - Log(ex, "准备安装整合包失败", LogLevel.Feedback) - Return False Finally If Archive IsNot Nothing Then Archive.Dispose() End Try @@ -112,7 +111,7 @@ Public Module ModModpack '整合包缓存清理 Private IsInstallCacheCleared As Boolean = False Private IsInstallCacheClearing As Boolean = False - Private Sub UnpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase) + Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double) '清理缓存文件夹 If Not IsInstallCacheCleared Then IsInstallCacheCleared = True @@ -139,7 +138,7 @@ Public Module ModModpack Retry: '完全不知道为啥会出现文件正在被另一进程使用的问题，总之多试试 DeleteDirectory(InstallTemp) - ExtractFile(FileAddress, InstallTemp, Encode) + ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta) Catch ex As Exception Log(ex, "第 " & RetryCount & " 次解压尝试失败") If TypeOf ex Is ArgumentException Then @@ -152,7 +151,7 @@ Retry: RetryCount += 1 GoTo Retry Else - Throw + Throw New Exception("解压整合包文件失败", ex) End If End Try End Sub @@ -160,26 +159,25 @@ Retry: #Region "不同类型整合包的安装方法" 'CurseForge - Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) + Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, + Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) '读取 Json 文件 Dim Json As JObject Try Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) - If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") Catch ex As Exception - Log(ex, "整合包安装信息存在问题", LogLevel.Hint) - Exit Sub + Throw New Exception("CurseForge 整合包安装信息存在问题", ex) End Try + If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息") '获取版本名 - Dim ShowRibble As Boolean = VersionName Is Nothing If VersionName Is Nothing Then - Dim PackName As String = If(Json("name"), "") + VersionName = If(Json("name"), "") Dim Validate As New ValidateFolderName(PathMcFolder & "versions") - If Validate.Validate(PackName) <> "" Then PackName = "" - VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) - If String.IsNullOrEmpty(VersionName) Then Exit Sub + If Validate.Validate(VersionName) <> "" Then VersionName = "" + If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) + If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException End If '获取 Mod API 版本信息 @@ -190,35 +188,19 @@ Retry: Dim Id As String = If(Entry("id"), "").ToString.ToLower If Id.StartsWithF("forge-") Then 'Forge 指定 - If Id.Contains("recommended") Then - Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint) - Exit Sub - End If - Try - Log("[ModPack] 整合包 Forge 版本：" & Id) - ForgeVersion = Id.Split("-")(1) - Exit For - Catch ex As Exception - Log(ex, "读取整合包 Forge 版本失败：" & Id) - End Try + If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！") + Log("[ModPack] 整合包 Forge 版本：" & Id) + ForgeVersion = Id.Replace("forge-", "") ElseIf Id.StartsWithF("neoforge-") Then 'NeoForge 指定 - Try - Log("[ModPack] 整合包 NeoForge 版本：" & Id) - NeoForgeVersion = Id.Split("-")(1) - Exit For - Catch ex As Exception - Log(ex, "读取整合包 NeoForge 版本失败：" & Id) - End Try + Log("[ModPack] 整合包 NeoForge 版本：" & Id) + NeoForgeVersion = Id.Replace("neoforge-", "") ElseIf Id.StartsWithF("fabric-") Then 'Fabric 指定 - Try - Log("[ModPack] 整合包 Fabric 版本：" & Id) - FabricVersion = Id.Split("-")(1) - Exit For - Catch ex As Exception - Log(ex, "读取整合包 Fabric 版本失败：" & Id) - End Try + Log("[ModPack] 整合包 Fabric 版本：" & Id) + FabricVersion = Id.Replace("fabric-", "") + Else + Log("[ModPack] 未知 Mod 加载器：" & Id) End If Next '解压与配置文件 @@ -228,17 +210,17 @@ Retry: If OverrideHome <> "" Then InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", Sub(Task As LoaderTask(Of String, Integer)) - UnpackFiles(InstallTemp, FileAddress, Task) - Task.Progress = 0.5 + ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) + Task.Progress = 0.6 Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome '复制结果 If Directory.Exists(OverridePath) Then - CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName) + CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35) Log($"[ModPack] 整合包 override 复制：{OverridePath} -> {PathMcFolder & "versions\" & VersionName}") Else Log($"[ModPack] 整合包中未找到 override 文件夹：{OverridePath}") End If - Task.Progress = 0.9 + Task.Progress = 0.95 '开启版本隔离 WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) End Sub) With { @@ -260,9 +242,11 @@ Retry: '获取 Mod 下载信息 ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", Sub(Task As LoaderTask(Of Integer, JArray)) + '由于 MCIM 缺少下载信息，只使用官方源获取列表 + 'TODO: 在 MCIM 源稳定后回调回 DlModRequest 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 版本") + If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除，所以没法继续安装了，请向整合包作者反馈该问题") End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s '构造 NetFile ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息", @@ -320,7 +304,6 @@ Retry: .FabricVersion = FabricVersion } Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) - If MergeLoaders Is Nothing Then Exit Sub '构造 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}) @@ -342,8 +325,8 @@ Retry: 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) + If File.Exists(Target) Then + Log("[ModPack] 删除原始整合包文件：" & Target) File.Delete(Target) End If Next @@ -351,36 +334,31 @@ Retry: '重复任务检查 Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " " - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = LoaderName Then - Hint("该整合包正在安装中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then + Hint("该整合包正在安装中！", HintType.Critical) + Throw New CancelledException + End If '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Loader.Start(Request.TargetVersionFolder) LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() - If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() - - End Sub + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) + Return Loader + End Function 'Modrinth - Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) + Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) '读取 Json 文件 Dim Json As JObject Try Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open)) - If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") Catch ex As Exception - Log(ex, "整合包安装信息存在问题", LogLevel.Hint) - Exit Sub + Throw New Exception("Modrinth 整合包安装信息存在问题", ex) End Try + If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息") '获取 Mod API 版本信息 Dim MinecraftVersion As String = Nothing Dim ForgeVersion As String = Nothing @@ -401,42 +379,43 @@ Retry: Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion) Case "quilt-loader" 'eg. 1.0.0 Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical) - Exit Sub + Throw New CancelledException Case Else Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical) - Exit Sub + Throw New CancelledException End Select Next '获取版本名 - Dim ShowRibble As Boolean = VersionName Is Nothing If VersionName Is Nothing Then - Dim PackName As String = If(Json("name"), "") + VersionName = If(Json("name"), "") Dim Validate As New ValidateFolderName(PathMcFolder & "versions") - If Validate.Validate(PackName) <> "" Then PackName = "" - VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) - If String.IsNullOrEmpty(VersionName) Then Exit Sub + If Validate.Validate(VersionName) <> "" Then VersionName = "" + If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) + If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException End If '解压和配置文件 Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallLoaders As New List(Of LoaderBase) InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", - Sub(Task As LoaderTask(Of String, Integer)) - UnpackFiles(InstallTemp, FileAddress, Task) - Task.Progress = 0.5 - '复制 overrides 文件夹和 client-overrides 文件夹 - If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then - CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) - Else - Log("[ModPack] 整合包中未找到 override 目录，已跳过") - End If - Task.Progress = 0.8 - If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then - CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName) - End If - Task.Progress = 0.9 - '开启版本隔离 - WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) - End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s + Sub(Task As LoaderTask(Of String, Integer)) + ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) + Task.Progress = 0.6 + '复制 overrides 文件夹和 client-overrides 文件夹 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then + CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName, + Sub(Delta) Task.Progress += Delta * 0.25) + Else + Log("[ModPack] 整合包中未找到 override 目录，已跳过") + End If + Task.Progress = 0.85 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then + CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName, + Sub(Delta) Task.Progress += Delta * 0.1) + End If + Task.Progress = 0.95 + '开启版本隔离 + WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '获取下载文件列表 Dim FileList As New List(Of NetFile) For Each File In If(Json("files"), {}) @@ -453,8 +432,10 @@ Retry: End Select 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, + Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList + Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList) + Urls = Urls.Distinct.ToList() + FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString, New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True)) Next If FileList.Any Then @@ -471,7 +452,6 @@ Retry: .FabricVersion = FabricVersion } Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) - If MergeLoaders Is Nothing Then Exit Sub '构造 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}) @@ -493,8 +473,8 @@ Retry: 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) + If File.Exists(Target) Then + Log("[ModPack] 删除原始整合包文件：" & Target) File.Delete(Target) End If Next @@ -502,69 +482,60 @@ Retry: '重复任务检查 Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " " - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = LoaderName Then - Hint("该整合包正在安装中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then + Hint("该整合包正在安装中！", HintType.Critical) + Throw New CancelledException + End If '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Loader.Start(Request.TargetVersionFolder) LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() - If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() - - End Sub + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) + Return Loader + End Function 'HMCL - Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String) '读取 Json 文件 Dim Json As JObject Try Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) Catch ex As Exception - Log(ex, "整合包安装信息存在问题", LogLevel.Hint) - Exit Sub + Throw New Exception("HMCL 整合包安装信息存在问题", ex) End Try '获取版本名 - Dim PackName As String = If(Json("name"), "") + Dim VersionName As String = If(Json("name"), "") Dim Validate As New ValidateFolderName(PathMcFolder & "versions") - If Validate.Validate(PackName) <> "" Then PackName = "" - Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) - If VersionName Is Nothing Then Exit Sub + If Validate.Validate(VersionName) <> "" Then VersionName = "" + If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) + If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException '解压与配置文件 Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallLoaders As New List(Of LoaderBase) InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", Sub(Task As LoaderTask(Of String, Integer)) - UnpackFiles(InstallTemp, FileAddress, Task) - Task.Progress = 0.5 + ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) + Task.Progress = 0.6 '复制结果 If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then - CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName) + CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35) Else Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过") End If - Task.Progress = 0.9 + Task.Progress = 0.95 '开启版本隔离 WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '构造加载器 - If Json("gameVersion") Is Nothing Then - Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical) - Exit Sub - End If + If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！") Dim Request As New McInstallRequest With { .TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .MinecraftName = Json("gameVersion").ToString } Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) - If MergeLoaders Is Nothing Then Exit Sub '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） Dim LoadersLib As New List(Of LoaderBase) LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）", @@ -592,14 +563,10 @@ Retry: '重复任务检查 Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " " - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = LoaderName Then - Hint("该整合包正在安装中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then + Hint("该整合包正在安装中！", HintType.Critical) + Throw New CancelledException + End If '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} @@ -607,41 +574,41 @@ Retry: Loader.Start(Request.TargetVersionFolder) LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() - FrmMain.BtnExtraDownload.Ribble() - End Sub + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) + Return Loader + End Function 'MMC - Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String) '读取 Json 文件 Dim PackJson As JObject, PackInstance As String Try PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8)) PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8) Catch ex As Exception - Log(ex, "整合包安装信息存在问题", LogLevel.Hint) - Exit Sub + Throw New Exception("MMC 整合包安装信息存在问题", ex) End Try '获取版本名 - Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") + Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim Validate As New ValidateFolderName(PathMcFolder & "versions") - If Validate.Validate(PackName) <> "" Then PackName = "" - Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) - If VersionName Is Nothing Then Exit Sub + If Validate.Validate(VersionName) <> "" Then VersionName = "" + If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) + If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException '解压、配置设置文件 Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\" Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim InstallLoaders As New List(Of LoaderBase) InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", Sub(Task As LoaderTask(Of String, Integer)) - UnpackFiles(InstallTemp, FileAddress, Task) - Task.Progress = 0.5 + ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) + Task.Progress = 0.6 '复制结果 If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then - CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName) + CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35) Else Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过") End If - Task.Progress = 0.9 + Task.Progress = 0.95 '开启版本隔离 WriteIni(SetupFile, "VersionArgumentIndie", 1) '读取 MMC 设置文件（#2655） @@ -684,10 +651,7 @@ Retry: End Try End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '构造版本安装请求 - If PackJson("components") Is Nothing Then - Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical) - Exit Sub - End If + If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！") Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} For Each Component In PackJson("components") Select Case If(Component("uid"), "").ToString @@ -703,12 +667,11 @@ Retry: Request.FabricVersion = Component("version") Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical) - Exit Sub + Throw New CancelledException End Select Next '构造加载器 Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) - If MergeLoaders Is Nothing Then Exit Sub '构造 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}) @@ -721,73 +684,67 @@ Retry: '重复任务检查 Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " " - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = LoaderName Then - Hint("该整合包正在安装中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then + Hint("该整合包正在安装中！", HintType.Critical) + Throw New CancelledException + End If '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Loader.Start(Request.TargetVersionFolder) LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() - FrmMain.BtnExtraDownload.Ribble() - End Sub + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) + Return Loader + End Function 'MCBBS - Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, + Optional VersionName As String = Nothing) As LoaderCombo(Of String) '读取 Json 文件 Dim Json As JObject Try Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json")) Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Catch ex As Exception - Log(ex, "整合包安装信息存在问题", LogLevel.Hint) - Exit Sub + Throw New Exception("MCBBS 整合包安装信息存在问题", ex) End Try '获取版本名 - Dim PackName As String = If(Json("name"), "") - Dim Validate As New ValidateFolderName(PathMcFolder & "versions") - If Validate.Validate(PackName) <> "" Then PackName = "" - Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) - If VersionName Is Nothing Then Exit Sub + If VersionName Is Nothing Then + VersionName = If(Json("name"), "") + Dim Validate As New ValidateFolderName(PathMcFolder & "versions") + If Validate.Validate(VersionName) <> "" Then VersionName = "" + If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) + If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException + End If '解压与配置文件 Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallLoaders As New List(Of LoaderBase) InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", Sub(Task As LoaderTask(Of String, Integer)) - UnpackFiles(InstallTemp, FileAddress, Task) - Task.Progress = 0.5 + ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) + Task.Progress = 0.6 '复制结果 If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then - CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) + CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName, + Sub(Delta) Task.Progress += 0.35 * Delta) Else Log("[ModPack] 整合包中未找到 overrides 目录，已跳过") End If - Task.Progress = 0.9 + Task.Progress = 0.95 '开启版本隔离 WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s '构造加载器 - If Json("addons") Is Nothing Then - Hint("该整合包未提供游戏版本附加信息，无法安装！", HintType.Critical) - Exit Sub - End If + If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！") Dim Addons As New Dictionary(Of String, String) For Each Entry In Json("addons") Addons.Add(Entry("id"), Entry("version")) Next - If Not Addons.ContainsKey("game") Then - Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical) - Exit Sub - End If + If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！") If Addons.ContainsKey("quilt") Then Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical) - Exit Sub + Throw New CancelledException End If Dim Request As New McInstallRequest With { .TargetVersionName = VersionName, @@ -799,7 +756,6 @@ Retry: .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) } Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) - If MergeLoaders Is Nothing Then Exit Sub '构造 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}) @@ -812,14 +768,10 @@ Retry: '重复任务检查 Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " " - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = LoaderName Then - Hint("该整合包正在安装中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then + Hint("该整合包正在安装中！", HintType.Critical) + Throw New CancelledException + End If '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} @@ -827,28 +779,106 @@ Retry: Loader.Start(Request.TargetVersionFolder) LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) + Return Loader + End Function + + '带启动器的压缩包 + Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String) + '获取解压路径 + MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) + Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）") + If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException + If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException + If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException + '解压 + Dim Loader As New LoaderCombo(Of String)("解压压缩包", { + New LoaderTask(Of String, Integer)("解压压缩包", + Sub(Task As LoaderTask(Of String, Integer)) + ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9) + Thread.Sleep(400) '避免文件争用 + '查找解压后的 exe 文件 + Dim Launcher As String = Nothing + For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.AllDirectories) + Dim Info = FileVersionInfo.GetVersionInfo(ExeFile) + Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}") + If Info.ProductName = "Plain Craft Launcher" Then + Launcher = ExeFile + ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动器", True)) AndAlso + Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then + If Launcher Is Nothing Then Launcher = ExeFile + End If + Next + Task.Progress = 0.95 + '尝试使用附带的启动器打开 + If Launcher IsNot Nothing Then + Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher) + If MyMsgBox($"整合包中似乎自带了启动器，是否换用它继续安装？{vbCrLf}通常推荐这样做，以获得最佳体验。{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "继续", "取消") = 1 Then + ShellOnly(Launcher, "--wait") + Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序") + FrmMain.EndProgram(False) + Return + End If + Else + Log("[Modpack] 未找到压缩包中附带的启动器") + End If + '加入文件夹列表 + Dim VersionName As String = GetFolderNameFromPath(TargetFolder) + PageSelectLeft.AddFolder( + TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串） + VersionName, False) + '调用 modpack 文件进行安装 + Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First + Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile) + ModpackInstall(ModpackFile, VersionName) + End Sub) + }) + Loader.Start(TargetFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.Ribble() - End Sub + Return Loader + End Function '普通压缩包 - Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) - MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True) + Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String) + '尝试定位 .minecraft 文件夹：寻找形如 “/versions/XXX/XXX.json” 的路径 + Dim Match As RegularExpressions.Match = Nothing + Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?[^\/]+)\/(\k)\.json$)", RegularExpressions.RegexOptions.IgnoreCase) + For Each Entry In Archive.Entries + Dim EntryMatch = Regex.Match("/" & Entry.FullName) + If EntryMatch.Success Then + Match = EntryMatch + Exit For + End If + Next + If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构，这可能不是一个 MC 压缩包") '没有匹配 + Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串） + Dim VersionName As String = Match.Groups(1).Value + Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & VersionName) '获取解压路径 + MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）") - If String.IsNullOrEmpty(TargetFolder) Then Exit Sub - If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Exit Sub - If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Exit Sub - '要求显示名称 - Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder), - New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})}) - If String.IsNullOrWhiteSpace(NewName) Then Exit Sub + If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException + If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException + If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException '解压 - Hint("正在解压压缩包……") - UnpackFiles(TargetFolder, FileAddress, Nothing) - '加入文件夹列表 - PageSelectLeft.AddFolder(TargetFolder, NewName, False) - Hint("已加入游戏文件夹列表：" & NewName, HintType.Finish) - End Sub + Dim Loader As New LoaderCombo(Of String)("解压压缩包", { + New LoaderTask(Of String, Integer)("解压压缩包", + Sub(Task As LoaderTask(Of String, Integer)) + ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95) + '加入文件夹列表 + PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False) + Thread.Sleep(400) '避免文件争用 + RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect)) + End Sub) + }) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(TargetFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Return Loader + End Function #End Region #End Region diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index 9d16fd2..ce900ea 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -88,26 +88,27 @@ AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived '初始化时钟 - RunInNewThread(Sub() - Try - Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted - TimerWindow() - TimerLog() - '设置窗口标题 - For i = 1 To 3 - If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then - Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss")) - SetWindowText(WindowHandle, RealTitle.ToCharArray) - End If - Thread.Sleep(64) - Next - Loop - WatcherLog("Minecraft 日志监控已退出") - Catch ex As Exception - Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback) - State = MinecraftState.Ended - End Try - End Sub, "Minecraft Watcher PID " & PID) + RunInNewThread( + Sub() + Try + Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted + TimerWindow() + TimerLog() + '设置窗口标题 + For i = 1 To 3 + If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then + Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss")) + SetWindowText(WindowHandle, RealTitle.ToCharArray) + End If + Thread.Sleep(64) + Next + Loop + WatcherLog("Minecraft 日志监控已退出") + Catch ex As Exception + Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback) + State = MinecraftState.Ended + End Try + End Sub, "Minecraft Watcher PID " & PID) End Sub '状态 @@ -349,22 +350,21 @@ WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析") Hint("检测到 Minecraft 出现错误，错误分析已开始……") FeedbackInfo() - RunInNewThread(Sub() - Try - Thread.Sleep(2000) - WatcherLog("崩溃分析开始") - Dim Analyzer As New CrashAnalyzer(PID) - Analyzer.Collect(Version.PathIndie, LatestLog.ToList) - Analyzer.Prepare() - Analyzer.Analyze(Version) - Analyzer.Output(False, New List(Of String) From - {Version.Path & Version.Name & ".json", - Path & "PCL\Log1.txt", - Path & "PCL\LatestLaunch.bat"}) - Catch ex As Exception - Log(ex, "崩溃分析失败", LogLevel.Feedback) - End Try - End Sub, "Crash Analyzer") + RunInNewThread( + Sub() + Try + Thread.Sleep(2000) + WatcherLog("崩溃分析开始") + Dim Analyzer As New CrashAnalyzer(PID) + Analyzer.Collect(Version.PathIndie, LatestLog.ToList) + Analyzer.Prepare() + Analyzer.Analyze(Version) + Analyzer.Output(False, New List(Of String) From + {Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"}) + Catch ex As Exception + Log(ex, "崩溃分析失败", LogLevel.Feedback) + End Try + End Sub, "Crash Analyzer") End Sub '强制关闭 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml index 8fd7bae..7524a36 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml @@ -1,6 +1,7 @@  @@ -23,7 +24,7 @@ - + $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub - '在完成正常加载后才保存缓存图片 - PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd) - Catch ex As Exception - Log(ex, $"读取资源工程图标失败（{LocalFileAddress}）") - File.Delete(LocalFileAddress & DownloadEnd) - LoadError = ex - End Try - End Sub) - If LoadError IsNot Nothing Then Throw LoadError - If File.Exists(LocalFileAddress) Then - File.Delete(LocalFileAddress & DownloadEnd) - Else - FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress) - End If - Catch ex As Exception - If Not Retried Then - Retried = True - GoTo RetryStart - Else - Log(ex, $"下载资源工程图标失败（{_Logo}）") - RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")) - End If - End Try - End Sub '标题 Public Property Title As String @@ -172,7 +96,7 @@ RetryStart: '记录当前展开的卡片标题（#2712） Dim Titles As New List(Of String) If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then - For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children + For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title) Next Log("[Comp] 记录当前已展开的卡片：" & String.Join("、", Titles)) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml index a64f249..445f44b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml @@ -24,30 +24,27 @@ - + - - - + + + + + + + + - - - + diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb index 016f81a..f826928 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb @@ -6,90 +6,14 @@ Public Class MyLocalModItem Public Uuid As Integer = GetUuid() 'Logo - Private _Logo As String = "" Public Property Logo As String Get - Return _Logo + Return PathLogo.Source End Get Set(value As String) - If _Logo = value OrElse value Is Nothing Then Exit Property - _Logo = value - Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" - Try - If _Logo.StartsWithF("http", True) Then - '网络图片 - If File.Exists(FileAddress) Then - PathLogo.Source = New MyBitmap(FileAddress) - ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo - Log($"[LocalModItem] 发现不支持的 WebP 格式图标，已更改为默认图标：{_Logo}") - PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") - Else - PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") - RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal) - End If - Else - '位图 - PathLogo.Source = New MyBitmap(_Logo) - End If - Catch ex As IOException - Log(ex, "加载本地 Mod 图标时读取失败（" & FileAddress & "）") - Catch ex As ArgumentException - '考虑缓存的图片本身可能有误 - Log(ex, "可视化本地 Mod 图标失败（" & FileAddress & "）") - Try - File.Delete(FileAddress) - Log("[LocalModItem] 已清理损坏的本地 Mod 图标：" & FileAddress) - Catch exx As Exception - Log(exx, "清理损坏的本地 Mod 图标缓存失败（" & FileAddress & "）", LogLevel.Hint) - End Try - Catch ex As Exception - Log(ex, "加载本地 Mod 图标失败（" & value & "）") - End Try + PathLogo.Source = value End Set End Property - '后台加载 Logo - Private Sub LogoLoader(LocalFileAddress As String) - Dim Retried As Boolean = False - Dim DownloadEnd As String = GetUuid() -RetryStart: - Try - 'CurseForge 图片使用缩略图 - Dim Url As String = _Logo - If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then - Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小 - End If - '下载图片 - NetDownload(Url, LocalFileAddress & DownloadEnd, True) - Dim LoadError As Exception = Nothing - RunInUiWait( - Sub() - Try - '在地址更换时取消加载 - If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub - '在完成正常加载后才保存缓存图片 - PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd) - Catch ex As Exception - Log(ex, "读取本地 Mod 图标失败（" & LocalFileAddress & "）") - File.Delete(LocalFileAddress & DownloadEnd) - LoadError = ex - End Try - End Sub) - If LoadError IsNot Nothing Then Throw LoadError - If File.Exists(LocalFileAddress) Then - File.Delete(LocalFileAddress & DownloadEnd) - Else - FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress) - End If - Catch ex As Exception - If Not Retried Then - Retried = True - GoTo RetryStart - Else - Log(ex, $"下载本地 Mod 图标失败（{_Logo}）") - RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")) - End If - End Try - End Sub '标题 Private _Title As String @@ -104,7 +28,7 @@ RetryStart: LabTitle.TextDecorations = Nothing Case McMod.McModState.Disabled LabTitle.TextDecorations = TextDecorations.Strikethrough - Case McMod.McModState.Unavaliable + Case McMod.McModState.Unavailable LabTitle.TextDecorations = TextDecorations.Strikethrough value &= " [错误]" End Select @@ -117,12 +41,12 @@ RetryStart: '副标题 Public Property SubTitle As String Get - Return If(LabTitleRaw?.Text, "") + Return If(LabSubtitle?.Text, "") End Get Set(value As String) - If LabTitleRaw.Text = value Then Exit Property - LabTitleRaw.Text = value - LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) + If LabSubtitle.Text = value Then Exit Property + LabSubtitle.Text = value + LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) End Set End Property @@ -145,9 +69,9 @@ RetryStart: For Each TagText In value Dim NewTag = GetObjectFromXML( " - + ") PanTags.Children.Add(NewTag) Next @@ -379,57 +303,75 @@ RetryStart: #End Region - Public Sub Refresh() + Private Function GetUpdateCompareDescription() As String + Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "") + Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "") + '简化名称对比 + Dim CurrentSegs = CurrentName.Split("-"c).ToList() + Dim NewestSegs = NewestName.Split("-"c).ToList() + Dim Shortened As Boolean = False + For Each Seg In CurrentSegs.ToList() + If Not NewestSegs.Contains(Seg) Then Continue For + CurrentSegs.Remove(Seg) + NewestSegs.Remove(Seg) + Shortened = True + Next + If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then + CurrentName = Join(CurrentSegs, "-") + NewestName = Join(NewestSegs, "-") + Entry._Version = CurrentName '使用网络信息作为显示的版本号 + End If + Return $"当前版本：{CurrentName}（{GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}）{vbCrLf}最新版本：{NewestName}（{GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)}）" + End Function + Public Sub Refresh() Handles Me.Loaded RunInUi( Sub() '更新 If Entry.CanUpdate Then BtnUpdate.Visibility = Visibility.Visible - Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "") - Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "") - '简化名称对比 - Dim CurrentSegs = CurrentName.Split("-"c).ToList() - Dim NewestSegs = NewestName.Split("-"c).ToList() - Dim Shortened As Boolean = False - For Each Seg In CurrentSegs.ToList() - If Not NewestSegs.Contains(Seg) Then Continue For - CurrentSegs.Remove(Seg) - NewestSegs.Remove(Seg) - Shortened = True - Next - If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then - CurrentName = Join(CurrentSegs, "-") - NewestName = Join(NewestSegs, "-") - Entry._Version = CurrentName '使用网络信息作为显示的版本号 - End If - BtnUpdate.ToolTip = $"当前版本：{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本：{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新，右键查看更新日志。" + BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新，右键查看更新日志。" Else BtnUpdate.Visibility = Visibility.Collapsed End If - '标题 - If Entry.Comp Is Nothing Then - Title = Entry.Name - SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) - Else - Dim Titles = Entry.Comp.GetControlTitle(False) - Title = Titles.Key - SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version) - End If - If Checked Then - LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5")) - Else - LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4")) - End If - '描述 - Dim NewDescription As String + '标题与描述 + Dim DescFileName As String Select Case Entry.State Case McMod.McModState.Fine - NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path) + DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path) Case McMod.McModState.Disabled - NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", "")) - Case Else 'McMod.McModState.Unavaliable - NewDescription = GetFileNameFromPath(Entry.Path) + DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", "")) + Case Else 'McMod.McModState.Unavailable + DescFileName = GetFileNameFromPath(Entry.Path) End Select + Dim NewDescription As String + If Setup.Get("ToolModLocalNameStyle") = 1 Then + '标题显示文件名，详情显示译名 + '标题 + Title = DescFileName + SubTitle = "" + '描述 + If Entry.Comp Is Nothing Then + NewDescription = Entry.Name + Else + Dim Titles = Entry.Comp.GetControlTitle(False) + NewDescription = Titles.Key & Titles.Value + End If + NewDescription = NewDescription.Replace(" | ", " / ") + If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})" + Else + '标题显示译名，详情显示文件名 + '标题 + If Entry.Comp Is Nothing Then + Title = Entry.Name + SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) + Else + Dim Titles = Entry.Comp.GetControlTitle(False) + Title = Titles.Key + SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version) + End If + '描述 + NewDescription = DescFileName + End If If Entry.Comp IsNot Nothing Then NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "") ElseIf Entry.Description IsNot Nothing Then @@ -438,6 +380,11 @@ RetryStart: NewDescription += ": " & "存在错误，无法获取信息" End If Description = NewDescription + If Checked Then + LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5")) + Else + LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4")) + End If '主 Logo Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo()) '图标右下角的 Logo @@ -458,7 +405,7 @@ RetryStart: ' + ' Source="/Images/Icons/Unavailable.png" /> End If ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png") End If @@ -532,7 +479,57 @@ RetryStart: '触发更新 Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click + If MyMsgBox($"是否要更新 {Entry.Name}？{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "取消") = 2 Then Return FrmVersionMod.UpdateMods({Entry}) End Sub + '自适应（#4465） + Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged + '0：全部舒展：Auto - Auto - (Auto) - 1* + '1：压缩 Subtitle：Auto - 1* - (Auto) - 0 + '2：继续压缩 Title：1* - 0 - (Auto) - 0 + Dim CurrentCompressLevel As Integer = + If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed + Dim NewCompressLevel As Integer + Select Case CurrentCompressLevel + Case 0 + If ColumnExtend.ActualWidth < 0.5 Then + NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1) + Else + Return + End If + Case 1 + If ColumnSubtitle.ActualWidth < 0.5 Then + NewCompressLevel = 2 + ElseIf Not LabSubtitle.IsTextTrimmed Then + NewCompressLevel = 0 + Else + Return + End If + Case 2 + If Not LabTitle.IsTextTrimmed Then + NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1) + Else + Return + End If + End Select + Select Case NewCompressLevel + Case 0 + '全部舒展：Auto - Auto - (Auto) - 1* + ColumnTitle.Width = GridLength.Auto + ColumnSubtitle.Width = GridLength.Auto + ColumnExtend.Width = New GridLength(1, GridUnitType.Star) + Case 1 + '压缩 Subtitle：Auto - 1* - (Auto) - 0 + ColumnTitle.Width = GridLength.Auto + ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star) + ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel) + Case 2 + '继续压缩 Title：1* - 0 - (Auto) - 0 + ColumnTitle.Width = New GridLength(1, GridUnitType.Star) + ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel) + ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel) + End Select + End Sub + End Class diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index 9e3ed0f..be69955 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -21,26 +21,28 @@ OpenWebsite(Data(0)) Case "打开文件", "打开帮助" - RunInThread(Sub() - Try - '确认实际路径 - Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) - Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) - '执行 - If Type = "打开文件" Then - Dim Info As New ProcessStartInfo With { - .Arguments = If(Data.Length >= 2, Data(1), ""), - .FileName = Location, - .WorkingDirectory = WorkingDir - } - Process.Start(Info) - Else '打开帮助 - PageOtherHelp.EnterHelpPage(Location) - End If - Catch ex As Exception - Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) - End Try - End Sub) + RunInThread( + Sub() + Try + '确认实际路径 + Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) + Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) + Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}") + '执行 + If Type = "打开文件" Then + Dim Info As New ProcessStartInfo With { + .Arguments = If(Data.Length >= 2, Data(1), ""), + .FileName = Location, + .WorkingDirectory = WorkingDir + } + Process.Start(Info) + Else '打开帮助 + PageOtherHelp.EnterHelpPage(Location) + End If + Catch ex As Exception + Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) + End Try + End Sub) Case "启动游戏" If Data(0) = "\current" Then @@ -90,7 +92,18 @@ MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败") Exit Sub End If - PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0))) + Try + Select Case Data.Length + Case 1 + PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0))) + Case 2 + PageOtherTest.StartCustomDownload(Data(0), Data(1)) + Case Else + PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2)) + End Select + Catch + PageOtherTest.StartCustomDownload(Data(0), "未知") + End Try Case Else MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败") @@ -126,7 +139,6 @@ Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml") Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1) - Hint("正在获取资源，请稍候……") Try NetDownload(RelativeUrl, LocalTemp1) NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml")) diff --git a/Plain Craft Launcher 2/Modules/ModMain.vb b/Plain Craft Launcher 2/Modules/ModMain.vb index 319a431..3c877a1 100644 --- a/Plain Craft Launcher 2/Modules/ModMain.vb +++ b/Plain Craft Launcher 2/Modules/ModMain.vb @@ -69,14 +69,14 @@ Public Module ModMain Dim Percent As Double = 0.3 Select Case CurrentHint.Type Case HintType.Info - TargetColor0 = New MyColor(37, 155, 252) - TargetColor1 = New MyColor(10, 142, 252) + TargetColor0 = New MyColor(215, 37, 155, 252) + TargetColor1 = New MyColor(215, 10, 142, 252) Case HintType.Finish - TargetColor0 = New MyColor(33, 177, 33) - TargetColor1 = New MyColor(29, 160, 29) + TargetColor0 = New MyColor(215, 33, 177, 33) + TargetColor1 = New MyColor(215, 29, 160, 29) Case Else 'HintType.Critical - TargetColor0 = New MyColor(255, 53, 11) - TargetColor1 = New MyColor(255, 43, 0) + TargetColor0 = New MyColor(215, 255, 53, 11) + TargetColor1 = New MyColor(215, 255, 43, 0) End Select If Not IsNothing(DoubleStack) Then '有重复提示，且该提示的进入动画已播放 @@ -176,15 +176,17 @@ EndHint: Public Title As String Public Text As String ''' - ''' 输入框模式：文本框的文本；选择模式：需要放进去的 List(Of MyListItem)。 + ''' 输入模式：文本框的文本。 + ''' 选择模式：需要放进去的 List(Of MyListItem)。 + ''' 登录模式：登录步骤 1 中返回的 JSON。 ''' Public Content As Object ''' - ''' 仅输入框模式：输入验证规则。 + ''' 输入模式：输入验证规则。 ''' Public ValidateRules As ObjectModel.Collection(Of Validate) ''' - ''' 仅输入框模式：提示文本。 + ''' 输入模式：提示文本。 ''' Public HintText As String = "" ''' @@ -214,7 +216,9 @@ EndHint: ''' Public IsExited As Boolean = False ''' - ''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮，则为 Nothing。 + ''' 输入模式：输入的文本。若点击了 非 第一个按钮，则为 Nothing。 + ''' 选择模式：点击的按钮编号，从 1 开始。 + ''' 登录模式：字符串数组 {AccessToken, RefreshToken} 或一个 Exception。 ''' Public Result As Object End Class @@ -222,6 +226,7 @@ EndHint: Text [Select] Input + Login End Enum ''' @@ -352,6 +357,8 @@ EndHint: FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0))) Case MyMsgBoxType.Text FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0))) + Case MyMsgBoxType.Login + FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0))) End Select WaitingMyMsgBox.RemoveAt(0) Else @@ -437,6 +444,10 @@ EndHint: #Region "帮助" Public Class HelpEntry + ''' + ''' 原始信息路径。用于刷新。 + ''' + Public RawPath As String '基础 @@ -495,6 +506,7 @@ EndHint: ''' 从文件初始化 HelpEntry 对象，失败会抛出异常。 ''' Public Sub New(FilePath As String) + RawPath = FilePath Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath))) If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath) '加载常规信息 @@ -592,7 +604,7 @@ EndHint: '加载忽略列表 Log("[Help] 发现 .helpignore 文件：" & File.FullName) For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray) - Dim RealString As String = Line.Before("#").Trim + Dim RealString As String = Line.BeforeFirst("#").Trim If String.IsNullOrWhiteSpace(RealString) Then Continue For IgnoreList.Add(RealString) If ModeDebug Then Log("[Help] > " & RealString) diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index cc1ace6..6a7e34d 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -14,8 +14,8 @@ ''' 初始化音乐播放列表。 ''' ''' 强制全部重新载入列表。 - ''' 在重载列表时避免让某项成为第一项。 - Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "") + ''' 在重载列表时避免让某项成为第一项。 + Private Sub MusicListInit(ForceReload As Boolean, Optional PreventFirst As String = Nothing) If ForceReload Then MusicAllList = Nothing Try '初始化全部可用音乐列表 @@ -31,10 +31,10 @@ End If '打乱顺序播放 MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList)) - If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then + If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then '若需要避免成为第一项的为第一项，则将它放在最后 MusicWaitingList.RemoveAt(0) - MusicWaitingList.Add(IgnoreFirst) + MusicWaitingList.Add(PreventFirst) End If Catch ex As Exception Log(ex, "初始化音乐列表失败", LogLevel.Feedback) @@ -42,13 +42,18 @@ End Sub ''' ''' 获取下一首播放的音乐路径并将其从列表中移除。 + ''' 如果没有，可能会返回 Nothing。 ''' Private Function DequeueNextMusicAddress() As String '初始化，确保存在音乐 If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False) '出列下一个音乐，如果出列结束则生成新列表 - DequeueNextMusicAddress = MusicWaitingList(0) - MusicWaitingList.RemoveAt(0) + If MusicWaitingList.Any() Then + DequeueNextMusicAddress = MusicWaitingList(0) + MusicWaitingList.RemoveAt(0) + Else + DequeueNextMusicAddress = Nothing + End If If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress) End Function @@ -60,44 +65,45 @@ ''' 刷新背景音乐按钮 UI 与设置页 UI。 ''' Private Sub MusicRefreshUI() - RunInUi(Sub() - Try + RunInUi( + Sub() + Try - If Not MusicAllList.Any() Then - '无背景音乐 - FrmMain.BtnExtraMusic.Show = False + If Not MusicAllList.Any() Then + '无背景音乐 + FrmMain.BtnExtraMusic.Show = False + Else + '有背景音乐 + FrmMain.BtnExtraMusic.Show = True + Dim ToolTipText As String + If MusicState = MusicStates.Pause Then + FrmMain.BtnExtraMusic.Logo = Logo.IconPlay + FrmMain.BtnExtraMusic.LogoScale = 0.8 + ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) + If MusicAllList.Count > 1 Then + ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。" Else - '有背景音乐 - FrmMain.BtnExtraMusic.Show = True - Dim ToolTipText As String - If MusicState = MusicStates.Pause Then - FrmMain.BtnExtraMusic.Logo = Logo.IconPlay - FrmMain.BtnExtraMusic.LogoScale = 0.8 - ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) - If MusicAllList.Count > 1 Then - ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。" - Else - ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。" - End If - Else - FrmMain.BtnExtraMusic.Logo = Logo.IconMusic - FrmMain.BtnExtraMusic.LogoScale = 1 - ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) - If MusicAllList.Count > 1 Then - ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。" - Else - ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。" - End If - End If - FrmMain.BtnExtraMusic.ToolTip = ToolTipText - ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16)) + ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。" End If - If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() + Else + FrmMain.BtnExtraMusic.Logo = Logo.IconMusic + FrmMain.BtnExtraMusic.LogoScale = 1 + ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) + If MusicAllList.Count > 1 Then + ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。" + Else + ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。" + End If + End If + FrmMain.BtnExtraMusic.ToolTip = ToolTipText + ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16)) + End If + If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() - Catch ex As Exception - Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback) - End Try - End Sub) + Catch ex As Exception + Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback) + End Try + End Sub) End Sub ''' @@ -128,8 +134,12 @@ Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Finish) Else Dim Address As String = DequeueNextMusicAddress() - MusicStartPlay(Address) - Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish) + If Address Is Nothing Then + Hint("没有可以播放的音乐！", HintType.Critical) + Else + MusicStartPlay(Address) + Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish) + End If End If MusicRefreshUI() End Sub @@ -179,11 +189,15 @@ End If Else Dim Address As String = DequeueNextMusicAddress() - Try - MusicStartPlay(Address, IsFirstLoad) - If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False) - Catch - End Try + If Address Is Nothing Then + If ShowHint Then Hint("没有可以播放的音乐！", HintType.Critical) + Else + Try + MusicStartPlay(Address, IsFirstLoad) + If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False) + Catch + End Try + End If End If MusicRefreshUI() @@ -195,6 +209,7 @@ ''' 开始播放音乐。 ''' Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False) + If Address Is Nothing Then Return Log("[Music] 播放开始：" & Address) MusicCurrent = Address RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal) @@ -280,22 +295,28 @@ '当前音乐已播放结束，继续下一曲 If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress) Catch ex As Exception - Log("[Music] 播放音乐失败的文件完整路径：" & MusicCurrent) + Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", LogLevel.Developer) If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Critical) Thread.Sleep(1000000000) End If If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) - ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then + ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse + ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4) Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) Else Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint) End If - Thread.Sleep(1000) + '将播放错误的音乐从列表中移除 + MusicAllList.Remove(MusicCurrent) + MusicWaitingList.Remove(MusicCurrent) + MusicRefreshUI() + '等待 2 秒后继续播放 + Thread.Sleep(2000) If TypeOf ex Is FileNotFoundException Then MusicRefreshPlay(True, IsFirstLoad) - ElseIf MusicAllList.Count > 1 Then + Else MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad) End If Finally diff --git a/Plain Craft Launcher 2/Modules/ModSecret.vb b/Plain Craft Launcher 2/Modules/ModSecret.vb index f6e0a36..52fd4d2 100644 --- a/Plain Craft Launcher 2/Modules/ModSecret.vb +++ b/Plain Craft Launcher 2/Modules/ModSecret.vb @@ -8,8 +8,12 @@ Friend Module ModSecret #Region "杂项" - '在开源内容的注册表键与普通内容的注册表键隔离 + '在开源版的注册表与常规版的注册表隔离，以防数据冲突 Public Const RegFolder As String = "PCLDebug" + '用于微软登录的 ClientId + Public Const OAuthClientId As String = "" + 'CurseForge API Key + Public Const CurseForgeAPIKey As String = "" Friend Sub SecretOnApplicationStart() '提升 UI 线程优先级 @@ -41,8 +45,9 @@ Friend Module ModSecret Environment.[Exit](Result.Cancel) End If '开源版本提示 - MyMsgBox($"该版本中不包含以下特性： -- CurseForge 查询：需要 API Key（你可以申请一个，然后添加到 SecretHeadersSign 方法中） + MyMsgBox($"该版本中无法使用以下特性： +- CurseForge API 调用：需要你自行申请 API Key，然后添加到 ModSecret.vb 的开头 +- 正版登录：需要你自行申请 Client ID，然后添加到 ModSecret.vb 的开头 - 更新与联网通知：避免滥用隐患 - 主题切换：这是需要赞助解锁的纪念性质的功能，别让赞助者太伤心啦…… - 百宝箱：开发早期往里面塞了些开发工具，整理起来太麻烦了", "开源版本说明") @@ -89,35 +94,36 @@ Friend Module ModSecret #Region "网络鉴权" Friend Function SecretCdnSign(UrlWithMark As String) - '只处理以 {CDN} 结尾的链接 If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20") End Function ''' ''' 设置 Headers 的 UA、Referer。 ''' - Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False) - If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用 - If UseBrowserUserAgent Then + Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False) + If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then + Client.Headers("User-Agent") = "LogStatistic" '#4951 + ElseIf UseBrowserUserAgent Then Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Else Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode End If - Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/" - '如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问 + Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/" + If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey End Sub ''' ''' 设置 Headers 的 UA、Referer。 ''' Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False) - If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用 - If UseBrowserUserAgent Then + If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then + Request.UserAgent = "LogStatistic" '#4951 + ElseIf UseBrowserUserAgent Then Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Else Request.UserAgent = "PCL2/" & VersionStandardCode End If - Request.Referer = "http://" & VersionCode & ".pcl2.server/" - '如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问 + Request.Referer = "http://" & VersionCode & ".pcl2.open.server/" + If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey End Sub #End Region diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index c5d5a6d..5f7dcd9 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 方法是按如下所示使用“*” - - + + diff --git a/Plain Craft Launcher 2/My Project/Resources.Designer.vb b/Plain Craft Launcher 2/My Project/Resources.Designer.vb index 033f910..81e998d 100644 --- a/Plain Craft Launcher 2/My Project/Resources.Designer.vb +++ b/Plain Craft Launcher 2/My Project/Resources.Designer.vb @@ -100,6 +100,16 @@ Namespace My.Resources End Get End Property + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Imazen_WebP() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + ''' ''' 查找 System.Byte[] 类型的本地化资源。 ''' @@ -120,6 +130,16 @@ Namespace My.Resources End Get End Property + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property libwebp64() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + ''' ''' 查找 System.Byte[] 类型的本地化资源。 ''' diff --git a/Plain Craft Launcher 2/My Project/Resources.resx b/Plain Craft Launcher 2/My Project/Resources.resx index 66663f3..8f1da65 100644 --- a/Plain Craft Launcher 2/My Project/Resources.resx +++ b/Plain Craft Launcher 2/My Project/Resources.resx @@ -130,12 +130,18 @@ ..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + ..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + ..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 ..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + ..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + ..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb index b7e5093..ff7ec51 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -1,4 +1,5 @@ Imports System.IO.Compression +Imports System.Net.Http Public Module ModDownloadLib @@ -28,15 +29,12 @@ Public Module ModDownloadLib Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then - If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return LoaderTaskbar(i) - Hint("该版本正在下载中！", HintType.Critical) - Return LoaderTaskbar(i) - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For + If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader + Hint("该版本正在下载中！", HintType.Critical) + Return OngoingLoader + Next '已有版本检查 If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then @@ -62,50 +60,6 @@ Public Module ModDownloadLib Return Nothing End Try End Function - ''' - ''' 保存某个 Minecraft 版本的核心文件（仅 Json 与核心 Jar）。 - ''' - ''' 所下载的 Minecraft 的版本名。 - ''' Json 文件的 Mojang 官方地址。 - Public Sub McDownloadClientCore(Id As String, JsonUrl As String, Behaviour As NetPreDownloadBehaviour) - Try - Dim VersionFolder As String = SelectFolder() - If Not VersionFolder.Contains("\") Then Exit Sub - VersionFolder = VersionFolder & Id & "\" - - '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then - If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock - - Dim Loaders As New List(Of LoaderBase) - '下载版本 Json 文件 - Loaders.Add(New LoaderDownload("下载版本 json 文件", New List(Of NetFile) From { - New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) - }) With {.ProgressWeight = 2}) - '获取支持库文件地址 - Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 jar 文件下载地址", - Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False}) - '下载支持库文件 - Loaders.Add(New LoaderDownload("下载核心 jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) - - '启动 - Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} - Loader.Start(Id) - LoaderTaskbarAdd(Loader) - FrmMain.BtnExtraDownload.ShowRefresh() - FrmMain.BtnExtraDownload.Ribble() - - Catch ex As Exception - Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback) - End Try - End Sub ''' ''' 获取下载某个 Minecraft 版本的加载器列表。 @@ -161,7 +115,7 @@ Public Module ModDownloadLib LoadersAssets.Add(New LoaderDownload("下载资源文件索引（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False}) LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) - Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task) + Task.Output = McAssetsFixList(New McVersion(VersionFolder), True, Task) End Sub) With {.ProgressWeight = 3, .Show = False}) LoadersAssets.Add(New LoaderDownload("下载资源文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False}) Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21}) @@ -213,7 +167,12 @@ Public Module ModDownloadLib ToolTipService.SetVerticalOffset(BtnInfo, 30) ToolTipService.SetHorizontalOffset(BtnInfo, 2) AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog - sender.Buttons = {BtnInfo} + Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"} + ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnServer, 30) + ToolTipService.SetHorizontalOffset(BtnServer, 2) + AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer + sender.Buttons = {BtnServer, BtnInfo} End Sub Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs) Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} @@ -226,7 +185,12 @@ Public Module ModDownloadLib ToolTipService.SetVerticalOffset(BtnInfo, 30) ToolTipService.SetHorizontalOffset(BtnInfo, 2) AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog - sender.Buttons = {BtnSave, BtnInfo} + Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"} + ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnServer, 30) + ToolTipService.SetHorizontalOffset(BtnServer, 2) + AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer + sender.Buttons = {BtnSave, BtnInfo, BtnServer} End Sub Private Sub McDownloadMenuLog(sender As Object, e As RoutedEventArgs) Dim Version As JToken @@ -239,6 +203,83 @@ Public Module ModDownloadLib End If McUpdateLogShow(Version) End Sub + Private Sub McDownloadMenuSaveServer(sender As Object, e As RoutedEventArgs) + Dim Version As MyListItem + If TypeOf sender Is MyListItem Then + Version = sender + ElseIf TypeOf sender.Parent Is MyListItem Then + Version = sender.Parent + Else + Version = sender.Parent.Parent + End If + Try + Dim Id = Version.Title + Dim JsonUrl = Version.Tag("url").ToString + Dim VersionFolder As String = SelectFolder() + If Not VersionFolder.Contains("\") Then Exit Sub + VersionFolder = VersionFolder & Id & "\" + + '重复任务检查 + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"Minecraft {Id} 服务端下载" Then Continue For + Hint("该服务端正在下载中！", HintType.Critical) + Exit Sub + Next + + Dim Loaders As New List(Of LoaderBase) + '下载版本 JSON 文件 + Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From { + New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) + }) With {.ProgressWeight = 2}) + '构建服务端 + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '分析服务端 JAR 文件下载地址 + Dim McVersion As New McVersion(VersionFolder) + If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then + File.Delete(VersionFolder & Id & ".json") + If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder) + Task.Output = New List(Of NetFile) + Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载，没法下，撤退！", HintType.Critical) + Thread.Sleep(2000) '等玩家把上一个提示看完 + Task.Abort() + Exit Sub + End If + Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url") + Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1")) + Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)} + '添加启动脚本 + Dim Bat As String = +$"@echo off +title {Id} 原版服务端 +echo 如果服务端立即停止，请右键编辑该脚本，将下一行开头的 java 替换为适合该 Minecraft 版本的完整 java.exe 的路径。 +echo 你可以在 PCL 的 [设置 → 启动选项] 中查看已安装的 java，所需的 java.exe 一般在其中的 bin 文件夹下。 +echo ------------------------------ +echo 如果提示 ""You need to agree to the EULA in order to run the server""，请打开 eula.txt，按说明阅读并同意 Minecraft EULA 后，将该文件最后一行中的 eula=false 改为 eula=true。 +echo ------------------------------ +""java"" -server -XX:+UseG1GC -Xmx4096M -Xms1024M -XX:+UseCompressedOops -jar {Id}-server.jar nogui +echo ---------------------- +echo 服务端已停止。 +pause" + WriteFile(VersionFolder & "Launch Server.bat", Bat, + Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030"))) + '删除版本 JSON + File.Delete(VersionFolder & Id & ".json") + End Sub + ) With {.ProgressWeight = 0.5, .Show = False}) + '下载服务端文件 + Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5}) + + '启动 + Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 服务端下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(Id) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Catch ex As Exception + Log(ex, "开始 Minecraft 服务端下载失败", LogLevel.Feedback) + End Try + End Sub Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs) Dim Version As MyListItem If TypeOf sender Is MyListItem Then @@ -248,7 +289,41 @@ Public Module ModDownloadLib Else Version = sender.Parent.Parent End If - McDownloadClientCore(Version.Title, Version.Tag("url").ToString, NetPreDownloadBehaviour.HintWhileExists) + Try + Dim Id = Version.Title + Dim JsonUrl = Version.Tag("url").ToString + Dim VersionFolder As String = SelectFolder() + If Not VersionFolder.Contains("\") Then Exit Sub + VersionFolder = VersionFolder & Id & "\" + + '重复任务检查 + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next + + Dim Loaders As New List(Of LoaderBase) + '下载版本 JSON 文件 + Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From { + New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) + }) With {.ProgressWeight = 2}) + '获取支持库文件地址 + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址", + Sub(Task) Task.Output = New List(Of NetFile) From {DlClientJarGet(New McVersion(VersionFolder), False)} + ) With {.ProgressWeight = 0.5, .Show = False}) + '下载支持库文件 + Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) + + '启动 + Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(Id) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Catch ex As Exception + Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback) + End Try End Sub ''' ''' 显示某 Minecraft 版本的更新日志。 @@ -316,46 +391,6 @@ Public Module ModDownloadLib #Region "OptiFine 下载" - Public Sub McDownloadOptiFine(DownloadInfo As DlOptiFineListEntry) - Try - Dim Id As String = DownloadInfo.NameVersion - Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" - Dim IsNewVersion As Boolean = Val(DownloadInfo.Inherit.Split(".")(1)) >= 14 - Dim Target As String = If(IsNewVersion, - PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(), - PathMcFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")) - - '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock - - '已有版本检查 - If File.Exists(VersionFolder & Id & ".json") Then - If MyMsgBox("版本 " & Id & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 json 和 jar 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then - File.Delete(VersionFolder & Id & ".jar") - File.Delete(VersionFolder & Id & ".json") - Else - Exit Sub - End If - End If - - '启动 - Dim Loader As New LoaderCombo(Of String)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineLoader(DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState} - Loader.Start(VersionFolder) - LoaderTaskbarAdd(Loader) - FrmMain.BtnExtraDownload.ShowRefresh() - FrmMain.BtnExtraDownload.Ribble() - - Catch ex As Exception - Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback) - End Try - End Sub Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry) Try Dim Id As String = DownloadInfo.NameVersion @@ -363,14 +398,11 @@ Public Module ModDownloadLib If Not Target.Contains("\") Then Exit Sub '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave} Loader.Start(DownloadInfo) @@ -408,7 +440,7 @@ Public Module ModDownloadLib '添加 Java Wrapper 作为主 Jar Dim Arguments As String If UseJavaWrapper Then - Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer" + Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer" Else Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer" End If @@ -527,10 +559,12 @@ Public Module ModDownloadLib Task.Progress = 0.1 Dim Sources As New List(Of String) 'BMCLAPI 源 + Dim BmclapiInherit As String = DownloadInfo.Inherit + If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 If DownloadInfo.IsPreview Then - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) Else - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) End If '官方源 Dim PageData As String @@ -538,12 +572,10 @@ Public Module ModDownloadLib PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) Task.Progress = 0.8 Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) - Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) + Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last) Catch ex As Exception Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") End Try - 'OptiFine 中文镜像源 - Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile) '构造文件请求 Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} End Sub) With {.ProgressWeight = 8}) @@ -690,10 +722,12 @@ Retry: Sub(Task As LoaderTask(Of DlOptiFineListEntry, List(Of NetFile))) Dim Sources As New List(Of String) 'BMCLAPI 源 + Dim BmclapiInherit As String = DownloadInfo.Inherit + If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 If DownloadInfo.IsPreview Then - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) Else - Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) End If '官方源 Dim PageData As String @@ -701,7 +735,7 @@ Retry: PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) Task.Progress = 0.8 Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) - Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) + Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last) Catch ex As Exception Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") End Try @@ -793,14 +827,11 @@ Retry: Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next '已有版本检查 If File.Exists(VersionFolder & VersionName & ".json") Then @@ -830,14 +861,11 @@ Retry: If Not Target.Contains("\") Then Exit Sub '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next '构造步骤加载器 Dim Loaders As New List(Of LoaderBase) @@ -1007,73 +1035,6 @@ Retry: #Region "Forgelike 下载" - Public Sub McDownloadForgelike(Info As DlForgelikeEntry) - '老版本提示 - If Not Info.IsNeoForge Then - Dim ForgeInfo As DlForgeVersionEntry = Info - If ForgeInfo.Category = "client" Then - If MyMsgBox("该 Forge 版本过于古老，PCL 暂不支持该版本的自动安装。" & vbCrLf & - "若你仍然希望继续，PCL 将把安装程序下载到你指定的位置，但不会进行安装。", - "版本过老", "继续", "取消") = 1 Then - McDownloadForgelikeSave(Info) - End If - Exit Sub - End If - If ForgeInfo.Category = "universal" OrElse ForgeInfo.Inherit.StartsWithF("1.5") Then - If MyMsgBox("该 Forge 版本过于古老，PCL 暂不支持该版本的自动安装。" & vbCrLf & - "若你仍然希望继续，PCL 将把安装程序下载到你指定的位置，但不会进行安装。", - "版本过老", "继续", "取消") = 1 Then - McDownloadForgelikeSave(Info) - End If - Exit Sub - End If - End If - '初始化参数 - Dim McVersionName As String = $"{Info.Inherit}-{Info.LoaderName.ToLower}-{Info.VersionName}" - Dim TempFolder As String = $"{PathTemp}Cache\Code\{Info.LoaderName}Install-{Info.Version}_{GetUuid()}.{Info.FileExtension}" - Dim McVersionFolder As String = $"{PathMcFolder}versions\{McVersionName}\" - Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}" - Try - - '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = Info.LoaderName & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock - - '已有版本检查 - If File.Exists(McVersionFolder & McVersionName & ".json") Then - If MyMsgBox("版本 " & McVersionName & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 json 和 jar 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then - File.Delete(McVersionFolder & McVersionName & ".jar") - File.Delete(McVersionFolder & McVersionName & ".json") - Else - Exit Sub - End If - End If - - '启动 - Dim Loader As New LoaderCombo(Of String)(Info.LoaderName & " 下载", - McDownloadForgelikeLoader(Info.IsNeoForge, If(Info.IsNeoForge, CType(Info, DlNeoForgeListEntry).ApiName, Info.VersionName), Info.Inherit, Info)) With - {.OnStateChanged = AddressOf McInstallState} - Loader.Start(McVersionFolder) - LoaderTaskbarAdd(Loader) - FrmMain.BtnExtraDownload.ShowRefresh() - FrmMain.BtnExtraDownload.Ribble() - - Catch ex As Exception - Log(ex, $"开始 {Info.LoaderName} 下载失败", LogLevel.Feedback) - Finally - '删除安装包 - Try - If File.Exists(TempFolder) Then File.Delete(TempFolder) - Catch - End Try - End Try - End Sub Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry) Try Dim Target As String = SelectAs("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}", @@ -1082,14 +1043,11 @@ Retry: If Not Target.Contains("\") Then Exit Sub '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = DisplayName & " 下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next '获取下载地址 Dim Files As New List(Of NetFile) @@ -1151,7 +1109,7 @@ Retry: '添加 Java Wrapper 作为主 Jar Dim Arguments As String If UseJavaWrapper Then - Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}" + Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}" Else Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" End If @@ -1242,79 +1200,74 @@ Retry: End SyncLock End Sub Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean)) - If Content.StartsWithF(" Data") OrElse Content.StartsWithF(" Slim") Then - If ModeDebug Then Log("[Installer] " & Content) - ElseIf Content.StartsWithF(" Reading patch ") Then - If ModeDebug Then Log("[Installer] " & Content) - Task.Progress = 0.86 - Else - Select Case Content - Case "Extracting json" - Log("[Installer] " & Content) - Task.Progress = 0.07 - Case "Downloading libraries" - Log("[Installer] " & Content) - Task.Progress = 0.08 - Case " File exists: Checksum validated." - If ModeDebug Then Log("[Installer] " & Content) - Task.Progress += 0.003 - Case "Building Processors" - Task.Progress = 0.38 - Case "Task: DOWNLOAD_MOJMAPS" 'B - Task.Progress = 0.4 - Case "Task: MERGE_MAPPING" 'B - Task.Progress = 0.6 - Case "Splitting: " - Task.Progress = 0.62 - Case "Parameter Annotations" 'B - Task.Progress = 0.66 - Case "Processing Complete" 'B - Task.Progress = 0.7 - Case "Remapping final jar" 'A - Task.Progress = 0.72 - Case "Remapping jar... 50%" 'A - Task.Progress = 0.76 - Case "Remapping jar... 100%" 'A - Task.Progress = 0.81 - Case "Injecting profile" - Task.Progress = 0.91 - Case Else - If ModeDebug Then Log("[Installer] " & Content) - Exit Sub - End Select - Log("[Installer] " & Content) - End If + Select Case Content + Case "Extracting json" + Log("[Installer] " & Content) + Task.Progress = 0.07 + Case "Downloading libraries" + Log("[Installer] " & Content) + Task.Progress = 0.08 + Case " File exists: Checksum validated." + If ModeDebug Then Log("[Installer] " & Content) + Task.Progress += 0.003 + Case "Building Processors" + Task.Progress = 0.18 + Case "Task: DOWNLOAD_MOJMAPS" 'B + Task.Progress = 0.2 + Case "Task: MERGE_MAPPING" 'B + Task.Progress = 0.3 + Case "Splitting: " + Task.Progress = 0.35 + Case "Parameter Annotations" 'B + Task.Progress = 0.4 + Case "Processing Complete" 'B + Task.Progress = 0.5 + Case "log: null" 'new + Task.Progress = 0.5 + Case "Sorting" 'new + Task.Progress = 0.65 + Case "Remapping final jar" 'A + Task.Progress = 0.72 + Case "Remapping jar... 50%" 'A + Task.Progress = 0.76 + Case "Remapping jar... 100%" 'A + Task.Progress = 0.81 + Case "Injecting profile" + Task.Progress = 0.91 + Case Else + If ModeDebug Then Log("[Installer] " & Content) + Exit Sub + End Select + Log("[Installer] " & Content) End Sub ''' ''' 获取下载某个 Forgelike 版本的加载器列表。 ''' - Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, Version As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) + Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, LoaderVersion As String, TargetVersion As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing) As List(Of LoaderBase) '参数初始化 McFolder = If(McFolder, PathMcFolder) If IsNeoForge AndAlso Info Is Nothing Then '需要传入 API Name，但整合包版本可能不以 1.20.1- 开头，所以需要进行特别处理 - If Inherit = "1.20.1" AndAlso Not Version.StartsWithF("1.20.1-") Then - Info = New DlNeoForgeListEntry("1.20.1-" & Version) + If Inherit = "1.20.1" AndAlso Not LoaderVersion.StartsWithF("1.20.1-") Then + Info = New DlNeoForgeListEntry("1.20.1-" & LoaderVersion) Else - Info = New DlNeoForgeListEntry(Version) + Info = New DlNeoForgeListEntry(LoaderVersion) End If End If - If Not IsNeoForge AndAlso Version.StartsWithF("1.") AndAlso Version.Contains("-") Then + If Not IsNeoForge AndAlso LoaderVersion.StartsWithF("1.") AndAlso LoaderVersion.Contains("-") Then '类似 1.19.3-41.2.8 格式，优先使用 Version 中要求的版本而非 Inherit（例如 1.19.3 却使用了 1.19 的 Forge） - Inherit = Version.Before("-") - Version = Version.After("-") + Inherit = LoaderVersion.BeforeFirst("-") + LoaderVersion = LoaderVersion.AfterLast("-") End If Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge") Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder - Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{Version}_{RandomInteger(0, 100000)}" - Dim VersionName As String = If(IsNeoForge, "neoforge-" & Version.Replace("1.20.1-", ""), "forge-" & Version) - Dim VersionFolder As String = $"{McFolder}versions\{VersionName}\" - Log($"[Download] Forgelike 安装目标版本文件夹：{VersionFolder}") - Dim DisplayName As String = $"{LoaderName} {Inherit} - {Version}" + Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{LoaderVersion}_{RandomInteger(0, 100000)}" + Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\" + Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}" Dim Loaders As New List(Of LoaderBase) - Dim LibVersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" '作为 Lib 文件目标的版本文件夹 + Dim LibVersionFolder As String = $"{PathMcFolder}versions\{TargetVersion}\" '作为 Lib 文件目标的版本文件夹 '获取 Forge 下载信息 If Info Is Nothing Then @@ -1326,12 +1279,12 @@ Retry: Task.Progress = 0.8 '查找对应版本 For Each ForgeVersion In ForgeLoader.Output - If VersionSortInteger(ForgeVersion.Version.ToString, Version) = 0 Then + If VersionSortInteger(ForgeVersion.Version.ToString, LoaderVersion) = 0 Then Info = ForgeVersion Exit Sub End If Next - Throw New Exception($"未能找到 {LoaderName} " & Inherit & "-" & Version & " 的详细信息！") + Throw New Exception($"未能找到 {LoaderName} " & Inherit & "-" & LoaderVersion & " 的详细信息！") End Sub) With {.ProgressWeight = 3}) End If '下载 Forgelike 主文件 @@ -1354,9 +1307,11 @@ Retry: Else 'Forge Dim Forge As DlForgeVersionEntry = Info + Dim FileName As String = + $"{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}/forge-{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}" Files.Add(New NetFile({ - $"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}", - $"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}" + $"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}", + $"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{FileName}" }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash))) End If Task.Output = Files @@ -1364,8 +1319,8 @@ Retry: Loaders.Add(New LoaderDownload($"下载 {LoaderName} 主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) '安装（仅在新版安装时需要原版 Jar） - If IsNeoForge OrElse Version.Before(".") >= 20 Then - Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：" & Version) + If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then + Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：" & LoaderVersion) Dim Libs As List(Of McLibToken) = Nothing Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) @@ -1386,17 +1341,19 @@ Retry: Task.Progress = 0.4 Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] - Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@") + Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@") Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) - Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, - .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")}) - Log("[Download] 需要下载 Mappings：" & Address) + Dim ClientMappings As JToken = RawJson("downloads")("client_mappings") + Libs.Add(New McLibToken With { + .IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, + .Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")}) + Log($"[Download] 需要下载 Mappings：{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})") End If Task.Progress = 0.8 '去除其中的原始 Forgelike 项 For i = 0 To Libs.Count - 1 - If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{Version}.jar") OrElse - Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{Version}-client.jar") Then + If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse +Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then Log($"[Download] 已从待下载 {LoaderName} 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug) Libs.RemoveAt(i) Exit For @@ -1498,10 +1455,15 @@ Retry: '如果没有新增文件夹，那么预测的文件夹名就是正确的 '如果只新增 1 个文件夹，那么拷贝 json 文件 Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First() - WriteFile(VersionFolder & VersionName & ".json", ReadFile(JsonFile.FullName)) + WriteFile(VersionFolder & TargetVersion & ".json", ReadFile(JsonFile.FullName)) + Log($"[Download] 已拷贝新增的版本 JSON 文件：{JsonFile.FullName} -> {VersionFolder}{TargetVersion}.json") + ElseIf DeltaList.Count > 1 Then + '新增了多个文件夹 + Log($"[Download] 有多个疑似的新增版本，无法确定：{DeltaList.Select(Function(d) d.Name).Join(";")}") + Else + '没有新增文件夹 + Log("[Download] 未找到新增的版本文件夹") End If - '新建 mods 文件夹 - Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Catch ex As Exception Throw New Exception($"安装新 {LoaderName} 版本失败", ex) Finally @@ -1515,7 +1477,7 @@ Retry: End Try End Sub) With {.ProgressWeight = 10}) Else - Log("[Download] 检测为非新版 Forge：" & Version) + Log("[Download] 检测为非新版 Forge：" & LoaderVersion) Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}（方式 B）", Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Dim Installer As ZipArchive = Nothing @@ -1533,8 +1495,8 @@ Retry: Log("[Download] 开始进行 Forge 安装，Legacy 方式 1：" & InstallerAddress) '建立 Json 文件 Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) - JsonVersion("id") = VersionName - WriteFile(VersionFolder & VersionName & ".json", JsonVersion.ToString) + JsonVersion("id") = TargetVersion + WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString) Task.Progress = 0.6 '解压支持库文件 Installer.Dispose() @@ -1550,12 +1512,10 @@ Retry: WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) Task.Progress = 0.9 '建立 Json 文件 - Json("versionInfo")("id") = VersionName + Json("versionInfo")("id") = TargetVersion If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) - WriteFile(VersionFolder & VersionName & ".json", Json("versionInfo").ToString) + WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString) End If - '新建 mods 文件夹 - Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Catch ex As Exception Throw New Exception("非新版方式安装 Forge 失败", ex) Finally @@ -1569,11 +1529,6 @@ Retry: End Try End Try End Sub) With {.ProgressWeight = 1}) - If FixLibrary Then - If IsCustomFolder Then Throw New Exception("若需要补全支持库，就不能自定义 MC 文件夹") - Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) - Loaders.Add(New LoaderDownload($"下载 {LoaderName} 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 11}) - End If End If Return Loaders @@ -1838,14 +1793,11 @@ Retry: If Not Target.Contains("\") Then Exit Sub '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = "Fabric " & Version & " 安装器下载" Then - Hint("该版本正在下载中！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar.ToList() + If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + Next '构造步骤加载器 Dim Loaders As New List(Of LoaderBase) @@ -1881,26 +1833,24 @@ Retry: '下载 Json MinecraftName = MinecraftName.Replace("∞", "infinite") '放在 ID 后面避免影响版本文件夹名称 Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址", - Sub(Task As LoaderTask(Of String, List(Of NetFile))) - '启动依赖版本的下载 - If FixLibrary Then - McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName) - End If - Task.Progress = 0.5 - '构造文件请求 - Task.Output = New List(Of NetFile) From {New NetFile({ - "https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", - "https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json" - }, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} - '新建 mods 文件夹 - Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") - End Sub) With {.ProgressWeight = 0.5}) + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If FixLibrary Then + McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName) + End If + Task.Progress = 0.5 + '构造文件请求 + Task.Output = New List(Of NetFile) From {New NetFile({ + "https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", + "https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json" + }, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} + End Sub) With {.ProgressWeight = 0.5}) Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5}) '下载支持库 If FixLibrary Then Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件", - Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) + Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8}) End If @@ -1925,7 +1875,7 @@ Retry: Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem '建立控件 Dim NewItem As New MyListItem With { - .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Before("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, + .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Logo = PathImage & "Blocks/Fabric.png" } @@ -2090,6 +2040,8 @@ Retry: FrmMain.BtnExtraDownload.Ribble() Return True + Catch ex As CancelledException + Return False Catch ex As Exception Log(ex, "开始合并安装失败", LogLevel.Feedback) Return False @@ -2097,8 +2049,8 @@ Retry: End Function ''' ''' 获取合并安装加载器列表，并进行前期的缓存清理与 Java 检查工作。 - ''' 如果出现已知问题且已提示用户，则返回 Nothing。出现异常则直接抛出。 ''' + ''' Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase) '获取缓存目录 Dim PathInstallTemp As String @@ -2110,11 +2062,10 @@ Retry: '清理缓存 Try - If Not IsInstallTempCleared Then - IsInstallTempCleared = True - DeleteDirectory(PathInstallTemp, True) - Log("[Download] 已清理合并安装缓存") - End If + If IsInstallTempCleared Then Exit Try + IsInstallTempCleared = True + DeleteDirectory(PathInstallTemp, True) + Log("[Download] 已清理合并安装缓存") Catch ex As Exception Log(ex, "清理合并安装缓存失败") End Try @@ -2125,7 +2076,7 @@ Retry: If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) Dim OptiFineFolder As String = Nothing If Request.OptiFineVersion IsNot Nothing Then - If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.After("_HD_U_") '#735 + If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735 Request.OptiFineEntry = New DlOptiFineListEntry With { .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .Inherit = Request.MinecraftName, @@ -2138,7 +2089,7 @@ Retry: If Request.OptiFineEntry IsNot Nothing Then OptiFineFolder = TempMcFolder & "versions\" & Request.OptiFineEntry.NameVersion Dim ForgeFolder As String = Nothing If Request.ForgeEntry IsNot Nothing Then Request.ForgeVersion = If(Request.ForgeVersion, Request.ForgeEntry.VersionName) - If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-forge-" & Request.ForgeVersion + If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\forge-" & Request.ForgeVersion Dim NeoForgeFolder As String = Nothing If Request.NeoForgeEntry IsNot Nothing Then Request.NeoForgeVersion = If(Request.NeoForgeVersion, Request.NeoForgeEntry.VersionName) If Request.NeoForgeVersion IsNot Nothing Then NeoForgeFolder = TempMcFolder & "versions\neoforge-" & Request.NeoForgeVersion @@ -2147,12 +2098,16 @@ Retry: Dim LiteLoaderFolder As String = Nothing If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" - 'OptiFine 是否作为 Mod 进行下载 - Dim OptiFineAsMod As Boolean = - (Request.OptiFineEntry IsNot Nothing OrElse Request.OptiFineVersion IsNot Nothing) AndAlso Request.FabricVersion IsNot Nothing + '判断 OptiFine 是否作为 Mod 进行下载 + Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0) + Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine + (Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric... + (Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15（#4134） + Dim ModsFolder As String = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" + If OptiFineAsMod Then Log("[Download] OptiFine 将作为 Mod 进行下载") - OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" + OptiFineFolder = ModsFolder End If '记录日志 @@ -2166,7 +2121,7 @@ Retry: '重复版本检查 If File.Exists(OutputFolder & Request.TargetVersionName & ".json") Then Hint("版本 " & Request.TargetVersionName & " 已经存在！", HintType.Critical) - Return Nothing + Throw New CancelledException End If Dim LoaderList As New List(Of LoaderBase) @@ -2174,11 +2129,11 @@ Retry: 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}) + LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False}) End If 'OptiFabric If Request.OptiFabric IsNot Nothing Then - LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False}) + LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False}) End If '原版 Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing} @@ -2193,11 +2148,11 @@ Retry: End If 'Forge If Request.ForgeVersion IsNot Nothing Then - LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing}) + LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing}) End If 'NeoForge If Request.NeoForgeVersion IsNot Nothing Then - LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}) + LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}) End If 'LiteLoader If Request.LiteLoaderEntry IsNot Nothing Then @@ -2213,11 +2168,16 @@ Retry: InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder) Task.Progress = 0.3 If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries") - If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods") + If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", ModsFolder) + '新建 mods 文件夹 + If Request.ForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then + Directory.CreateDirectory(ModsFolder) + Log("[Download] 自动创建 mods 文件夹：" & ModsFolder) + End If End Sub) With {.ProgressWeight = 2, .Block = True}) '补全文件 If Not DontFixLibraries AndAlso - (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Before(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then + (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then 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(OutputFolder))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb index 95b18d0..5c041d1 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb @@ -43,6 +43,12 @@ Type = "愚人节版" Version("type") = "special" Version.Add("lore", GetMcFoolName(Version("id"))) + Case Else '4/1 自动视作愚人节版 + Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2) + If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then + Type = "愚人节版" + Version("type") = "special" + End If End Select Case "special" '已被处理的愚人节版 @@ -56,7 +62,7 @@ '排序 For i = 0 To Dict.Keys.Count - 1 Dict(Dict.Keys(i)) = Sort(Dict.Values(i), - Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date)) + Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date)) Next '清空当前 PanMain.Children.Clear() diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml index 7333268..28f238f 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml @@ -20,8 +20,13 @@ - - + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb index 0302160..c988751 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb @@ -34,41 +34,121 @@ End Select End Sub '结果 UI 化 - Private Class VersionSorterWithSelect + Private Class CardSorter Implements IComparer(Of String) - Public Top As String = "" + Public Topmost As String = "" Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare + '相同 If x = y Then Return 0 - If x = Top Then Return -1 - If y = Top Then Return 1 + '置顶 + If x = Topmost Then Return -1 + If y = Topmost Then Return 1 + '特殊版本 + Dim IsXSpecial As Boolean = x.EndsWithF("版本") + Dim IsYSpecial As Boolean = y.EndsWithF("版本") + If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y) + If IsXSpecial Then Return 1 + If IsYSpecial Then Return -1 + '比较版本号 + Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", "")) + If VersionCodeSort <> 0 Then Return VersionCodeSort + '比较全部 Return -VersionSortInteger(x, y) End Function - Public Sub New(Optional Top As String = "") - Me.Top = If(Top, "") + Public Sub New(Optional Topmost As String = "") + Me.Topmost = If(Topmost, "") End Sub End Class + + Private VersionFilter As String + Private IsMajorVersionFilter As Boolean '是否按大版本号筛选（1.21 / 1.20 / 1.19 / ...）而非小版本号（1.21.1 / 1.21 / 1.20.4 / ...） Private Sub Load_OnFinish() + '初始化筛选器 + Dim VersionFilters As List(Of String) + + '按小版本号筛选？ + IsMajorVersionFilter = False + VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). + Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList + '按大版本号筛选？ + If VersionFilters.Count >= 9 Then + IsMajorVersionFilter = True + VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). + Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList + End If + + 'UI 化筛选器 + PanFilter.Children.Clear() + If VersionFilters.Count <= 2 Then + CardFilter.Visibility = Visibility.Collapsed + VersionFilter = Nothing + Else + CardFilter.Visibility = Visibility.Visible + VersionFilters.Insert(0, "全部") + '转化为按钮 + For Each Version As String In VersionFilters + Dim NewButton As New MyRadioButton With { + .Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight} + NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0) + AddHandler NewButton.Check, + Sub(sender As MyRadioButton, raiseByMouse As Boolean) + PanScroll.ScrollToHome() + VersionFilter = If(sender.Text = "全部", Nothing, sender.Text) + UpdateFilterResult() + End Sub + PanFilter.Children.Add(NewButton) + Next + '自动选择 + Dim ToCheck As MyRadioButton = Nothing + If TargetVersion <> "" Then + Dim TargetFile = CompFileLoader.Output.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion)) + If TargetFile IsNot Nothing Then + Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True) + For Each Button As MyRadioButton In PanFilter.Children + If Button.Text <> TargetGroup Then Continue For + ToCheck = Button + Exit For + Next + End If + End If + If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0) + ToCheck.Checked = True + End If + + '更新筛选结果（文件列表 UI 化） + UpdateFilterResult() + End Sub + Private Sub UpdateFilterResult() Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any, - $"所选版本：{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "") - '初始化字典 - Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName)) - Dict.Add("未知版本", New List(Of CompFile)) + $"所选版本：{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "") + '归类到卡片下 + Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName)) + Dict.Add("其他版本", New List(Of CompFile)) + Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType))) For Each Version As CompFile In CompFileLoader.Output For Each GameVersion In Version.GameVersions - '决定添加到哪个版本 - Dim TargetCard As String - If GameVersion Is Nothing Then - TargetCard = "未知版本" - ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then - TargetCard = "快照版本" - ElseIf GameVersion.StartsWith("1.0") Then - TargetCard = "远古版本" - Else - TargetCard = GameVersion + '检查是否符合版本筛选器 + If VersionFilter IsNot Nothing AndAlso + GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For + '决定添加到哪个卡片 + Dim Ver As String = GetGroupedVersionName(GameVersion, False, False) + '遍历加入的加载器列表 + Dim Loaders As New List(Of String) + If Project.ModLoaders.Count > 1 AndAlso '至少有两个加载器 + Project.Type = CompType.Mod AndAlso '是 Mod + Ver.StartsWith("1.") Then '不是 “快照版本” 之类的 + For Each Loader In Version.ModLoaders + If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For + If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ") + Next End If - '实际进行添加 - If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile)) - If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version) + If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里 + '实际添加 + For Each Loader In Loaders + Dim TargetCard As String = Loader & Ver + If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile)) + If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version) + Next Next Next '添加筛选的版本的卡片 @@ -77,16 +157,16 @@ For Each Version As CompFile In CompFileLoader.Output If Version.GameVersions.Contains(TargetVersion) AndAlso (TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then + '检查是否符合版本筛选器 + If VersionFilter IsNot Nothing AndAlso + Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version) End If Next End If - -#Region "转化为 UI" + '转化为 UI Try - '清空当前 - PanMain.Children.Clear() - '转化为 UI + PanResults.Children.Clear() For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict If Not Pair.Value.Any() Then Continue For '增加卡片 @@ -94,7 +174,7 @@ Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value} NewCard.Children.Add(NewStack) NewCard.SwapControl = NewStack - PanMain.Children.Add(NewCard) + PanResults.Children.Add(NewCard) '确定卡片是否展开 If Pair.Key = TargetCardName OrElse (FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761 @@ -104,20 +184,29 @@ NewCard.IsSwaped = True End If '增加提示 - If Pair.Key = "未知版本" Then - NewStack.Children.Add(New MyHint With {.Text = "由于 API 的版本信息更新缓慢，可能无法识别刚更新不久的 MC 版本，只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)}) + If Pair.Key = "其他版本" Then + NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢，可能无法识别刚更新的 MC 版本，只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)}) End If Next '如果只有一张卡片，展开第一张卡片 - If PanMain.Children.Count = 1 Then - CType(PanMain.Children(0), MyCard).IsSwaped = False + If PanResults.Children.Count = 1 Then + CType(PanResults.Children(0), MyCard).IsSwaped = False End If Catch ex As Exception Log(ex, "可视化工程下载列表出错", LogLevel.Feedback) End Try -#End Region - End Sub + Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String + If Name Is Nothing Then + Return "其他版本" + ElseIf Name.Contains("w") Then + Return "快照版本" + ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then + Return "远古版本" + Else + Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name) + End If + End Function #End Region @@ -167,14 +256,10 @@ '构造步骤加载器 Dim Loaders As New List(Of LoaderBase) Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}" - Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png" + Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", - Sub() - If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then - Throw New Exception("整合包安装出现异常！") - End If - End Sub) With {.ProgressWeight = 0.1}) + Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1}) '启动 Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = @@ -229,7 +314,7 @@ If Not Version.IsLoaded Then Version.Load() If Not Version.Modable Then Return False If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso - Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False + Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True If AllowFabric AndAlso Version.Version.HasFabric Then Return True @@ -277,7 +362,7 @@ If Project.TranslatedName = Project.RawName Then FileName = File.FileName Else - Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - "). + Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - "). Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：") Select Case Setup.Get("ToolDownloadTranslate") Case 0 @@ -295,10 +380,10 @@ '弹窗要求选择保存位置 Dim Target As String Target = SelectAs("选择保存位置", FileName, - Desc & "文件|" & - If(Project.Type = CompType.Mod, - If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"), - If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) + Desc & "文件|" & + If(Project.Type = CompType.Mod, + If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"), + If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If Not Target.Contains("\") Then Exit Sub '构造步骤加载器 Dim LoaderName As String = Desc & "下载：" & GetFileNameWithoutExtentionFromPath(Target) & " " diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb index 2b4c8e3..354fe86 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb @@ -55,10 +55,6 @@ Card.StackInstall() End Sub - Public Sub DownloadStart(sender As MyListItem, e As Object) - McDownloadForgelike(sender.Tag) - End Sub - '介绍栏 Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click OpenWebsite("https://files.minecraftforge.net") diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb index 1304527..9b5a245 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb @@ -618,6 +618,12 @@ Type = "愚人节版" Version("type") = "special" Version.Add("lore", GetMcFoolName(Version("id"))) + Case Else '4/1 自动视作愚人节版 + Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2) + If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then + Type = "愚人节版" + Version("type") = "special" + End If End Select Case "special" '已被处理的愚人节版 @@ -724,6 +730,7 @@ Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry) If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本 If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge + If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183 If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0 Else 'XXXX @@ -1069,12 +1076,12 @@ If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False '直接的判断（例如 1.18.1/22w03a） - For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/") + For Each Part As String In DisplayName.BeforeFirst("]").TrimStart("[").Split("/") If Part = MinecraftVersion Then Return True Next '将版本名分割语素（例如 1.16.4/5） - Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+") - Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+") + Dim Lefts = RegexSearch(DisplayName.BeforeFirst("]"), "[a-z/]+|[0-9/]+") + Dim Rights = RegexSearch(MinecraftVersion.BeforeFirst("]"), "[a-z/]+|[0-9/]+") '对每段进行判断 Dim i As Integer = 0 While True diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml index 8a64667..bb644b1 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml @@ -2,88 +2,90 @@ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> - + + - - + - - - - - - - + + + + + + - - + - - - - - - - - --> + + + + + + + - - - - - - - - --> + + + + + + + - - - - - - - - --> + + + + + + + - - - - - - - + + + + + + - - - - - - - + + + + + + - - - - - - - - + + + + + + + - - - - - - - + + + + + + - - - - - - + + + + + + - + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb index 2658c33..f2eb250 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb @@ -1,4 +1,5 @@ Public Class PageDownloadLeft + Implements IRefreshable #Region "页面切换" @@ -61,7 +62,7 @@ PageChangeRun(PageGet(ID)) PageID = ID Catch ex As Exception - Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Log(ex, "切换分页面失败（ID " & ID & "）", LogLevel.Feedback) Finally AniControlEnabled -= 1 End Try @@ -91,7 +92,13 @@ '强制刷新 Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 - Select Case Val(sender.Tag) + Refresh(Val(sender.Tag)) + End Sub + Public Sub Refresh() Implements IRefreshable.Refresh + Refresh(FrmMain.PageCurrentSub) + End Sub + Public Sub Refresh(SubType As FormMain.PageSubType) + Select Case SubType Case FormMain.PageSubType.DownloadInstall DlClientListLoader.Start(IsForceRestart:=True) DlOptiFineListLoader.Start(IsForceRestart:=True) @@ -106,12 +113,14 @@ PageDownloadMod.Storage = New CompProjectStorage PageDownloadMod.Page = 0 CompProjectCache.Clear() + CompFilesCache.Clear() If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart() ItemMod.Checked = True Case FormMain.PageSubType.DownloadPack PageDownloadPack.Storage = New CompProjectStorage PageDownloadPack.Page = 0 CompProjectCache.Clear() + CompFilesCache.Clear() If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart() ItemPack.Checked = True Case FormMain.PageSubType.DownloadClient diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml index 4483c5d..bcfb637 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml @@ -33,19 +33,17 @@ - + + - - - diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb index db3f168..113ff25 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb @@ -1,24 +1,62 @@ Public Class PageDownloadMod Public Const PageSize = 40 + ''' + ''' 在切换到该页面时自动设置的目标版本。 + ''' + Public Shared TargetVersion As McVersion = Nothing '加载器信息 Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} Public Shared Storage As New CompProjectStorage Public Shared Page As Integer = 0 - Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized + Private IsLoaderInited As Boolean = False + Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Loaded + '不知道从 Initialized 改成 Loaded 会不会有问题，但用 Initialized 会导致初始的筛选器修改被覆盖回默认值 + If TargetVersion IsNot Nothing Then + '设置目标 + ResetFilter() '重置筛选器 + TextSearchVersion.Text = TargetVersion.Version.McName + Dim GetTargetItemByName = + Function(Name As String) As MyComboBoxItem + For Each Item As MyComboBoxItem In ComboSearchLoader.Items + If Item.Content = Name Then Return Item + Next + Return ComboSearchLoader.Items(0) + End Function + If TargetVersion.Version.HasForge Then + ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge") + ElseIf TargetVersion.Version.HasFabric Then + ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric") + ElseIf TargetVersion.Version.HasNeoForge Then + ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge") + End If + TargetVersion = Nothing + '如果已经完成请求，则重新开始 + If IsLoaderInited Then StartNewSearch() + PanScroll.ScrollToHome() + End If + '加载器初始化 + If IsLoaderInited Then Return + IsLoaderInited = True PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1))) End Sub Private Shared Function LoaderInput() As CompProjectRequest Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize) If FrmDownloadMod IsNot Nothing Then + Dim ModLoader As CompModLoaderType = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag) + Dim GameVersion As String = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing, + If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing)) + If GameVersion IsNot Nothing AndAlso GameVersion.Contains(".") AndAlso Val(GameVersion.Split(".")(1)) < 14 AndAlso '1.14- + ModLoader = CompModLoaderType.Forge Then '选择了 Forge + ModLoader = CompModLoaderType.Any '此时，视作没有筛选 Mod Loader（因为部分老 Mod 没有设置自己支持的加载器） + End If With Request .SearchText = FrmDownloadMod.TextSearchName.Text - .GameVersion = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing, - If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing)) + .GameVersion = GameVersion .Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag - .ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag) + .ModLoader = ModLoader .Source = CType(Val(FrmDownloadMod.ComboSearchSource.SelectedItem.Tag), CompSourceType) End With End If @@ -112,7 +150,7 @@ End Sub '重置按钮 - Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click + Private Sub ResetFilter() Handles BtnSearchReset.Click TextSearchName.Text = "" TextSearchVersion.Text = "全部 (也可自行输入)" TextSearchVersion.SelectedIndex = 0 diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml index f9b7bc3..886c343 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml @@ -8,7 +8,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml index 1ca5eb0..79b34ab 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml @@ -8,14 +8,12 @@ - + - - - + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb index 27c2fd4..f843529 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb @@ -49,8 +49,5 @@ Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click OpenWebsite("https://www.optifine.net/") End Sub - Private Sub BtnChina_Click(sender As Object, e As EventArgs) Handles BtnChina.Click - OpenWebsite("https://optifine.cn/home") - End Sub End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml index 1ed768b..5ad426d 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml @@ -32,19 +32,17 @@ - + + - - - @@ -60,7 +58,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml deleted file mode 100644 index 10e9c84..0000000 --- a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml +++ /dev/null @@ -1,28 +0,0 @@ - - - - - - - - - - - - - - - - - - - diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb deleted file mode 100644 index 35cd847..0000000 --- a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb +++ /dev/null @@ -1,100 +0,0 @@ -Imports System.Windows.Navigation - -Public Class FormLoginOAuth - - Public Event OnLoginSuccess(code As String) - Public Event OnLoginCanceled(IsSwitch As Boolean) - - '跳转事件 - Private IsLoginSuccessed As Boolean = False - Private IsSwitch As Boolean = False - Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating - Dim Url As String = e.Uri.AbsoluteUri - If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向：" & Url) - If Url.Contains("code=") Then - Dim Code As String = RegexSeek(Url, "(?<=code\=)[^&]+") - Log("[Login] 抓取到 OAuth 返回码：" & Code) - IsLoginSuccessed = True - RaiseEvent OnLoginSuccess(Code) - ElseIf Url.Contains("github.") Then - Hint("PCL 不支持使用 GitHub 登录微软账号！", HintType.Critical) - Close() - End If - End Sub - - '已导航事件 - Private IsFirstLoaded As Boolean = False - Private IsFirstLoadedLock As New Object - Private Sub Browser_Navigated(sender As WebBrowser, e As NavigationEventArgs) Handles Browser1.Navigated, Browser2.Navigated, Browser3.Navigated - SyncLock IsFirstLoadedLock - If IsFirstLoaded Then Exit Sub - IsFirstLoaded = True - End SyncLock - RunInThread(Sub() - Thread.Sleep(1000) - RunInUi(Sub() - sender.Visibility = Visibility.Visible - PanLoading.Visibility = Visibility.Collapsed - Log("[Login] 已将登录窗口切换至浏览器") - End Sub) - End Sub) - End Sub - - '窗体的进出事件 - Public Shared LoginUrl1 As String = "https://login.microsoftonline.com/consumers/oauth2/v2.0/authorize?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf" - Public Shared LoginUrl2 As String = "https://login.live.com/oauth20_authorize.srf?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf" - Private Sub FrmLoginOAuth_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded - Browser1.Navigate(LoginUrl1) - RunInThread(Sub() - '估计是由于时间戳原因，同时导航会导致误报密码失败 - Thread.Sleep(2500) - RunInUi(Sub() - Try '防止在 Dispose 之后调用 - If Not IsFirstLoaded Then Browser2.Navigate(LoginUrl1) - Catch - End Try - End Sub) - Thread.Sleep(2500) - RunInUi(Sub() - Try - If Not IsFirstLoaded Then Browser3.Navigate(LoginUrl2) - Catch - End Try - End Sub) - End Sub) - End Sub - Private Sub FormLoginOAuth_Closed() Handles Me.Closed - RunInThread(Sub() - Thread.Sleep(1000) '释放会卡一下，所以稍等一下…… - RunInUiWait(Sub() - Try - Browser1.Dispose() - Catch ex As Exception - Log(ex, "释放微软登录浏览器 1 失败") - End Try - End Sub) - Thread.Sleep(200) - RunInUiWait(Sub() - Try - Browser2.Dispose() - Catch ex As Exception - Log(ex, "释放微软登录浏览器 2 失败") - End Try - End Sub) - Thread.Sleep(200) - RunInUiWait(Sub() - Try - Browser3.Dispose() - Catch ex As Exception - Log(ex, "释放微软登录浏览器 3 失败") - End Try - End Sub) - End Sub) - If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch) - FrmMain.Focus() - End Sub - Private Sub HintSwitch_Click() Handles HintSwitch.Click - IsSwitch = True - Close() - End Sub -End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml new file mode 100644 index 0000000..1144f09 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb new file mode 100644 index 0000000..174f4be --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb @@ -0,0 +1,145 @@ +Public Class MyMsgLogin + Private Data As JObject + Private UserCode As String '需要用户在网页上输入的设备代码 + Private DeviceCode As String '用于轮询的设备代码 + Private Website As String '验证网页的网址 + +#Region "弹窗" + + Private ReadOnly MyConverter As MyMsgBoxConverter + Private ReadOnly Uuid As Integer = GetUuid() + + Public Sub New(Converter As MyMsgBoxConverter) + Try + InitializeComponent() + Btn1.Name = Btn1.Name & GetUuid() + Btn2.Name = Btn2.Name & GetUuid() + Btn3.Name = Btn3.Name & GetUuid() + MyConverter = Converter + ShapeLine.StrokeThickness = GetWPFSize(1) + Data = Converter.Content + Init() + Catch ex As Exception + Log(ex, "登录弹窗初始化失败", LogLevel.Hint) + End Try + End Sub + + Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded + Try + '动画 + Opacity = 0 + AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, If(MyConverter.IsWarn, New MyColor(140, 80, 0, 0), New MyColor(90, 0, 0, 0)) - FrmMain.PanMsg.Background, 200), "PanMsg Background") + AniStart({ + AaOpacity(Me, 1, 120, 60), + AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 300, 60, New AniEaseOutBack(AniEasePower.Weak)), + AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak)) + }, "MyMsgBox " & Uuid) + '记录日志 + Log("[Control] 登录弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text) + Catch ex As Exception + Log(ex, "登录弹窗加载失败", LogLevel.Hint) + End Try + End Sub + Private Sub Close() + '动画 + AniStart({ + AaCode( + Sub() + If Not WaitingMyMsgBox.Any() Then + AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak))) + End If + End Sub, 30), + AaOpacity(Me, -Opacity, 80, 20), + AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent), + AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)), + AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True) + }, "MyMsgBox " & Uuid) + End Sub + + '实现回车和 Esc 的接口（#4857） + Public Sub Btn1_Click() Handles Btn1.Click + End Sub + Public Sub Btn3_Click() Handles Btn3.Click + Finished(New ThreadInterruptedException) + End Sub + + Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown + On Error Resume Next + If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove() + End Sub + +#End Region + + Private Sub Finished(Result As Object) + If MyConverter.IsExited Then Return + MyConverter.IsExited = True + MyConverter.Result = Result + RunInUi(AddressOf Close) + Thread.Sleep(200) + FrmMain.ShowWindowToTop() + End Sub + + Private Sub Init() + UserCode = Data("user_code") + DeviceCode = Data("device_code") + Website = Data("verification_uri") + '设置 UI + LabTitle.Text = "登录 Minecraft" + LabCaption.Text = + $"登录网页将自动开启，请在网页中输入 {UserCode}（已自动复制）。" & vbCrLf & vbCrLf & + $"如果网络环境不佳，网页可能一直加载不出来，届时请使用 VPN 并重试。" & vbCrLf & + $"你也可以用其他设备打开 {Website} 并输入上述代码。" + Btn1.EventData = Website + Btn2.EventData = UserCode + '启动工作线程 + RunInNewThread(AddressOf WorkThread, "MyMsgLogin") + End Sub + + Private Sub WorkThread() + Thread.Sleep(3000) + If MyConverter.IsExited Then Exit Sub + OpenWebsite(Website) + ClipboardSet(UserCode) + Thread.Sleep((Data("interval").ToObject(Of Integer) - 1) * 1000) + '轮询 + Dim UnknownFailureCount As Integer = 0 + Do While Not MyConverter.IsExited + Try + Dim Result = NetRequestOnce( + "https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", + "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" & + "client_id=" & OAuthClientId & "&" & + "device_code=" & DeviceCode & "&" & + "scope=XboxLive.signin%20offline_access", + "application/x-www-form-urlencoded", 5000 + UnknownFailureCount * 5000, MakeLog:=False) + '获取结果 + Dim ResultJson As JObject = GetJson(Result) + McLaunchLog($"令牌过期时间：{ResultJson("expires_in")} 秒") + Hint("网页登录成功！", HintType.Finish) + Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString}) + Return + Catch ex As Exception + If ex.Message.Contains("authorization_declined") Then + Finished(New Exception("$你拒绝了 PCL 申请的权限……")) + Return + ElseIf ex.Message.Contains("expired_token") Then + Finished(New Exception("$登录用时太长啦，重新试试吧！")) + Return + ElseIf ex.Message.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”，见 #269 + Finished(New RestartException) + Return + ElseIf ex.Message.Contains("authorization_pending") Then + Thread.Sleep(2000) + ElseIf UnknownFailureCount <= 2 Then + UnknownFailureCount += 1 + Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败") + Thread.Sleep(2000) + Else + Finished(New Exception("登录轮询失败", ex)) + Return + End If + End Try + Loop + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb index 91f0bc6..6d1ef20 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb @@ -177,8 +177,8 @@ Sub() Try '更新缓存 - WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress) - Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress)) + WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress) + Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsV2Uuid"), SkinAddress)) '刷新控件 For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy} SkinLoader.WaitForExit(IsForceRestart:=True) @@ -241,7 +241,8 @@ Retry: {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"}, {"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"}, {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}, - {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Follower's", "追随者披风"} + {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, + {"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"} } Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} For Each Cape In SkinData("capes") diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb index c7da13c..416bdcf 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -21,6 +21,21 @@ '加载版本 RunInNewThread( Sub() + '自动整合包安装：准备 + Dim PackInstallPath As String = Nothing + If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip" + If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack" + If PackInstallPath IsNot Nothing Then + Log("[Launch] 需自动安装整合包：" & PackInstallPath, LogLevel.Debug) + Setup.Set("LaunchFolderSelect", "$.minecraft\") + If Not Directory.Exists(Path & ".minecraft\") Then + Directory.CreateDirectory(Path & ".minecraft\") + Directory.CreateDirectory(Path & ".minecraft\versions\") + McFolderLauncherProfilesJsonCreate(Path & ".minecraft\") + End If + PageSelectLeft.AddFolder(Path & ".minecraft\", GetFolderNameFromPath(Path), False) + McFolderListLoader.WaitForExit() + End If '确认 Minecraft 文件夹存在 PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then @@ -35,17 +50,28 @@ End If Log("[Launch] Minecraft 文件夹：" & PathMcFolder) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) + '自动整合包安装 + If PackInstallPath IsNot Nothing Then + Try + Dim InstallLoader = ModpackInstall(PackInstallPath, GetFolderNameFromPath(Path)) + Log("[Launch] 自动安装整合包已开始：" & PackInstallPath) + InstallLoader.WaitForExit() + If InstallLoader.State = LoadState.Finished Then + Log("[Launch] 自动安装整合包成功，删除安装包：" & PackInstallPath) + File.Delete(PackInstallPath) + End If + Catch ex As CancelledException + Log(ex, "自动安装整合包被用户取消：" & PackInstallPath) + Catch ex As Exception + Log(ex, "自动安装整合包失败：" & PackInstallPath, LogLevel.Msgbox) + End Try + End If '确认 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 + Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection)) + If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then '无效的版本 - Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) + Log("[Launch] 当前选择的 Minecraft 版本无效：" & If(Version Is Nothing, "null", 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 @@ -99,7 +125,7 @@ '初始化页面 LabLaunchingName.Text = McVersionCurrent.Name LabLaunchingStage.Text = "初始化" - LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本") + LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本") LabLaunchingProgress.Text = "0.00 %" LabLaunchingProgress.Opacity = 1 LabLaunchingDownload.Visibility = Visibility.Visible @@ -265,7 +291,7 @@ Case 0 '正版或离线 UnknownType: If RadioLoginType5.Checked Then - If Setup.Get("CacheMsAccess") = "" Then + If Setup.Get("CacheMsV2Access") = "" Then Type = PageType.Ms Else Type = PageType.MsSkin @@ -280,7 +306,7 @@ UnknownType: RadioLoginType5.Visibility = Visibility.Visible RadioLoginType0.Visibility = Visibility.Visible Case 1 '仅正版 - If Setup.Get("CacheMsAccess") = "" Then + If Setup.Get("CacheMsV2Access") = "" Then Type = PageType.Ms Else Type = PageType.MsSkin @@ -344,7 +370,7 @@ UnknownType: Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal) Private Shared Function SkinMsInput() As EqualableList(Of String) '获取名称 - Return New EqualableList(Of String) From {Setup.Get("CacheMsName"), Setup.Get("CacheMsUuid")} + Return New EqualableList(Of String) From {Setup.Get("CacheMsV2Name"), Setup.Get("CacheMsV2Uuid")} End Function Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String)) '清空已有皮肤 @@ -400,7 +426,7 @@ Finish: ElseIf Setup.Get("LoginLegacyName") = "" Then Return New EqualableList(Of String) From {0, ""} Else - Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")} + Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")} End If Case 3 Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} @@ -619,7 +645,7 @@ Finish: Log("[Minecraft] 启动按钮：正在加载 Minecraft 版本") FrmLaunchLeft.BtnLaunch.Text = "正在加载" FrmLaunchLeft.BtnLaunch.IsEnabled = False - FrmLaunchLeft.LabVersion.Text = "正在加载版本列表，请稍候" + FrmLaunchLeft.LabVersion.Text = "正在加载中，请稍候" FrmLaunchLeft.BtnVersion.IsEnabled = False FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed Case 1 @@ -702,7 +728,7 @@ ExitRefresh: If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高，直接回退 If IsLaunched Then ShowProgress = 1 '如果已经完成了，就不卖关子了 '文本 - LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")) + LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")) LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %" Dim HasLaunchDownloader As Boolean = False Try diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb index 5efe384..595aecb 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -1,4 +1,5 @@ Public Class PageLaunchRight + Implements IRefreshable Private Sub Init() Handles Me.Loaded PanBack.ScrollToHome() @@ -92,7 +93,7 @@ Download: GoTo Download Case 3 Log("[Page] 主页预设：简单主页") - Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml" + Url = "https://raw.gitcode.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml" GoTo Download Case 4 Log("[Page] 主页预设：每日整合包推荐") @@ -102,6 +103,30 @@ Download: Log("[Page] 主页预设：Minecraft 皮肤推荐") Url = "https://forgepixel.com/pcl_sub_file" GoTo Download + Case 6 + Log("[Page] 主页预设：OpenBMCLAPI 仪表盘 Lite") + Url = "https://pcl-bmcl.milu.ink/" + GoTo Download + Case 7 + Log("[Page] 主页预设：主页市场") + Url = "https://homepage-market.pages.dev/Custom.xaml" + GoTo Download + Case 8 + Log("[Page] 主页预设：更新日志") + Url = "https://updatehomepage.pages.dev/UpdateHomepage.xaml" + GoTo Download + Case 9 + Log("[Page] 主页预设：PCL 新功能说明书") + Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml" + GoTo Download + Case 10 + Log("[Page] 主页预设：OpenMCIM Dashboard") + Url = "https://files.mcimirror.top/PCL" + GoTo Download + Case 11 + Log("[Page] 主页预设：杂志主页") + Url = "http://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Ext1nguisher/Custom.xaml" + GoTo Download End Select End Select RunInUi(Sub() LoadContent(Content)) @@ -118,17 +143,17 @@ Download: If Address.Contains(".xaml") Then VersionAddress = Address.Replace(".xaml", ".xaml.ini") Else - VersionAddress = Address.Before("?") + VersionAddress = Address.BeforeFirst("?") If Not VersionAddress.EndsWith("/") Then VersionAddress += "/" VersionAddress += "version" - If Address.Contains("?") Then VersionAddress += Address.After("?") + If Address.Contains("?") Then VersionAddress += Address.AfterLast("?") End If '校验版本 Dim Version As String = "" Dim NeedDownload As Boolean = True Try Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000) - If Version.Length > 100 Then Throw New Exception($"获取的自定义主页版本过长（{Version.Length} 字符）") + If Version.Length > 1000 Then Throw New Exception($"获取的自定义主页版本过长（{Version.Length} 字符）") Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion") If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then Log($"[Page] 当前缓存的自定义主页已为最新，当前版本：{Version}，检查源：{VersionAddress}") @@ -163,7 +188,7 @@ Download: ''' 立即强制刷新自定义主页。 ''' 必须在 UI 线程调用。 ''' - Public Sub ForceRefresh() + Public Sub ForceRefresh() Implements IRefreshable.Refresh Log("[Page] 要求强制刷新自定义主页") ClearCache() '实际的刷新 diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb index 3476e70..e9ae125 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb @@ -17,8 +17,8 @@ ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨") - If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim + ComboName.Text = Setup.Get("LoginAuthEmail").ToString.BeforeFirst("¨") + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim End If End If IsFirstLoad = False diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb index 0ed101d..fec81e6 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb @@ -58,19 +58,23 @@ Hint("正在尝试更换，请稍候！") Setup.Set("CacheAuthUuid", "") '清空选择缓存 Setup.Set("CacheAuthName", "") - RunInThread(Sub() - Try - Dim Data As McLoginServer = GetLoginData() - Data.ForceReselectProfile = True - McLoginLoader.WaitForExit(Data, IsForceRestart:=True) - RunInUi(Sub() Reload(True)) - Catch ex As Exception - Log(ex, "更换角色失败", LogLevel.Hint) - End Try - End Sub) + RunInThread( + Sub() + Try + Dim Data As McLoginServer = GetLoginData() + Data.ForceReselectProfile = True + McLoginLoader.WaitForExit(Data, IsForceRestart:=True) + RunInUi(Sub() Reload(True)) + Catch ex As Exception + Log(ex, "更换角色失败", LogLevel.Hint) + End Try + End Sub) End Sub - Private Sub BtnExit_Click() Handles BtnExit.Click + Public Shared Sub ExitLogin() Handles BtnExit.Click Setup.Set("CacheAuthAccess", "") + Setup.Set("CacheAuthUuid", "") + Setup.Set("CacheAuthName", "") + McLoginAuthLoader.Input = Nothing '防止因为输入的用户名密码相同，直接使用了上次登录的加载器结果 FrmLaunchLeft.RefreshPage(False, True) End Sub diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb index 0c47882..ed91684 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb @@ -26,7 +26,7 @@ Public Class PageLoginLegacy ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim + ComboName.Text = Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim End If End If IsReloaded = True diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb index e61fa4e..a7f9830 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb @@ -37,7 +37,7 @@ ''' 获取当前页面的登录信息。 ''' Public Shared Function GetLoginData() As McLoginMs - If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} + If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")} Dim Result As McLoginMs = Nothing RunInUiWait( Sub() diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb index 15a3581..e7ecc6c 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb @@ -12,7 +12,7 @@ ''' 刷新页面显示的所有信息。 ''' Public Sub Reload(KeepInput As Boolean) - TextName.Text = Setup.Get("CacheMsName") + TextName.Text = Setup.Get("CacheMsV2Name") '皮肤在 Loaded 加载 End Sub ''' @@ -20,9 +20,9 @@ ''' Public Shared Function GetLoginData() As McLoginMs If McLoginMsLoader.State = LoadState.Finished Then - Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName"), .AccessToken = Setup.Get("CacheMsAccess"), .Uuid = Setup.Get("CacheMsUuid"), .ProfileJson = Setup.Get("CacheMsProfileJson")} + Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name"), .AccessToken = Setup.Get("CacheMsV2Access"), .Uuid = Setup.Get("CacheMsV2Uuid"), .ProfileJson = Setup.Get("CacheMsV2ProfileJson")} Else - Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} + Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")} End If End Function @@ -50,11 +50,11 @@ '退出登录 Private Sub BtnExit_Click() Handles BtnExit.Click - Setup.Set("CacheMsOAuthRefresh", "") - Setup.Set("CacheMsAccess", "") - Setup.Set("CacheMsProfileJson", "") - Setup.Set("CacheMsUuid", "") - Setup.Set("CacheMsName", "") + Setup.Set("CacheMsV2OAuthRefresh", "") + Setup.Set("CacheMsV2Access", "") + Setup.Set("CacheMsV2ProfileJson", "") + Setup.Set("CacheMsV2Uuid", "") + Setup.Set("CacheMsV2Name", "") McLoginMsLoader.Abort() FrmLaunchLeft.RefreshPage(False, True) End Sub @@ -90,8 +90,8 @@ Try Retry: If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束 - Dim AccessToken As String = Setup.Get("CacheMsAccess") - Dim Uuid As String = Setup.Get("CacheMsUuid") + Dim AccessToken As String = Setup.Get("CacheMsV2Access") + Dim Uuid As String = Setup.Get("CacheMsV2Uuid") Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)} Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) @@ -99,7 +99,7 @@ Retry: 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)} + {New Net.Http.ByteArrayContent(ReadFileBytes(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 diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb index 0e327d0..3b47833 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb @@ -17,8 +17,8 @@ ComboName.ItemsSource = Nothing Else ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") - ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨") - If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim + ComboName.Text = Setup.Get("LoginNideEmail").ToString.BeforeFirst("¨") + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim End If End If IsFirstLoad = False diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb index bceb7c8..84fa773 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb @@ -47,8 +47,9 @@ Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click OpenWebsite("https://login.mc-user.com:233/account/changepw") End Sub - Private Sub BtnExit_Click() Handles BtnExit.Click + Public Shared Sub ExitLogin() Handles BtnExit.Click Setup.Set("CacheNideAccess", "") + McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同，直接使用了上次登录的加载器结果 FrmLaunchLeft.RefreshPage(False, True) End Sub diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb b/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb index f0a318f..f1e6312 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb @@ -111,8 +111,6 @@ Public Class PageLinkIoi End Sub '复制联机码 Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click - ClipboardSet(IoiId.Substring(4) & SecretEncrypt(GetPlayerName), False) - Hint("已复制联机码！", HintType.Finish) End Sub #End Region @@ -419,75 +417,6 @@ Public Class PageLinkIoi '获取数据包 Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing) - '获取数据 - Dim Id As String = JsonData("id"), Type As String = JsonData("type") - Select Case Type - Case "connect" - Dim DisplayName As String = JsonData("name") - Dim User As New LinkUserIoi(Id, DisplayName, NewSocket) - '如果发生了双向连接 - If UserList.ContainsKey(Id) Then - If Id > IoiId Then - Log("[IOI] 双向连接，应当抛弃当前用户（" & DisplayName & "）") - For Each Pair In UserList(User.Id).Ports.ToList - User.Ports(Pair.Key) = Pair.Value - Next - UserList(Id).Dispose() - Else - '应当保留当前用户 - Log("[IOI] 双向连接，应当保留当前用户（" & DisplayName & "）") - NewSocket.Dispose() - Exit Sub - End If - End If - '加入列表 - UserList.Add(Id, User) - '返回请求 - User.RelativeThread = RunInNewThread(Sub() - SendPortsubBack(User, JsonData("version").ToObject(Of Integer)) - End Sub, "Link Connect " & DisplayName) - '更新时间 - User.LastReceive = Date.Now - Case "update" - If Not UserList.ContainsKey(Id) Then Throw New Exception("未在列表中的用户发送了更新请求：" & Id) - Dim User = UserList(Id) - '拉满进度（该请求也作为反向连接回应出现，用于向正向连接方传达连接已完成信号） - User.Progress = 1 - '更新名称 - Dim DisplayName As String = JsonData("name") - User.DisplayName = DisplayName - '更新房间列表 - If JsonData("rooms") IsNot Nothing Then - User.Rooms = New List(Of RoomEntry) - For Each RoomObject In JsonData("rooms") - User.Rooms.Add(New RoomEntry(RoomObject("port"), RoomObject("name"), User)) - Next - End If - '更新 Ping - Dim Stage As Integer = JsonData("stage"), Unique As Long = JsonData("unique") - If Stage > 1 Then - User.PingRecord.Enqueue((Date.Now - User.PingPending(Unique)).TotalMilliseconds / 2) - If User.PingRecord.Count > 5 Then User.PingRecord.Dequeue() - User.PingPending.Remove(Unique) - End If - '返回请求 - If Stage > 0 AndAlso Stage < 3 Then RunInNewThread(Sub() - Try - SendUpdateRequest(User, Stage + 1, Unique) - Catch ex As Exception - Log(ex, "发送回程请求失败") - End Try - End Sub, "Link Update " & DisplayName) - '更新时间 - User.LastReceive = Date.Now - Case "disconnect" - '断开连接 - If Not UserList.ContainsKey(Id) Then Exit Sub - UserRemove(UserList(Id), ShowLeaveMessage:=JsonData("message") Is Nothing) - If JsonData("message") IsNot Nothing Then Hint(JsonData("message").ToString, If(JsonData("isError").ToObject(Of Boolean), HintType.Critical, HintType.Info)) - Case Else - Throw New Exception("未知的操作种类：" & Type) - End Select End Sub ''' ''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。 diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml.vb index 7d62918..38fd50f 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml.vb @@ -63,7 +63,7 @@ PageChangeRun(PageGet(ID)) PageID = ID Catch ex As Exception - Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Log(ex, "切换分页面失败（ID " & ID & "）", LogLevel.Feedback) Finally AniControlEnabled -= 1 End Try diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml index b586851..8142163 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml @@ -29,7 +29,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -104,312 +104,107 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -418,7 +213,7 @@ - + @@ -427,12 +222,12 @@ - + - + - + @@ -458,6 +253,8 @@ + + @@ -494,10 +291,18 @@ - - - + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb index 40afd2e..237bd2a 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb @@ -19,7 +19,7 @@ End Sub Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click - OpenWebsite("https://afdian.net/a/bangbang93") + OpenWebsite("https://afdian.com/a/bangbang93") End Sub Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click OpenWebsite("https://www.mcmod.cn") @@ -27,7 +27,7 @@ Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click ClipboardSet(UniqueAddress) End Sub - Private Sub DonateCodeInput() Handles BtnDonateInput.Click + Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click DonateCodeInput() End Sub diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb index d8c0a68..46a8bf4 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb @@ -1,4 +1,5 @@ Public Class PageOtherHelp + Implements IRefreshable #Region "初始化" @@ -79,31 +80,35 @@ End Try End Sub Public Shared Sub EnterHelpPage(Location As String) - RunInThread(Sub() - If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) - Dim Entry As New HelpEntry(Location) - RunInUi(Sub() - Dim FrmHelpDetail As New PageOtherHelpDetail - If FrmHelpDetail.Init(Entry) Then - FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) - Else - Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) - End If - End Sub) - End Sub) + RunInThread( + Sub() + If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) + Dim Entry As New HelpEntry(Location) + RunInUi( + Sub() + Dim FrmHelpDetail As New PageOtherHelpDetail + If FrmHelpDetail.Init(Entry) Then + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) + Else + Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) + End If + End Sub) + End Sub) End Sub Public Shared Sub EnterHelpPage(Entry As HelpEntry) - RunInThread(Sub() - If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) - RunInUi(Sub() - Dim FrmHelpDetail As New PageOtherHelpDetail - If FrmHelpDetail.Init(Entry) Then - FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) - Else - Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) - End If - End Sub) - End Sub) + RunInThread( + Sub() + If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) + RunInUi( + Sub() + Dim FrmHelpDetail As New PageOtherHelpDetail + If FrmHelpDetail.Init(Entry) Then + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) + Else + Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) + End If + End Sub) + End Sub) End Sub Public Shared Function GetHelpPage(Location As String) As PageOtherHelpDetail If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) @@ -122,14 +127,15 @@ If String.IsNullOrWhiteSpace(SearchBox.Text) Then '隐藏 AniStart({ - AaOpacity(PanSearch, -PanSearch.Opacity, 100), - AaCode(Sub() - PanSearch.Height = 0 - PanSearch.Visibility = Visibility.Collapsed - PanList.Visibility = Visibility.Visible - End Sub,, True), - AaOpacity(PanList, 1 - PanList.Opacity, 150, 30) - }, "FrmOtherHelp Search Switch") + AaOpacity(PanSearch, -PanSearch.Opacity, 100), + AaCode( + Sub() + PanSearch.Height = 0 + PanSearch.Visibility = Visibility.Collapsed + PanList.Visibility = Visibility.Visible + End Sub,, True), + AaOpacity(PanList, 1 - PanList.Opacity, 150, 30) + }, "FrmOtherHelp Search Switch") Else '构造请求 Dim QueryList As New List(Of SearchEntry(Of HelpEntry)) @@ -163,15 +169,19 @@ End If '显示 AniStart({ - AaOpacity(PanList, -PanList.Opacity, 100), - AaCode(Sub() - PanList.Visibility = Visibility.Collapsed - PanSearch.Visibility = Visibility.Visible - PanSearch.TriggerForceResize() - End Sub,, True), - AaOpacity(PanSearch, 1 - PanSearch.Opacity, 150, 30) - }, "FrmOtherHelp Search Switch") + AaOpacity(PanList, -PanList.Opacity, 100), + AaCode( + Sub() + PanList.Visibility = Visibility.Collapsed + PanSearch.Visibility = Visibility.Visible + PanSearch.TriggerForceResize() + End Sub,, True), + AaOpacity(PanSearch, 1 - PanSearch.Opacity, 150, 30) + }, "FrmOtherHelp Search Switch") End If End Sub + Public Sub Refresh() Implements IRefreshable.Refresh + PageOtherLeft.RefreshHelp() + End Sub End Class diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb index 79aecfd..fda05ce 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb @@ -1,6 +1,11 @@ Public Class PageOtherHelpDetail + Implements IRefreshable Public Entry As HelpEntry + Public Sub Refresh() Implements IRefreshable.Refresh + Init(New HelpEntry(Entry.RawPath)) + End Sub + Private Sub PageOtherHelpDetail_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded PanBack.ScrollToTop() End Sub diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml index 119a07c..874928f 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml @@ -15,9 +15,9 @@ LogoScale="0.98" Logo="M149.883623 873.911618c47.094581 47.094581 101.765247 83.95121 162.783444 109.75085 63.065787 26.618676 130.226755 40.337532 199.230553 40.337532 69.003799 0 136.164767-13.514097 199.230554-40.337532 61.018196-25.79964 115.688862-62.656269 162.783444-109.75085s83.95121-101.765247 109.75085-162.783444c26.618676-63.065787 40.337532-130.226755 40.337532-199.230554 0-69.003799-13.514097-136.164767-40.337532-199.230553-25.79964-61.018196-62.656269-115.688862-109.75085-162.783444-46.889822-46.889822-101.765247-83.95121-162.783444-109.75085C648.062388 13.514097 580.90142 0 511.89762 0s-136.164767 13.514097-199.230553 40.337532c-61.018196 25.79964-115.688862 62.656269-162.783444 109.75085s-83.95121 101.765247-109.75085 162.783444C13.514097 375.732853 0 442.893821 0 511.89762s13.514097 136.164767 40.337532 199.230554c25.594881 61.018196 62.656269 115.688862 109.546091 162.783444zM97.670066 511.89762c0-228.511098 185.921216-414.227554 414.227554-414.227554 228.511098 0 414.227554 185.921216 414.227555 414.227554S740.408718 926.125175 511.89762 926.125175c-228.511098 0-414.227554-185.716457-414.227554-414.227555z M539.130574 244.277544c-8.190362-4.709458-17.609278-7.371326-27.232954-7.371325-9.623675 0-19.042591 2.457109-27.232953 7.371325-16.790242 9.623675-27.232953 27.847231-27.232953 47.299341 0 30.09958 24.366327 54.465907 54.465906 54.465906 30.09958 0 54.465907-24.366327 54.465907-54.465906 0-19.45211-10.442711-37.470906-27.232953-47.299341zM566.363527 732.218356v-284.615077c0-30.09958-24.366327-54.465907-54.465907-54.465906-30.09958 0-54.465907 24.366327-54.465906 54.465906v284.615077c0 30.09958 24.366327 54.465907 54.465906 54.465907 30.09958 0 54.465907-24.366327 54.465907-54.465907z" /> - - diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb index 846e453..59df742 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb @@ -83,7 +83,7 @@ PageChangeRun(PageGet(ID)) PageID = ID Catch ex As Exception - Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Log(ex, "切换分页面失败（ID " & ID & "）", LogLevel.Feedback) Finally AniControlEnabled -= 1 End Try @@ -125,19 +125,29 @@ End Sub '打开网页 - Public Shared Sub TryFeedback() Handles ItemFeedback.Click + Private Sub TryFeedback(sender As Object, e As RouteEventArgs) Handles ItemFeedback.Changed + If Not ItemFeedback.Checked Then Exit Sub + TryFeedback() + e.Handled = True + End Sub + Public Shared Sub TryFeedback() If Not CanFeedback(True) Then Exit Sub - Select Case MyMsgBox("是否要打开反馈列表网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。", - "反馈提示", "提交新反馈", "查看反馈列表", "取消") + Select Case MyMsgBox("在提交新反馈前，建议先搜索反馈列表，以避免重复提交。" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。", + "反馈", "提交新反馈", "查看反馈列表", "取消") Case 1 Feedback(True, False) Case 2 OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/") End Select End Sub - Public Shared Sub TryVote() Handles ItemVote.Click + Private Sub TryVote(sender As Object, e As RouteEventArgs) Handles ItemVote.Changed + If Not ItemVote.Checked Then Exit Sub + TryVote() + e.Handled = True + End Sub + Public Shared Sub TryVote() If MyMsgBox("是否要打开新功能投票网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。", - "提醒", "打开", "取消") = 2 Then Exit Sub + "新功能投票", "打开", "取消") = 2 Then Exit Sub OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created") End Sub diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherTest.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherTest.xaml.vb index af35b45..041421a 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherTest.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherTest.xaml.vb @@ -12,7 +12,7 @@ Public Shared Sub MemoryOptimize(ShowHint As Boolean) If ShowHint Then Hint("为便于维护，开源内容中不包含百宝箱功能……") End Sub - Public Shared Sub MemoryOptimizeInternal() + Public Shared Sub MemoryOptimizeInternal(ShowHint As Boolean) End Sub Public Shared Function GetRandomCave() As String Return "为便于维护，开源内容中不包含百宝箱功能……" diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml index 97e9c54..2dfe903 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml @@ -9,7 +9,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb index 1ef40df..2b5177a 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb @@ -1,4 +1,5 @@ Public Class PageSelectLeft + Implements IRefreshable Private Sub PageSelectLeft_Initialized(sender As Object, e As EventArgs) Handles Me.Initialized AddHandler McFolderListLoader.PreviewFinish, Sub() If FrmSelectLeft IsNot Nothing Then RunInUiWait(AddressOf McFolderListUI) @@ -295,7 +296,7 @@ For i = 0 To Folders.Count - 1 If Folders(i) = "" Then Exit For If Folders(i).ToString.EndsWith(Folder.Path) Then - Name = Folders(i).ToString.Before(">") + Name = Folders(i).ToString.BeforeFirst(">") Folders.RemoveAt(i) Exit For End If @@ -347,8 +348,14 @@ End Sub Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs) Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag - WriteIni(Data.Path & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表 - If Data.Path = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + RefreshCurrent(Data.Path) + End Sub + Public Sub RefreshCurrent() Implements IRefreshable.Refresh + RefreshCurrent(PathMcFolder) + End Sub + Public Shared Sub RefreshCurrent(Folder As String) + WriteIni(Folder & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表 + If Folder = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") End Sub Public Sub Rename_Click(sender As Object, e As RoutedEventArgs) Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag diff --git a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb index 5b88927..f364869 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb @@ -167,14 +167,16 @@ ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) ToolTipService.SetVerticalOffset(BtnCont, 30) ToolTipService.SetHorizontalOffset(BtnCont, 2) - AddHandler BtnCont.Click, Sub() - PageVersionLeft.Version = Version - FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) - End Sub - AddHandler sender.MouseRightButtonUp, Sub() - PageVersionLeft.Version = Version - FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) - End Sub + AddHandler BtnCont.Click, + Sub() + PageVersionLeft.Version = Version + FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) + End Sub + AddHandler sender.MouseRightButtonUp, + Sub() + PageVersionLeft.Version = Version + FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) + End Sub sender.Buttons = {BtnStar, BtnDel, BtnCont} Else Dim BtnCont As New MyIconButton With {.LogoScale = 1.15, .Logo = Logo.IconButtonOpen} @@ -182,12 +184,8 @@ ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) ToolTipService.SetVerticalOffset(BtnCont, 30) ToolTipService.SetHorizontalOffset(BtnCont, 2) - AddHandler BtnCont.Click, Sub() - PageVersionOverall.OpenVersionFolder(Version) - End Sub - AddHandler sender.MouseRightButtonUp, Sub() - PageVersionOverall.OpenVersionFolder(Version) - End Sub + AddHandler BtnCont.Click, Sub() PageVersionOverall.OpenVersionFolder(Version) + AddHandler sender.MouseRightButtonUp, Sub() PageVersionOverall.OpenVersionFolder(Version) sender.Buttons = {BtnStar, BtnDel, BtnCont} End If End Sub diff --git a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb index 31025f3..6dbe50c 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb @@ -9,6 +9,8 @@ ''' Private ReadOnly SetupDict As New Dictionary(Of String, SetupEntry) From { {"Identify", New SetupEntry("", Source:=SetupSource.Registry)}, + {"WindowHeight", New SetupEntry(550)}, + {"WindowWidth", New SetupEntry(900)}, {"HintDownloadThread", New SetupEntry(False, Source:=SetupSource.Registry)}, {"HintNotice", New SetupEntry(0, Source:=SetupSource.Registry)}, {"HintDownload", New SetupEntry(0, Source:=SetupSource.Registry)}, @@ -42,6 +44,12 @@ {"CacheMsProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, {"CacheMsUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, {"CacheMsName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"CacheMsV2Migrated", New SetupEntry(False, Source:=SetupSource.Registry)}, + {"CacheMsV2OAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"CacheMsV2Access", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"CacheMsV2ProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"CacheMsV2Uuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, + {"CacheMsV2Name", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, {"CacheNideAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, {"CacheNideClient", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, {"CacheNideUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)}, @@ -86,7 +94,7 @@ {"LaunchArgumentWindowHeight", New SetupEntry(480)}, {"LaunchArgumentWindowType", New SetupEntry(1)}, {"LaunchArgumentRam", New SetupEntry(False, Source:=SetupSource.Registry)}, - {"LaunchAdvanceJvm", New SetupEntry("-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")}, + {"LaunchAdvanceJvm", New SetupEntry("-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")}, {"LaunchAdvanceGame", New SetupEntry("")}, {"LaunchAdvanceRun", New SetupEntry("")}, {"LaunchAdvanceRunWait", New SetupEntry(True)}, @@ -105,9 +113,10 @@ {"ToolDownloadSpeed", New SetupEntry(42, Source:=SetupSource.Registry)}, {"ToolDownloadVersion", New SetupEntry(0, Source:=SetupSource.Registry)}, {"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)}, - {"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)}, - {"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)}, + {"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)}, + {"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)}, + {"ToolModLocalNameStyle", New SetupEntry(0, Source:=SetupSource.Registry)}, {"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)}, @@ -144,6 +153,7 @@ {"UiHiddenPageSetup", New SetupEntry(False)}, {"UiHiddenPageOther", New SetupEntry(False)}, {"UiHiddenFunctionSelect", New SetupEntry(False)}, + {"UiHiddenFunctionModUpdate", New SetupEntry(False)}, {"UiHiddenFunctionHidden", New SetupEntry(False)}, {"UiHiddenSetupLaunch", New SetupEntry(False)}, {"UiHiddenSetupUi", New SetupEntry(False)}, @@ -193,15 +203,19 @@ '加载状态：0/未读取 1/已读取未处理 2/已处理 Public State As Byte = 0 - Public Type + Public Type As Type Public Sub New(Value, Optional Source = SetupSource.Normal, Optional Encoded = False) - Me.DefaultValue = Value - Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value) - Me.Encoded = Encoded - Me.Value = Value - Me.Source = Source - Type = If(Value, New Object).GetType + Try + Me.DefaultValue = Value + Me.Encoded = Encoded + Me.Value = Value + Me.Source = Source + Me.Type = If(Value, New Object).GetType + Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value) + Catch ex As Exception + Log(ex, "初始化 SetupEntry 失败", LogLevel.Feedback) '#5095 的 fallback + End Try End Sub End Class @@ -303,6 +317,12 @@ Dim E As SetupEntry = SetupDict(Key) [Set](Key, E.DefaultValue, E, ForceReload, Version) End Sub + ''' + ''' 获取某个设置项的默认值。 + ''' + Public Function GetDefault(Key As String) As String + Return SetupDict(Key).DefaultValue + End Function Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion) Try @@ -591,7 +611,7 @@ FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible End If Try - FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png") + FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png" Catch ex As Exception FrmMain.ImageTitleLogo.Source = Nothing Log(ex, "显示标题栏图片失败", LogLevel.Msgbox) @@ -623,6 +643,9 @@ Public Sub UiHiddenFunctionSelect(Value As Boolean) PageSetupUI.HiddenRefresh() End Sub + Public Sub UiHiddenFunctionModUpdate(Value As Boolean) + PageSetupUI.HiddenRefresh() + End Sub Public Sub UiHiddenFunctionHidden(Value As Boolean) PageSetupUI.HiddenRefresh() End Sub diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml index a1957fe..8b692a4 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -7,54 +7,7 @@ PanScroll="{Binding ElementName=PanBack}"> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + @@ -217,10 +170,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -232,14 +232,19 @@ - - + + + + + ToolTip="在 MC 启动前执行特定命令或程序，语法与 Windows 的命令提示符一致。 可以使用以下替换标记实现相对路径（路径均以 \ 结尾）： · {path}：PCL 的 exe 文件所在的文件夹 · {minecraft}：.minecraft 文件夹 · {verpath}：版本文件夹（.minecraft\versions\版本名\） · {verindie}：开启版本隔离时等同版本文件夹，未开启时等同 .minecraft 文件夹 · {java}：游戏运行时的 Java 文件夹 除此之外，也支持以下替换标记： · {user}：玩家名字 · {login}：玩家的登录方式 · {uuid}：玩家的 UUID · {name}：游戏版本名 · {date}、{time}：当前的系统时间 · {version}：游戏对应的原版版本号 例如： · "{verpath}test.exe" ：运行版本文件夹下的 test.exe 程序 · "{java}java.exe" -jar "{verpath}test.jar" ：用 Java 运行版本文件夹下的 test.jar · notepad "{verindie}options.txt" ：使用记事本打开该版本的设置文件 涉及路径的操作最好都打上双引号，以避免路径中的空格导致运行失败。 执行命令时，命令行所在的目录是当前的 .minecraft 文件夹。" /> diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb index fe721e6..a30267b 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb @@ -214,7 +214,7 @@ If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "") LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB" LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB" - LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit() AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed) + LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit() AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed) If ShowAnim Then '宽度动画 AniStart({ @@ -321,6 +321,11 @@ ''' 获取当前设置的 RAM 值。单位为 GB。 ''' Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double + + '------------------------------------------ + ' 修改下方代码时需要一并修改 PageVersionSetup + '------------------------------------------ + Dim RamGive As Double If Setup.Get("LaunchRamType") = 0 Then '自动配置 @@ -507,7 +512,7 @@ PreFin: #End Region -#Region "启动参数" +#Region "其他选项" Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged If ComboArgumentWindowType Is Nothing Then Exit Sub @@ -545,6 +550,21 @@ PreFin: End If End Sub + '版本隔离警告 + Private IsReverting As Boolean = False + Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + If IsReverting Then Exit Sub + If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf & + "如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf & + "如果你不会迁移存档，不建议修改这项设置！", + "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then + IsReverting = True + ComboArgumentIndie.SelectedItem = e.RemovedItems(0) + IsReverting = False + End If + End Sub + #End Region #Region "高级设置" @@ -553,6 +573,15 @@ PreFin: CheckAdvanceRunWait.Visibility = If(TextAdvanceRun.Text = "", Visibility.Collapsed, Visibility.Visible) End Sub + 'JVM 参数重设 + Private Sub TextAdvanceJvm_TextChanged() Handles TextAdvanceJvm.ValidatedTextChanged + BtnAdvanceJvmReset.Visibility = If(TextAdvanceJvm.Text = Setup.GetDefault("LaunchAdvanceJvm"), Visibility.Hidden, Visibility.Visible) + End Sub + Private Sub BtnAdvanceJvmReset_Click(sender As Object, e As EventArgs) Handles BtnAdvanceJvmReset.Click + Setup.Reset("LaunchAdvanceJvm") + Reload() + End Sub + #End Region End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb index 1787316..9c98d0b 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb @@ -115,7 +115,7 @@ PageID = ID Catch ex As Exception - Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Log(ex, "切换分页面失败（ID " & ID & "）", LogLevel.Feedback) Finally AniControlEnabled -= 1 End Try diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml index 325c1f6..bf1c1da 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml @@ -7,9 +7,43 @@ PanScroll="{Binding ElementName=PanBack}"> - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -20,45 +54,32 @@ - - - - - - + + - - - - - + + + + + - + + ToolTip="下载 Mod 时，Mod 的默认文件名中，中文译名应该放在哪个位置"> - - - - - - - - - + + + + + + @@ -93,7 +114,8 @@ - + + @@ -116,15 +138,23 @@ - + - - + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb index 5156d1f..fc00a3d 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb @@ -1,33 +1,5 @@ Class PageSetupSystem -#Region "语言" - 'Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded - ' AniControlEnabled -= 1 - - ' '读取设置 - ' Select Case Lang - ' Case "zh_CN" - ' ComboLang.SelectedIndex = 0 - ' Case "zh_HK" - ' ComboLang.SelectedIndex = 1 - ' Case "en_US" - ' ComboLang.SelectedIndex = 2 - ' End Select - ' CheckDebug.Checked = ReadReg("SystemDebugMode", "False") - - ' AniControlEnabled += 1 - 'End Sub - - 'Private Sub RefreshLang() Handles ComboLang.SelectionChanged - ' If IsLoaded Then - ' If Not ComboLang.IsLoaded Then Exit Sub - ' Lang = CType(ComboLang.SelectedItem, MyComboBoxItem).Tag - ' Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Url("Languages\" & Lang & ".xaml", UrlKind.Relative)} - ' WriteReg("Lang", Lang) - ' End If - 'End Sub -#End Region - Private Shadows IsLoaded As Boolean = False Private Sub PageSetupSystem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded @@ -35,7 +7,10 @@ '重复加载部分 PanBack.ScrollToHome() -#If Not BETA Then +#If BETA Then + PanDonate.Visibility = Visibility.Collapsed +#Else + PanDonate.Visibility = Visibility.Visible ItemSystemUpdateDownload.Content = "在有新版本时自动下载（更新快照版可能需要更新密钥）" #End If @@ -55,11 +30,14 @@ SliderDownloadThread.Value = Setup.Get("ToolDownloadThread") SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed") ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion") - ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate") - CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack") - CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert") + 'Mod 与整合包 + ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate") + ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod") + ComboModLocalNameStyle.SelectedIndex = Setup.Get("ToolModLocalNameStyle") + CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") + 'Minecraft 更新提示 CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease") CheckUpdateSnapshot.Checked = Setup.Get("ToolUpdateSnapshot") @@ -87,9 +65,10 @@ Setup.Reset("ToolDownloadSpeed") Setup.Reset("ToolDownloadVersion") Setup.Reset("ToolDownloadTranslate") - Setup.Reset("ToolDownloadKeepModpack") Setup.Reset("ToolDownloadIgnoreQuilt") Setup.Reset("ToolDownloadCert") + Setup.Reset("ToolDownloadMod") + Setup.Reset("ToolModLocalNameStyle") Setup.Reset("ToolUpdateRelease") Setup.Reset("ToolUpdateSnapshot") Setup.Reset("ToolHelpChinese") @@ -111,13 +90,13 @@ End Sub '将控件改变路由到设置改变 - Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadKeepModpack.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) End Sub Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) End Sub - Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadMod.SelectionChanged If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) End Sub Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged @@ -165,26 +144,24 @@ End Sub '自动更新 - Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged + Private Sub ComboSystemActivity_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged If AniControlEnabled <> 0 Then Exit Sub - If ComboSystemActivity.SelectedIndex = 2 Then - If MyMsgBox("若选择此项，即使在将来出现严重问题时，你也无法获取相关通知。" & vbCrLf & - "例如，如果发现某个版本游戏存在严重 Bug，你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf & - "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf & - "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then - ComboSystemActivity.SelectedItem = e.RemovedItems(0) - End If + If ComboSystemActivity.SelectedIndex <> 2 Then Exit Sub + If MyMsgBox("若选择此项，即使在将来出现严重问题时，你也无法获取相关通知。" & vbCrLf & + "例如，如果发现某个版本游戏存在严重 Bug，你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf & + "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf & + "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then + ComboSystemActivity.SelectedItem = e.RemovedItems(0) End If End Sub - Private Sub ComboSystemUpdate_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged + Private Sub ComboSystemUpdate_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged If AniControlEnabled <> 0 Then Exit Sub - If ComboSystemUpdate.SelectedIndex = 3 Then - If MyMsgBox("若选择此项，即使在启动器将来出现严重问题时，你也无法获取更新并获得修复。" & vbCrLf & - "例如，如果官方修改了登录方式，从而导致现有启动器无法登录，你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf & - "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf & - "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then - ComboSystemUpdate.SelectedItem = e.RemovedItems(0) - End If + If ComboSystemUpdate.SelectedIndex <> 3 Then Exit Sub + If MyMsgBox("若选择此项，即使在启动器将来出现严重问题时，你也无法获取更新并获得修复。" & vbCrLf & + "例如，如果官方修改了登录方式，从而导致现有启动器无法登录，你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf & + "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf & + "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then + ComboSystemUpdate.SelectedItem = e.RemovedItems(0) End If End Sub Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click @@ -212,4 +189,15 @@ End Try End Function +#Region "导出 / 导入设置" + + Private Sub BtnSystemSettingExp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingExp.Click + Hint("该功能尚在开发中！") + End Sub + Private Sub BtnSystemSettingImp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingImp.Click + Hint("该功能尚在开发中！") + End Sub + +#End Region + End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml index 7f6436b..0e2f912 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml @@ -72,10 +72,10 @@ - + - - + + @@ -225,6 +225,7 @@ + @@ -242,6 +243,12 @@ + + + + + + @@ -285,8 +292,9 @@ - - + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb index 74d1cd2..f48e8ea 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb @@ -25,14 +25,15 @@ Next End If + AniControlEnabled += 1 + Reload() '#4826，在每次进入页面时都刷新一下 + AniControlEnabled -= 1 + '非重复加载部分 If IsLoaded Then Exit Sub IsLoaded = True - AniControlEnabled += 1 SliderLoad() - Reload() - AniControlEnabled -= 1 #If BETA Then PanLauncherHide.Visibility = Visibility.Visible @@ -97,6 +98,7 @@ CheckHiddenPageSetup.Checked = Setup.Get("UiHiddenPageSetup") CheckHiddenPageOther.Checked = Setup.Get("UiHiddenPageOther") CheckHiddenFunctionSelect.Checked = Setup.Get("UiHiddenFunctionSelect") + CheckHiddenFunctionModUpdate.Checked = Setup.Get("UiHiddenFunctionModUpdate") CheckHiddenFunctionHidden.Checked = Setup.Get("UiHiddenFunctionHidden") CheckHiddenSetupLaunch.Checked = Setup.Get("UiHiddenSetupLaunch") CheckHiddenSetupUI.Checked = Setup.Get("UiHiddenSetupUi") @@ -147,6 +149,7 @@ Setup.Reset("UiHiddenPageSetup") Setup.Reset("UiHiddenPageOther") Setup.Reset("UiHiddenFunctionSelect") + Setup.Reset("UiHiddenFunctionModUpdate") Setup.Reset("UiHiddenFunctionHidden") Setup.Reset("UiHiddenSetupLaunch") Setup.Reset("UiHiddenSetupUi") @@ -174,7 +177,7 @@ Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboBackgroundSuit.SelectionChanged, ComboCustomPreset.SelectionChanged If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) End Sub - Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenFunctionModUpdate.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) End Sub Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLogoText.ValidatedTextChanged, TextCustomNet.ValidatedTextChanged @@ -269,17 +272,16 @@ End Try End Sub - '顶部栏 Private Sub BtnLogoChange_Click(sender As Object, e As EventArgs) Handles BtnLogoChange.Click - Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片") + Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp)|*.png;*.jpg;*.gif;*.webp", "选择图片") If FileName = "" Then Exit Sub Try '拷贝文件 File.Delete(Path & "PCL\Logo.png") CopyFile(FileName, Path & "PCL\Logo.png") '设置当前显示 - FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png") + FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png" Catch ex As Exception If ex.Message.Contains("参数无效") Then Log("改变标题栏图片失败，该图片文件可能并非标准格式。" & vbCrLf & @@ -296,7 +298,7 @@ Refresh: '已有图片则不再选择 If File.Exists(Path & "PCL\Logo.png") Then Try - FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png") + FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png" Catch ex As Exception If ex.Message.Contains("参数无效") Then Log("调整标题栏图片失败，该图片文件可能并非标准格式。" & vbCrLf & @@ -315,7 +317,7 @@ Refresh: Exit Sub End If '没有图片则要求选择 - Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片") + Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp)|*.png;*.jpg;*.gif;*.webp", "选择图片") If FileName = "" Then FrmMain.ImageTitleLogo.Source = Nothing e.Handled = True @@ -364,27 +366,28 @@ Refresh: End Sub Private Sub BtnMusicClear_Click(sender As Object, e As EventArgs) Handles BtnMusicClear.Click If MyMsgBox("即将删除背景音乐文件夹中的所有文件。" & vbCrLf & "此操作不可撤销，是否确定？", "警告",, "取消", IsWarn:=True) = 1 Then - RunInThread(Sub() - Hint("正在删除背景音乐……") - '停止播放音乐 - MusicNAudio = Nothing - MusicWaitingList = New List(Of String) - MusicAllList = New List(Of String) - Thread.Sleep(200) - '删除文件 - Try - DeleteDirectory(Path & "PCL\Musics") - Hint("背景音乐已删除！", HintType.Finish) - Catch ex As Exception - Log(ex, "删除背景音乐失败", LogLevel.Msgbox) - End Try - Try - Directory.CreateDirectory(Path & "PCL\Musics") - RunInUi(Sub() MusicRefreshPlay(False)) - Catch ex As Exception - Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox) - End Try - End Sub) + RunInThread( + Sub() + Hint("正在删除背景音乐……") + '停止播放音乐 + MusicNAudio = Nothing + MusicWaitingList = New List(Of String) + MusicAllList = New List(Of String) + Thread.Sleep(200) + '删除文件 + Try + DeleteDirectory(Path & "PCL\Musics") + Hint("背景音乐已删除！", HintType.Finish) + Catch ex As Exception + Log(ex, "删除背景音乐失败", LogLevel.Msgbox) + End Try + Try + Directory.CreateDirectory(Path & "PCL\Musics") + RunInUi(Sub() MusicRefreshPlay(False)) + Catch ex As Exception + Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox) + End Try + End Sub) End If End Sub Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change @@ -427,9 +430,9 @@ Refresh: RadioLauncherTheme5Gray.Opacity -= 0.23 RadioLauncherTheme5.Opacity += 0.23 AniStart({ - AaOpacity(RadioLauncherTheme5Gray, 1, 1000), - AaOpacity(RadioLauncherTheme5, -1, 1000) - }, "ThemeUnlock") + AaOpacity(RadioLauncherTheme5Gray, 1, 1000 * AniSpeed), + AaOpacity(RadioLauncherTheme5, -1, 1000 * AniSpeed) + }, "ThemeUnlock") If RadioLauncherTheme5Gray.Opacity < 0.08 Then ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁！") AniStop("ThemeUnlock") @@ -437,7 +440,7 @@ Refresh: End If End Sub Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp - If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse LabLauncherTheme11Click.ToolTip.ToString.Contains("点击") Then + If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then If MyMsgBox( "1. 不爬取或攻击相关服务或网站，不盗取相关账号，没有谜题可以或需要以此来解决。" & vbCrLf & "2. 不得篡改或损毁相关公开信息，请尽量让它们保持原状。" & vbCrLf & @@ -449,10 +452,10 @@ Refresh: End If End If End Sub - Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp - OpenWebsite("https://afdian.net/a/LTCat") + Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp, RadioLauncherTheme8.MouseRightButtonUp + OpenWebsite("https://afdian.com/a/LTCat") End Sub - Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp + Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp, RadioLauncherTheme9.MouseRightButtonUp PageOtherLeft.TryFeedback() End Sub @@ -661,49 +664,39 @@ Refresh: #End Region - '公开预览版 + '赞助 Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click - OpenWebsite("https://afdian.net/a/LTCat") + OpenWebsite("https://afdian.com/a/LTCat") End Sub '滑动条 Private Sub SliderLoad() - SliderMusicVolume.GetHintText = Function(Value As Integer) - Return Math.Ceiling(Value * 0.1) & "%" - End Function - SliderLauncherOpacity.GetHintText = Function(Value As Integer) - Return Math.Round(40 + Value * 0.1) & "%" - End Function - SliderLauncherHue.GetHintText = Function(Value As Integer) - Return Value & "°" - End Function - SliderLauncherSat.GetHintText = Function(Value As Integer) - Return Value & "%" - End Function - SliderLauncherDelta.GetHintText = Function(Value As Integer) - If Value > 90 Then - Return "+" & (Value - 90) - ElseIf Value = 90 Then - Return 0 - Else - Return Value - 90 - End If - End Function - SliderLauncherLight.GetHintText = Function(Value As Integer) - If Value > 20 Then - Return "+" & (Value - 20) - ElseIf Value = 20 Then - Return 0 - Else - Return Value - 20 - End If - End Function - SliderBackgroundOpacity.GetHintText = Function(Value As Integer) - Return Math.Round(Value * 0.1) & "%" - End Function - SliderBackgroundBlur.GetHintText = Function(Value As Integer) - Return Value & " 像素" - End Function + SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%" + SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%" + SliderLauncherHue.GetHintText = Function(v) v & "°" + SliderLauncherSat.GetHintText = Function(v) v & "%" + SliderLauncherDelta.GetHintText = + Function(Value As Integer) + If Value > 90 Then + Return "+" & (Value - 90) + ElseIf Value = 90 Then + Return 0 + Else + Return Value - 90 + End If + End Function + SliderLauncherLight.GetHintText = + Function(Value As Integer) + If Value > 20 Then + Return "+" & (Value - 20) + ElseIf Value = 20 Then + Return 0 + Else + Return Value - 20 + End If + End Function + SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%" + SliderBackgroundBlur.GetHintText = Function(v) v & " 像素" End Sub End Class diff --git a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb index 18c7270..b8c81b0 100644 --- a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb @@ -60,11 +60,9 @@ Public Class PageSpeedLeft End Try If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub Try - SyncLock LoaderTaskbarLock - For Each Loader In LoaderTaskbar.ToList - TaskRefresh(Loader) - Next - End SyncLock + For Each Loader In LoaderTaskbar.ToList + TaskRefresh(Loader) + Next Catch ex As Exception Log(ex, "下载管理右栏监视出错", LogLevel.Feedback) End Try @@ -94,15 +92,12 @@ Public Class PageSpeedLeft Card.Children.Add(GetObjectFromXML("")) Dim Tb As TextBlock = GetObjectFromXML("") Tb.Text = GetExceptionDetail(Loader.Error) - AddHandler Tb.MouseLeftButtonDown, Sub(sender As TextBlock, e As EventArgs) - ClipboardSet(sender.Text, False) - Hint("已复制错误详情！", HintType.Finish) - End Sub + AddHandler Tb.MouseLeftButtonDown, + Sub(sender As TextBlock, e As EventArgs) + ClipboardSet(sender.Text, False) + Hint("已复制错误详情！", HintType.Finish) + End Sub Card.Children.Add(Tb) - ''删除取消按钮 - 'For Each Element As FrameworkElement In CType(Card.Parent, Panel).Children - ' If Element.Name = "BtnCancel" Then AniDispose(CType(Element, MyIconButton), True) - 'Next #End Region Case LoadState.Finished #Region "完成，销毁卡片并返回" @@ -198,11 +193,8 @@ Public Class PageSpeedLeft AniDispose(sender, False) AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) RightCards.Remove(Loader.Name) - SyncLock LoaderTaskbarLock - LoaderTaskbar.Remove(Loader) - Log($"[Taskbar] 由于下载管理卡片关闭，{Loader.Name} 已移出任务列表") - End SyncLock - Log($"[Watcher] 关闭下载管理卡片：{Loader.Name}") + LoaderTaskbar.Remove(Loader) + Log($"[Taskbar] 关闭下载管理卡片：{Loader.Name}，且移出任务列表") RunInThread(Sub() Loader.Abort()) End Sub '如果已经失败，再刷新一次，修改成失败的控件 diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb index 5a521b3..30742bc 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb @@ -64,7 +64,7 @@ PageChangeRun(PageGet(ID)) PageID = ID Catch ex As Exception - Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Log(ex, "切换分页面失败（ID " & ID & "）", LogLevel.Feedback) Finally AniControlEnabled -= 1 End Try @@ -91,17 +91,7 @@ #End Region Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 - '强制刷新 - Try - CompProjectCache.Clear() - File.Delete(PathTemp & "Cache\LocalMod.json") - Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存") - Catch ex As Exception - Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") - End Try - If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '无需 Else，还没加载刷个鬼的新 - ItemMod.Checked = True - Hint("正在刷新……", Log:=False) + PageVersionMod.Refresh() End Sub Public Sub Reset(sender As Object, e As EventArgs) diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml index 1915d09..d00296d 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml @@ -16,24 +16,42 @@ + - - - - + + + + + - - + + + + + + + + + - + - - + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb index c909f09..459a65b 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb @@ -1,4 +1,5 @@ Public Class PageVersionMod + Implements IRefreshable #Region "初始化" @@ -8,7 +9,7 @@ If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome() AniControlEnabled += 1 SelectedMods.Clear() - RefreshList() + ReloadModList() ChangeAllSelected(False) AniControlEnabled -= 1 @@ -16,6 +17,11 @@ If IsLoad Then Exit Sub IsLoad = True + '调整按钮边距（这玩意儿没法从 XAML 改） + For Each Btn As MyRadioButton In PanFilter.Children + Btn.LabText.Margin = New Thickness(-2, 0, 8, 0) + Next + #If DEBUG Then BtnManageCheck.Visibility = Visibility.Visible #End If @@ -24,22 +30,44 @@ ''' ''' 刷新 Mod 列表。 ''' - Public Sub RefreshList(Optional ForceReload As Boolean = False) - If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then + Public Sub ReloadModList(Optional ForceReload As Boolean = False) + If LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Log("[System] 已刷新 Mod 列表") + Filter = FilterType.All PanBack.ScrollToHome() SearchBox.Text = "" End If End Sub + '强制刷新 + Private Sub RefreshSelf() Implements IRefreshable.Refresh + Refresh() + End Sub + Public Shared Sub Refresh() + '强制刷新 + Try + CompProjectCache.Clear() + CompFilesCache.Clear() + File.Delete(PathTemp & "Cache\LocalMod.json") + Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存") + Catch ex As Exception + Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") + End Try + If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新 + FrmVersionLeft.ItemMod.Checked = True + Hint("正在刷新……", Log:=False) + End Sub Private Sub LoaderInit() Handles Me.Initialized PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McModLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False) End Sub Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click If McModLoader.State = LoadState.Failed Then - LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.ForceRun) + LoaderRun(LoaderFolderRunType.ForceRun) End If End Sub + Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean + Return LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", Type) + End Function #End Region @@ -53,10 +81,9 @@ ''' 将加载器结果的 Mod 列表加载为 UI。 ''' Private Sub LoadUIFromLoaderOutput() - Dim Mods As List(Of McMod) = McModLoader.Output Try '判断应该显示哪一个页面 - If Mods.Any() Then + If McModLoader.Output.Any() Then PanBack.Visibility = Visibility.Visible PanEmpty.Visibility = Visibility.Collapsed Else @@ -64,13 +91,15 @@ PanBack.Visibility = Visibility.Collapsed Exit Sub End If - '输出结果 + '修改缓存 ModItems.Clear() - For Each ModEntity As McMod In Mods + For Each ModEntity As McMod In McModLoader.Output ModItems(ModEntity.RawFileName) = McModListItem(ModEntity) Next + '显示结果 + Filter = FilterType.All SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频 - RefreshResult(Mods) + RefreshUI() Catch ex As Exception Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback) End Try @@ -114,7 +143,7 @@ ToolTipService.SetVerticalOffset(BtnED, 30) ToolTipService.SetHorizontalOffset(BtnED, 2) AddHandler BtnED.Click, AddressOf ED_Click - If sender.Entry.State = McMod.McModState.Unavaliable Then + If sender.Entry.State = McMod.McModState.Unavailable Then sender.Buttons = {BtnCont, BtnOpen, BtnDelete} Else sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete} @@ -122,38 +151,134 @@ End Sub ''' - ''' 刷新结果显示。 + ''' 刷新整个 UI。 ''' - Private Sub RefreshResult(Mods As List(Of McMod)) - PanList.Children.Clear() - For Each TargetMod In Mods - PanList.Children.Add(ModItems(TargetMod.RawFileName)) - Next - RefreshTitle() - End Sub - ''' - ''' 刷新卡片标题。 - ''' - Private Sub RefreshTitle() - Dim Mods = PanList.Children.Cast(Of MyLocalModItem).Select(Function(i) i.Entry).ToList - Dim Counter = {0, 0, 0} - For Each ModEntity As McMod In Mods - Counter(ModEntity.State) += 1 - Next - Dim TypeList As New List(Of String) - If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled)) - If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable)) - If Counter(McMod.McModState.Fine) > 0 Then TypeList.Insert(0, If(TypeList.Any, "启用 ", "") & Counter(McMod.McModState.Fine)) - If Not IsSearching Then - PanListBack.Title = "Mod 列表 (" & Join(TypeList, "，") & ")" - ElseIf TypeList.Any() Then - PanListBack.Title = "搜索结果 (" & Join(TypeList, "，") & ")" + Public Sub RefreshUI() + If PanList Is Nothing Then Exit Sub + Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod))).Where(Function(m) CanPassFilter(m)).ToList + '重新列出列表 + AniControlEnabled += 1 + If ShowingMods.Any() Then + PanList.Visibility = Visibility.Visible + PanList.Children.Clear() + For Each TargetMod In ShowingMods + Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName) + Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态 + PanList.Children.Add(Item) + Next Else - PanListBack.Title = "无搜索结果" + PanList.Visibility = Visibility.Collapsed End If - PanList.Visibility = If(Mods.Any(), Visibility.Visible, Visibility.Collapsed) + AniControlEnabled -= 1 + SelectedMods = SelectedMods.Where(Function(m) ShowingMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod + RefreshBars() End Sub + ''' + ''' 刷新顶栏和底栏显示。 + ''' + Public Sub RefreshBars() + '----------------- + ' 顶部栏 + '----------------- + + '计数 + Dim AnyCount As Integer = 0 + Dim EnabledCount As Integer = 0 + Dim DisabledCount As Integer = 0 + Dim UpdateCount As Integer = 0 + Dim UnavalialeCount As Integer = 0 + For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod))) + AnyCount += 1 + If ModItem.CanUpdate Then UpdateCount += 1 + If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1 + If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1 + If ModItem.State.Equals(McMod.McModState.Unavailable) Then UnavalialeCount += 1 + Next + '显示 + BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})" + BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})" + BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse UpdateCount > 0, Visibility.Visible, Visibility.Collapsed) + BtnFilterEnabled.Text = $"启用 ({EnabledCount})" + BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed) + BtnFilterDisabled.Text = $"禁用 ({DisabledCount})" + BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed) + BtnFilterError.Text = $"错误 ({UnavalialeCount})" + BtnFilterError.Visibility = If(Filter = FilterType.Unavailable OrElse UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed) + + '----------------- + ' 底部栏 + '----------------- + + '计数 + Dim NewCount As Integer = SelectedMods.Count + Dim Selected = NewCount > 0 + If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字 + '按钮可用性 + If Selected Then + Dim HasUpdate As Boolean = False + Dim HasEnabled As Boolean = False + Dim HasDisabled As Boolean = False + For Each ModEntity In McModLoader.Output + If SelectedMods.Contains(ModEntity.RawFileName) Then + If ModEntity.CanUpdate Then HasUpdate = True + If ModEntity.State = McMod.McModState.Fine Then + HasEnabled = True + ElseIf ModEntity.State = McMod.McModState.Disabled Then + HasDisabled = True + End If + End If + Next + BtnSelectDisable.IsEnabled = HasEnabled + BtnSelectEnable.IsEnabled = HasDisabled + BtnSelectUpdate.IsEnabled = HasUpdate + End If + '更新显示状态 + If AniControlEnabled = 0 Then + PanListBack.Margin = New Thickness(0, 0, 0, If(Selected, 95, 15)) + If Selected Then + '仅在数量增加时播放出现/跳跃动画 + If BottomBarShownCount >= NewCount Then + BottomBarShownCount = NewCount + Return + Else + BottomBarShownCount = NewCount + End If + '出现/跳跃动画 + CardSelect.Visibility = Visibility.Visible + AniStart({ + AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60), + AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)), + AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)), + AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)) + }, "Mod Sidebar") + Else + '不重复播放隐藏动画 + If BottomBarShownCount = 0 Then Return + BottomBarShownCount = 0 + '隐藏动画 + AniStart({ + AaOpacity(CardSelect, -CardSelect.Opacity, 90), + AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)), + AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True) + }, "Mod Sidebar") + End If + Else + AniStop("Mod Sidebar") + BottomBarShownCount = NewCount + If Selected Then + CardSelect.Visibility = Visibility.Visible + CardSelect.Opacity = 1 + TransSelect.Y = -25 + Else + CardSelect.Visibility = Visibility.Collapsed + CardSelect.Opacity = 0 + TransSelect.Y = -10 + End If + End If + End Sub + Private BottomBarShownCount As Integer = 0 + #End Region #Region "管理" @@ -192,18 +317,71 @@ ''' 全选。 ''' Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click - If SelectedMods.Count < PanList.Children.Count Then - ChangeAllSelected(True) - Else - ChangeAllSelected(False) - End If + ChangeAllSelected(SelectedMods.Count < PanList.Children.Count) End Sub ''' ''' 安装 Mod。 ''' - Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click - Hint("将 Mod 文件直接拖入 PCL 窗口即可安装！") + Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click, BtnHintInstall.Click + Dim FileList = SelectFiles("Mod 文件(*.jar;*.litemod;*.disabled;*.old)|*.jar;*.litemod;*.disabled;*.old", "选择要安装的 Mod") + If Not FileList.Any Then Return + InstallMods(FileList) + End Sub + ''' + ''' 尝试安装 Mod。 + ''' 返回输入的文件是否为一个 Mod 文件，仅用于判断拖拽行为。 + ''' + Public Shared Function InstallMods(FilePathList As IEnumerable(Of String)) As Boolean + Dim Extension As String = FilePathList.First.AfterLast(".").ToLower + '检查文件扩展名 + If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False + Log("[System] 文件为 jar/litemod 格式，尝试作为 Mod 安装") + '检查回收站：回收站中的文件有错误的文件名 + If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then + Hint("请先将文件从回收站还原，再尝试安装！", HintType.Critical) + Return True + End If + '获取并检查目标版本 + Dim TargetVersion As McVersion = McVersionCurrent + If FrmMain.PageCurrent = FormMain.PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version + If FrmMain.PageCurrent = FormMain.PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then + '正在选择版本，或当前版本不能安装 Mod + Hint("若要安装 Mod，请先选择一个可以安装 Mod 的版本！") + ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod) Then + '未处于 Mod 管理页面 + If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}？", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install + Else + '处于 Mod 管理页面 +Install: + Try + For Each ModFile In FilePathList + Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "") + If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227 + CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName) + Next + If FilePathList.Count = 1 Then + Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}！", HintType.Finish) + Else + Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Finish) + End If + '刷新列表 + If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod Then + LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun) + End If + Catch ex As Exception + Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox) + End Try + End If + Return True + End Function + + ''' + ''' 下载 Mod。 + ''' + Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click + PageDownloadMod.TargetVersion = PageVersionLeft.Version '将当前版本设置为筛选器 + FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod) End Sub #End Region @@ -223,91 +401,21 @@ Else SelectedMods.Remove(SelectedKey) End If - '更新下边栏 UI - RefreshBottomBar() - End Sub - - '改变下边栏状态 - Private ShownCount As Integer = 0 - Private Sub RefreshBottomBar() - '计数 - Dim NewCount As Integer = SelectedMods.Count - Dim Selected = NewCount > 0 - If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字 - '按钮可用性 - If Selected Then - Dim HasUpdate As Boolean = False - Dim HasEnabled As Boolean = False - Dim HasDisabled As Boolean = False - For Each ModEntity In McModLoader.Output - If SelectedMods.Contains(ModEntity.RawFileName) Then - If ModEntity.CanUpdate Then HasUpdate = True - If ModEntity.State = McMod.McModState.Fine Then - HasEnabled = True - ElseIf ModEntity.State = McMod.McModState.Disabled Then - HasDisabled = True - End If - End If - Next - BtnSelectDisable.IsEnabled = HasEnabled - BtnSelectEnable.IsEnabled = HasDisabled - BtnSelectUpdate.IsEnabled = HasUpdate - End If - '更新显示状态 - If AniControlEnabled = 0 Then - If Selected Then - '仅在数量增加时播放出现/跳跃动画 - If ShownCount >= NewCount Then - ShownCount = NewCount - Return - Else - ShownCount = NewCount - End If - '出现/跳跃动画 - CardSelect.Visibility = Visibility.Visible - AniStart({ - AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60), - AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)), - AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)), - AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)) - }, "Mod Sidebar") - Else - '不重复播放隐藏动画 - If ShownCount = 0 Then Return - ShownCount = 0 - '隐藏动画 - AniStart({ - AaOpacity(CardSelect, -CardSelect.Opacity, 90), - AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)), - AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True) - }, "Mod Sidebar") - End If - Else - AniStop("Mod Sidebar") - ShownCount = NewCount - If Selected Then - CardSelect.Visibility = Visibility.Visible - CardSelect.Opacity = 1 - TransSelect.Y = -25 - Else - CardSelect.Visibility = Visibility.Collapsed - CardSelect.Opacity = 0 - TransSelect.Y = -10 - End If - End If + RefreshBars() End Sub '切换所有项的选择状态 Private Sub ChangeAllSelected(Value As Boolean) AniControlEnabled += 1 SelectedMods.Clear() - For Each Item As MyLocalModItem In PanList.Children - Item.Checked = Value - If Value Then SelectedMods.Add(Item.Entry.RawFileName) + For Each Item As MyLocalModItem In ModItems.Values + '#4992，Mod 从过滤器看可能不应在列表中，但因为刚切换状态所以依然保留在列表中，所以应该从列表 UI 判断，而非从过滤器判断 + Dim ShouldSelected As Boolean = Value AndAlso PanList.Children.Contains(Item) + Item.Checked = ShouldSelected + If ShouldSelected Then SelectedMods.Add(Item.Entry.RawFileName) Next AniControlEnabled -= 1 - '更新下边栏 UI - RefreshBottomBar() + RefreshBars() End Sub Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit Dim CacheAniControlEnabled = AniControlEnabled @@ -321,6 +429,67 @@ #End Region +#Region "筛选" + + Private _Filter As FilterType = FilterType.All + Private Property Filter As FilterType + Get + Return _Filter + End Get + Set(value As FilterType) + If _Filter = value Then Return + _Filter = value + Select Case value + Case FilterType.All + BtnFilterAll.Checked = True + Case FilterType.Enabled + BtnFilterEnabled.Checked = True + Case FilterType.Disabled + BtnFilterDisabled.Checked = True + Case FilterType.CanUpdate + BtnFilterCanUpdate.Checked = True + Case Else + BtnFilterError.Checked = True + End Select + RefreshUI() + End Set + End Property + Private Enum FilterType As Integer + All = 0 + Enabled = 1 + Disabled = 2 + CanUpdate = 3 + Unavailable = 4 + End Enum + + ''' + ''' 检查该 Mod 项是否符合当前筛选的类别。 + ''' + Private Function CanPassFilter(CheckingMod As McMod) As Boolean + Select Case Filter + Case FilterType.All + Return True + Case FilterType.Enabled + Return CheckingMod.State = McMod.McModState.Fine + Case FilterType.Disabled + Return CheckingMod.State = McMod.McModState.Disabled + Case FilterType.CanUpdate + Return CheckingMod.CanUpdate + Case FilterType.Unavailable + Return CheckingMod.State = McMod.McModState.Unavailable + Case Else + Return False + End Select + End Function + + '点击筛选项触发的改变 + Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check, BtnFilterError.Check + Filter = sender.Tag + RefreshUI() + End Sub + +#End Region + #Region "下边栏" '启用 / 禁用 @@ -362,7 +531,7 @@ FileSystem.Rename(ModEntity.Path, NewPath) Catch ex As FileNotFoundException Log(ex, $"未找到需要重命名的 Mod（{If(ModEntity.Path, "null")}）", LogLevel.Feedback) - RefreshList(True) + ReloadModList(True) Return Catch ex As Exception Log(ex, $"重命名 Mod 失败（{If(ModEntity.Path, "null")}）") @@ -371,9 +540,16 @@ '更改 Loader 中的列表 Dim NewModEntity As New McMod(NewPath) NewModEntity.FromJson(ModEntity.ToJson) - Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) - McModLoader.Output.RemoveAt(IndexOfLoader) - McModLoader.Output.Insert(IndexOfLoader, NewModEntity) + If McModLoader.Output.Contains(ModEntity) Then + Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) + McModLoader.Output.RemoveAt(IndexOfLoader) + McModLoader.Output.Insert(IndexOfLoader, NewModEntity) + End If + If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862 + Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity) + SearchResult.Remove(ModEntity) + SearchResult.Insert(IndexOfResult, NewModEntity) + End If '更改 UI 中的列表 Dim NewItem As MyLocalModItem = McModListItem(NewModEntity) ModItems(ModEntity.RawFileName) = NewItem @@ -382,18 +558,21 @@ PanList.Children.RemoveAt(IndexOfUi) PanList.Children.Insert(IndexOfUi, NewItem) Next - RefreshTitle() '改变数量显示 - If Not IsSuccessful Then - Hint("由于文件被占用，Mod 的状态切换失败，请尝试关闭正在运行的游戏后再试！", HintType.Critical) - RefreshList(True) + If IsSuccessful Then + RefreshBars() Else - RefreshBottomBar() + Hint("由于文件被占用，Mod 的状态切换失败，请尝试关闭正在运行的游戏后再试！", HintType.Critical) + ReloadModList(True) End If + LoaderRun(LoaderFolderRunType.UpdateOnly) End Sub '更新 Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click - UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate)) + Dim UpdateList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate).ToList() + If Not UpdateList.Any() Then Return + UpdateMods(UpdateList) + ChangeAllSelected(False) End Sub ''' ''' 记录正在进行 Mod 更新的 mods 文件夹路径。 @@ -401,8 +580,8 @@ Public Shared UpdatingVersions As New List(Of String) Public Sub UpdateMods(ModList As IEnumerable(Of McMod)) '更新前警告 - If Not Setup.Get("HintUpdateMod") Then - If MyMsgBox($"新版本 Mod 可能不兼容老版本的存档或者其他 Mod，这可能导致游戏崩溃，甚至存档损坏！{vbCrLf}除非整合包作者要求你更新，否则不要私自更新整合包里的 Mod！{vbCrLf}在更新 Mod 前，请先备份存档，并检查它的更新日志！{vbCrLf}更新时，老版本的 Mod 会被移动到回收站，以防万一。{vbCrLf}{vbCrLf}请在认真阅读上述警告后再继续！", "Mod 更新警告", "我已了解上述风险，继续更新", "取消", IsWarn:=True) = 1 Then + If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then + If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod，这可能导致游戏崩溃，甚至永久损坏存档！{vbCrLf}如果你在游玩整合包，请千万不要自行更新 Mod！{vbCrLf}{vbCrLf}在更新前，请先备份存档，并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题，你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险，继续更新", "取消", IsWarn:=True) = 1 Then Setup.Set("HintUpdateMod", True) Else Exit Sub @@ -476,7 +655,14 @@ '结果提示 Select Case Loader.State Case LoadState.Finished - Hint(If(FinishedFileNames.Count > 1, $"已成功更新 {FinishedFileNames.Count} 个 Mod！", $"已成功更新：{FinishedFileNames.Single}"), HintType.Finish) + Select Case FinishedFileNames.Count + Case 0 '一般是由于 Mod 文件被占用，然后玩家主动取消 + Log($"[Mod] 没有 Mod 被成功更新") + Case 1 + Hint($"已成功更新 {FinishedFileNames.Single}！", HintType.Finish) + Case Else + Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod！", HintType.Finish) + End Select Case LoadState.Failed Hint("Mod 更新失败：" & GetExceptionSummary(Loader.Error), HintType.Critical) Case LoadState.Aborted @@ -484,6 +670,7 @@ Case Else Exit Sub End Select + Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除：{PathMods}") UpdatingVersions.Remove(PathMods) '清理缓存 RunInNewThread( @@ -498,13 +685,13 @@ End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal) End Sub '启动加载器 - Log($"[Mod] 开始更新 {ModList.Count} 个 Mod") + Log($"[Mod] 开始更新 {ModList.Count} 个 Mod：{PathMods}") UpdatingVersions.Add(PathMods) Loader.Start() LoaderTaskbarAdd(Loader) FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.Ribble() - RefreshList(True) + ReloadModList(True) Catch ex As Exception Log(ex, "初始化 Mod 更新失败") End Try @@ -513,6 +700,7 @@ '删除 Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName))) + ChangeAllSelected(False) End Sub Private Sub DeleteMods(ModList As IEnumerable(Of McMod)) Try @@ -538,7 +726,7 @@ End If Catch ex As OperationCanceledException Log(ex, "删除 Mod 被主动取消") - RefreshList(True) + ReloadModList(True) Return Catch ex As Exception Log(ex, $"删除 Mod 失败（{ModEntity.Path}）", LogLevel.Msgbox) @@ -548,18 +736,19 @@ SelectedMods.Remove(ModEntity.RawFileName) '更改 Loader 和 UI 中的列表 McModLoader.Output.Remove(ModEntity) + SearchResult?.Remove(ModEntity) ModItems.Remove(ModEntity.RawFileName) Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity))) If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi) Next - RefreshTitle() + RefreshBars() If Not IsSuccessful Then Hint("由于文件被占用，Mod 删除失败，请尝试关闭正在运行的游戏后再试！", HintType.Critical) - RefreshList(True) + ReloadModList(True) ElseIf PanList.Children.Count = 0 Then - RefreshList(True) '删除了全部文件 + ReloadModList(True) '删除了全部文件 Else - RefreshBottomBar() + RefreshBars() End If '显示结果提示 If Not IsSuccessful Then Exit Sub @@ -578,11 +767,12 @@ End If Catch ex As OperationCanceledException Log(ex, "删除 Mod 被主动取消") - RefreshList(True) + ReloadModList(True) Catch ex As Exception Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback) - RefreshList(True) + ReloadModList(True) End Try + LoaderRun(LoaderFolderRunType.UpdateOnly) End Sub '取消选择 @@ -600,7 +790,7 @@ Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry '加载失败信息 - If ModEntry.State = McMod.McModState.Unavaliable Then + If ModEntry.State = McMod.McModState.Unavailable Then MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败") Return End If @@ -694,8 +884,8 @@ Return Not String.IsNullOrWhiteSpace(SearchBox.Text) End Get End Property + Private SearchResult As List(Of McMod) Public Sub SearchRun() Handles SearchBox.TextChanged - ChangeAllSelected(False) If IsSearching Then '构造请求 Dim QueryList As New List(Of SearchEntry(Of McMod)) @@ -718,12 +908,9 @@ QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource}) Next '进行搜索 - Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35) - RefreshResult(SearchResult.Select(Function(r) r.Item).ToList) - Else - '退出搜索状态 - RefreshResult(McModLoader.Output) + SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList End If + RefreshUI() End Sub #End Region diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb index 4619d5b..133138a 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb @@ -283,17 +283,23 @@ '补全文件 Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Try + '忽略文件检查提示 + If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then + If Setup.Get("LaunchAdvanceAssets") Then + Hint("请先关闭 [设置 → 高级启动选项 → 关闭文件校验]，然后再尝试补全文件！", HintType.Info) + Else + Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验]，然后再尝试补全文件！", HintType.Info) + End If + Exit Sub + End If '重复任务检查 - SyncLock LoaderTaskbarLock - For i = 0 To LoaderTaskbar.Count - 1 - If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then - Hint("正在处理中，请稍候！", HintType.Critical) - Exit Sub - End If - Next - End SyncLock + For Each OngoingLoader In LoaderTaskbar + If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For + Hint("正在处理中，请稍候！", HintType.Critical) + Exit Sub + Next '启动 - Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False)) + Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload)) Loader.OnStateChanged = Sub() Select Case Loader.State diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml index 6dfb1fa..378e63e 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml @@ -213,7 +213,7 @@ + ToolTip="该项不会覆盖全局设置：启动时会先执行全局设置的命令，再执行版本设置的命令。 在 MC 启动前执行特定命令或程序，语法与 Windows 的命令提示符一致。 可以使用以下替换标记实现相对路径（路径均以 \ 结尾）： · {path}：PCL 的 exe 文件所在的文件夹 · {minecraft}：.minecraft 文件夹 · {verpath}：版本文件夹（.minecraft\versions\版本名\） · {verindie}：开启版本隔离时等同版本文件夹，未开启时等同 .minecraft 文件夹 · {java}：游戏运行时的 Java 文件夹 除此之外，也支持以下替换标记： · {user}：玩家名字 · {login}：玩家的登录方式 · {uuid}：玩家的 UUID · {name}：游戏版本名 · {date}、{time}：当前的系统时间 · {version}：游戏对应的原版版本号 例如： · "{verpath}test.exe" ：运行版本文件夹下的 test.exe 程序 · "{java}java.exe" -jar "{verpath}test.jar" ：用 Java 运行版本文件夹下的 test.jar · notepad "{verindie}options.txt" ：使用记事本打开该版本的设置文件 涉及路径的操作最好都打上双引号，以避免路径中的空格导致运行失败。 执行命令时，命令行所在的目录是当前的 .minecraft 文件夹。" /> diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb index 8351759..bc2ed25 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb @@ -173,7 +173,7 @@ If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "") LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB" LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB" - LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed) + LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed) If ShowAnim Then '宽度动画 AniStart({ @@ -282,6 +282,11 @@ If Setup.Get("VersionRamType", Version:=Version) = 2 Then Return PageSetupLaunch.GetRam(Version, True, Is32BitJava) End If + + '------------------------------------------ + ' 修改下方代码时需要一并修改 PageSetupLaunch + '------------------------------------------ + '使用当前版本的设置 Dim RamGive As Double If Setup.Get("VersionRamType", Version:=Version) = 0 Then @@ -297,19 +302,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 @@ -317,27 +322,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: '不低于最低值 @@ -351,8 +352,6 @@ PreFin: RamGive = (Value - 12) * 0.5 + 1.5 ElseIf Value <= 33 Then RamGive = (Value - 25) * 1 + 8 - ElseIf Value <= 41 Then - RamGive = (Value - 33) * 2 + 16 Else RamGive = (Value - 33) * 2 + 16 End If @@ -486,6 +485,25 @@ PreFin: #End Region +#Region "其他设置" + + '版本隔离警告 + Private IsReverting As Boolean = False + Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + If IsReverting Then Exit Sub + If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf & + "如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf & + "如果你不会迁移存档，不建议修改这项设置！", + "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then + IsReverting = True + ComboArgumentIndie.SelectedItem = e.RemovedItems(0) + IsReverting = False + End If + End Sub + +#End Region + #Region "高级设置" Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged diff --git a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj index 8b0900b..71699f6 100644 --- a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj +++ b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj @@ -38,7 +38,7 @@ false false true - D:\Minecraft\程序\ + .\bin\ Plain Craft Launcher 2.xml 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 false @@ -55,7 +55,7 @@ false false true - D:\Minecraft\程序\ + .\bin\ Plain Craft Launcher 2.xml 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 false @@ -100,7 +100,7 @@ false - D:\Minecraft\程序\ + .\bin\ Plain Craft Launcher 2.xml true 1 @@ -111,7 +111,7 @@ false - D:\Minecraft\程序\ + .\bin\ Plain Craft Launcher 2.xml true 1 @@ -129,7 +129,7 @@ - D:\Minecraft\程序\ + .\bin\ RELEASE,BY_UPDATE Plain Craft Launcher 2.xml true @@ -140,6 +140,11 @@ false + + False + Resources\Imazen.WebP.dll + False + False False @@ -160,6 +165,7 @@ + @@ -180,6 +186,7 @@ + @@ -250,8 +257,8 @@ PageDownloadPack.xaml - - FormLoginOAuth.xaml + + MyMsgLogin.xaml PageLoginAuth.xaml @@ -508,9 +515,9 @@ Designer MSBuild:Compile - - Designer + MSBuild:Compile + Designer MSBuild:Compile @@ -883,32 +890,11 @@ - - - - {1C565858-F302-471E-B409-F180AA4ABEC6} - 1 - 0 - 0 - tlbimp - False - True - - - {58FBCF7C-E7A9-467C-80B3-FC65E8FCCA08} - 1 - 0 - 0 - tlbimp - False - True - - @@ -929,7 +915,7 @@ - + @@ -940,5 +926,12 @@ + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Resources/Custom.xaml b/Plain Craft Launcher 2/Resources/Custom.xaml index 94e27d4..21ca459 100644 --- a/Plain Craft Launcher 2/Resources/Custom.xaml +++ b/Plain Craft Launcher 2/Resources/Custom.xaml @@ -4,311 +4,309 @@ 你也可以使用 Ctrl + F 快速查找。例如，若需要改变文本颜色，则搜索 “颜色” 即可。 --> - + - + - - - + + - + - + - - + Text="local:MyImage 代表图片，你需要在它的 Source 属性中填写一个网址或文件路径，它会从该处获取图片并显示。通常需要使用 Height 限制它的高度。" /> + + - + - - - - + - + - - - - + - + - - - - - + - + - - - - - - + - - + - - - - - - - + - - - - + - - + - - + - - - + + - - - - - - + + + + - - - - + + - + - + - + EventType="打开帮助" EventData="帮助/自定义帮助.json" Type="Clickable" /> - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - + - + - + - - + + - - + - + - - + - - + - - + - - + - - - - - - - - - - - + + + + + + + - - - - + + + - - - + + - - - - - - - - + - - - + + - - +