wyc-26 6 месяцев назад
Родитель
Сommit
24ff7e6f40
100 измененных файлов с 5514 добавлено и 5548 удалено
  1. 1 1
      .github/FUNDING.yml
  2. 1 1
      .github/ISSUE_TEMPLATE/bug1.yml
  3. 1 1
      .github/ISSUE_TEMPLATE/bug2.yml
  4. 1 1
      .github/ISSUE_TEMPLATE/bug9.yml
  5. 2 2
      .github/ISSUE_TEMPLATE/ch.yml
  6. 3 3
      .github/ISSUE_TEMPLATE/config.yml
  7. 2 2
      .github/ISSUE_TEMPLATE/feature.yml
  8. 2 2
      .github/workflows/build.yml
  9. 3 3
      LICENCE
  10. 5 1
      Plain Craft Launcher 2/App.config
  11. 4 1
      Plain Craft Launcher 2/Application.xaml
  12. 68 89
      Plain Craft Launcher 2/Application.xaml.vb
  13. 192 0
      Plain Craft Launcher 2/Controls/Behaviors/ClipboardInterceptor.vb
  14. 23 0
      Plain Craft Launcher 2/Controls/Behaviors/Interfaces.vb
  15. 46 0
      Plain Craft Launcher 2/Controls/Behaviors/LazyLoadBehavior.vb
  16. 0 4
      Plain Craft Launcher 2/Controls/IMyRadio.vb
  17. 3 28
      Plain Craft Launcher 2/Controls/MyButton.xaml.vb
  18. 67 64
      Plain Craft Launcher 2/Controls/MyCard.vb
  19. 28 13
      Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
  20. 53 9
      Plain Craft Launcher 2/Controls/MyComboBox.vb
  21. 32 29
      Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb
  22. 6 6
      Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb
  23. 6 21
      Plain Craft Launcher 2/Controls/MyHint.xaml.vb
  24. 3 24
      Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
  25. 1 22
      Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
  26. 26 59
      Plain Craft Launcher 2/Controls/MyImage.vb
  27. 9 27
      Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
  28. 24 29
      Plain Craft Launcher 2/Controls/MyLoading.xaml.vb
  29. 4 1
      Plain Craft Launcher 2/Controls/MyMenuItem.vb
  30. 3 1
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
  31. 5 8
      Plain Craft Launcher 2/Controls/MyPageLeft.vb
  32. 19 14
      Plain Craft Launcher 2/Controls/MyPageRight.vb
  33. 33 16
      Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
  34. 6 10
      Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb
  35. 3 0
      Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb
  36. 17 0
      Plain Craft Launcher 2/Controls/MySlider.xaml.vb
  37. 30 2
      Plain Craft Launcher 2/Controls/MyTextBox.vb
  38. 16 39
      Plain Craft Launcher 2/Controls/MyTextButton.vb
  39. 70 0
      Plain Craft Launcher 2/Controls/MyVirtualizingElement.vb
  40. 2 1
      Plain Craft Launcher 2/FormMain.xaml
  41. 475 235
      Plain Craft Launcher 2/FormMain.xaml.vb
  42. BIN
      Plain Craft Launcher 2/Images/Heads/EasyTier.png
  43. 52 45
      Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
  44. 315 227
      Plain Craft Launcher 2/Modules/Base/ModBase.vb
  45. 73 54
      Plain Craft Launcher 2/Modules/Base/ModLoader.vb
  46. 308 506
      Plain Craft Launcher 2/Modules/Base/ModNet.vb
  47. 47 21
      Plain Craft Launcher 2/Modules/Base/ModValidate.vb
  48. 19 16
      Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
  49. 339 299
      Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
  50. 83 63
      Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
  51. 245 209
      Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
  52. 97 119
      Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
  53. 296 235
      Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
  54. 455 358
      Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
  55. 122 522
      Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
  56. 120 114
      Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
  57. 15 15
      Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
  58. 305 80
      Plain Craft Launcher 2/Modules/ModEvent.vb
  59. 154 99
      Plain Craft Launcher 2/Modules/ModMain.vb
  60. 28 24
      Plain Craft Launcher 2/Modules/ModMusic.vb
  61. 38 30
      Plain Craft Launcher 2/Modules/ModSecret.vb
  62. 0 59
      Plain Craft Launcher 2/Modules/Reference/CookieWebClient.vb
  63. 151 0
      Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb
  64. 2 2
      Plain Craft Launcher 2/My Project/AssemblyInfo.vb
  65. 69 9
      Plain Craft Launcher 2/My Project/Resources.Designer.vb
  66. 26 8
      Plain Craft Launcher 2/My Project/Resources.resx
  67. 27 37
      Plain Craft Launcher 2/Pages/PageDownload/Comp/MyCompItem.xaml.vb
  68. 9 10
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml
  69. 26 20
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb
  70. 2 1
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml
  71. 159 98
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb
  72. 1 1
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadDataPack.xaml
  73. 3 2
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadMod.xaml
  74. 2 2
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadPack.xaml
  75. 1 1
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadResourcePack.xaml
  76. 1 1
      Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadShader.xaml
  77. 198 319
      Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
  78. 0 31
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml
  79. 0 111
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb
  80. 0 28
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml
  81. 0 32
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml.vb
  82. 0 26
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml
  83. 0 61
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb
  84. 8 8
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml
  85. 206 336
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
  86. 4 27
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml
  87. 1 88
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
  88. 0 26
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml
  89. 0 52
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml.vb
  90. 0 27
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml
  91. 0 34
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml.vb
  92. 0 26
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml
  93. 0 53
      Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb
  94. 0 0
      Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml
  95. 110 115
      Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml.vb
  96. 24 8
      Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml
  97. 49 53
      Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb
  98. 2 2
      Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml
  99. 25 25
      Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml.vb
  100. 2 4
      Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml

+ 1 - 1
.github/FUNDING.yml

@@ -1,3 +1,3 @@
 # These are supported funding model platforms
 
-custom: ['https://afdian.com/a/LTCat']
+custom: ['https://meloong.com/afd/a/LTCat']

+ 1 - 1
.github/ISSUE_TEMPLATE/bug1.yml

@@ -12,7 +12,7 @@ body:
       required: false
     - label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
       required: true
-    - label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
+    - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
       required: true
 - type: textarea
   id: "yml-2"

+ 1 - 1
.github/ISSUE_TEMPLATE/bug2.yml

@@ -12,7 +12,7 @@ body:
       required: false
     - label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
       required: true
-    - label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
+    - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
       required: true
 - type: textarea
   id: "yml-2"

+ 1 - 1
.github/ISSUE_TEMPLATE/bug9.yml

@@ -8,7 +8,7 @@ body:
     label: "检查项"
     description: "请逐个检查下列项目,并勾选确认。"
     options:
-    - label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
+    - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
       required: true
 - type: textarea
   id: "yml-2"

+ 2 - 2
.github/ISSUE_TEMPLATE/ch.yml

@@ -8,9 +8,9 @@ body:
     label: "检查项"
     description: "请逐个检查下列项目,并勾选确认。"
     options:
-    - label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一建议未被提交过。"
+    - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一建议未被提交过。"
       required: true
-    - label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
+    - label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
       required: true
 - type: textarea
   id: "yml-2"

+ 3 - 3
.github/ISSUE_TEMPLATE/config.yml

@@ -1,14 +1,14 @@
 blank_issues_enabled: false
 contact_links:
   - name: 主页预设反馈
-    url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页
+    url: https://github.com/Meloong-Git/PCL/discussions/categories/自定义主页
     about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈
   - name: 帮助文档反馈
     url: https://github.com/LTCatt/PCL2Help/issues
     about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
   - name: 提问
-    url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE
+    url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE
     about: 我想问一些 PCL 相关的问题……
   - name: 讨论
-    url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E8%AE%A8%E8%AE%BA
+    url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E8%AE%A8%E8%AE%BA
     about: 我想讨论一些 PCL 相关的事情……

+ 2 - 2
.github/ISSUE_TEMPLATE/feature.yml

@@ -8,9 +8,9 @@ body:
     label: "检查项"
     description: "请逐个检查下列项目,并勾选确认。"
     options:
-    - label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一提案未被提交过。"
+    - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一提案未被提交过。"
       required: true
-    - label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
+    - label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
       required: true
     - label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
       required: true

+ 2 - 2
.github/workflows/build.yml

@@ -51,8 +51,8 @@ jobs:
 
     - 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\ModSecret.vb") -replace 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")', 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "${{ secrets.CLIENT_ID }}")' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
+        (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")', 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "${{ 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"
         
     - name: Build

+ 3 - 3
LICENCE

@@ -31,8 +31,8 @@
 2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。
   允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。
   禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。
-3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SC 协议)。
-4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致的 Minecraft 正版购买弹窗与赞助弹窗。
+3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SA 协议)。
+4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致(或更激进)的 Minecraft 正版购买劝导与赞助劝导。
 5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
   例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
 
@@ -44,6 +44,6 @@
 这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
 
 如果你只是参考了一小段代码,署个名就行啦,不用担心。
-如果对具体细节有疑问,欢迎在 https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
+如果对具体细节有疑问,欢迎在 https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
 
 多谢大家啦!

+ 5 - 1
Plain Craft Launcher 2/App.config

@@ -30,6 +30,10 @@
                   <assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
                   <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
             </dependentAssembly>
+			<dependentAssembly>
+				<assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/>
+				<bindingRedirect oldVersion="0.0.0.0-6.0.0.0" newVersion="13.0.0.0"/>
+			</dependentAssembly>
         </assemblyBinding>
     </runtime>
-</configuration>
+</configuration>

+ 4 - 1
Plain Craft Launcher 2/Application.xaml

@@ -1,6 +1,7 @@
 <Application x:Class="Application"
     xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+    xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors"
     xmlns:local="clr-namespace:PCL"
     xmlns:sys="clr-namespace:System;assembly=mscorlib"
     StartupUri="FormMain.xaml"
@@ -302,6 +303,7 @@
                         </ControlTemplate>
                     </Setter.Value>
                 </Setter>
+                <Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
             </Style>
             <Style TargetType="PasswordBox">
                 <Setter Property="FontSize" Value="13" />
@@ -343,6 +345,7 @@
                         </ControlTemplate>
                     </Setter.Value>
                 </Setter>
+                <Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
             </Style>
 
             <!-- ComboBox -->
@@ -362,7 +365,7 @@
                 <Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
                 <Setter Property="FocusVisualStyle" Value="{x:Null}" />
                 <Setter Property="FontSize" Value="13" />
-                <Setter Property="MaxDropDownHeight" Value="160" />
+                <Setter Property="MaxDropDownHeight" Value="320" />
                 <Setter Property="Template">
                     <Setter.Value>
                         <ControlTemplate TargetType="ComboBox">

+ 68 - 89
Plain Craft Launcher 2/Application.xaml.vb

@@ -19,6 +19,9 @@ Public Class Application
     '开始
     Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
         Try
+            '动态 DLL 调用(必须尽量在前面,否则模块加载 CacheCow 等 DLL 就可能导致崩溃)
+            AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
+            '开始
             SecretOnApplicationStart()
             '检查参数调用
             If e.Args.Length > 0 Then
@@ -48,15 +51,6 @@ Public Class Application
                     Else
                         Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
                     End If
-#If DEBUG Then
-                    '制作更新包
-                ElseIf e.Args(0) = "--edit1" Then
-                    ExeEdit(e.Args(1), True)
-                    Environment.Exit(ProcessReturnValues.TaskDone)
-                ElseIf e.Args(0) = "--edit2" Then
-                    ExeEdit(e.Args(1), False)
-                    Environment.Exit(ProcessReturnValues.TaskDone)
-#End If
                 End If
             End If
             '初始化文件结构
@@ -67,15 +61,14 @@ Public Class Application
                 If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
             Catch ex As Exception
                 If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
-                    MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
+                    MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
                 Else
-                    MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
-                    Setup.Set("SystemSystemCache", "")
+                    MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
+                    Settings.Set("SystemSystemCache", "")
                     PathTemp = IO.Path.GetTempPath() & "PCL\"
                 End If
             End Try
             Directory.CreateDirectory(PathTemp & "Cache")
-            Directory.CreateDirectory(PathTemp & "Download")
             Directory.CreateDirectory(PathAppdata)
             '检测单例
 #If Not DEBUG Then
@@ -104,45 +97,41 @@ WaitRetry:
             ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
             ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
             ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
+            '设置网络配置默认值
+            ServicePointManager.Expect100Continue = False
+            ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
+            ServicePointManager.DefaultConnectionLimit = 10000
+            ServicePointManager.UseNagleAlgorithm = False
+            ServicePointManager.EnableDnsRoundRobin = True
+            ServicePointManager.ReusePort = True
             '设置初始窗口
-            If Setup.Get("UiLauncherLogo") Then
+            If Settings.Get("UiLauncherLogo") Then
                 FrmStart = New SplashScreen("Images\icon.ico")
                 FrmStart.Show(False, True)
             End If
-            '动态 DLL 调用
-            AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
             '日志初始化
             LogStart()
             '添加日志
             Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
 #If RELEASE Then
-            Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",正式版", "")}")
+            Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",正式版", "")}")
 #Else
-            Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
+            Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
 #End If
             Log($"[Start] 程序路径:{PathWithName}")
             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 & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
+                MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
+                FormMain.EndProgramForce(ProcessReturnValues.Cancel)
             End If
             If Is32BitSystem Then
                 MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
             End If
-            '设置初始化
-            Setup.Load("SystemDebugMode")
-            Setup.Load("SystemDebugAnim")
-            Setup.Load("ToolDownloadThread")
-            Setup.Load("ToolDownloadCert")
-            Setup.Load("ToolDownloadSpeed")
-            '网络配置初始化
-            ServicePointManager.Expect100Continue = True
-            ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
-            ServicePointManager.DefaultConnectionLimit = 1024
             '计时
-            Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
-            ApplicationStartTick = GetTimeTick()
+            Log("[Start] 第一阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms")
+            ApplicationStartTick = GetTimeMs()
             '执行测试
 #If DEBUG Then
             Test()
@@ -154,23 +143,33 @@ WaitRetry:
                 FilePath = PathWithName
             Catch
             End Try
-            MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
+            MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
             FormMain.EndProgramForce(ProcessReturnValues.Exception)
         End Try
     End Sub
 
     '结束
     Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
-        FrmMain.EndProgram(False)
+        FrmMain?.EndProgram(False)
     End Sub
 
     '异常
     Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
         On Error Resume Next
+        '触发页面的 Dispatcher
+        If FrmMain?.PageLeft IsNot Nothing AndAlso TypeOf FrmMain.PageLeft Is IDispatcherUnhandledException Then
+            CType(FrmMain.PageLeft, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
+            If e.Handled Then Return
+        End If
+        If FrmMain?.PageRight IsNot Nothing AndAlso TypeOf FrmMain.PageRight Is IDispatcherUnhandledException Then
+            CType(FrmMain.PageRight, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
+            If e.Handled Then Return
+        End If
+        '正常处理
         e.Handled = True
         If IsProgramEnded Then Return
         FeedbackInfo()
-        Dim Detail As String = GetExceptionDetail(e.Exception, True)
+        Dim Detail As String = e.Exception.GetDetail(True)
         If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
            Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
             OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
@@ -181,89 +180,69 @@ WaitRetry:
     End Sub
 
     '动态 DLL 调用
-    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
-                If AssemblyNAudio Is Nothing Then
-                    Log("[Start] 加载 DLL:NAudio")
-                    AssemblyNAudio = Assembly.Load(GetResources("NAudio"))
-                End If
-                Return AssemblyNAudio
-            End SyncLock
-        ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
-            SyncLock AssemblyJsonLock
-                If AssemblyJson Is Nothing Then
-                    Log("[Start] 加载 DLL:Json")
-                    AssemblyJson = Assembly.Load(GetResources("Json"))
-                End If
-                Return AssemblyJson
-            End SyncLock
-        ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
-            SyncLock AssemblyDialogLock
-                If AssemblyDialog Is Nothing Then
-                    Log("[Start] 加载 DLL:Dialogs")
-                    AssemblyDialog = Assembly.Load(GetResources("Dialogs"))
-                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"))
+    Public Shared Function AssemblyResolve(sender As Object, Args As ResolveEventArgs) As Assembly
+        '缓存
+        Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting", "System.ValueTuple"}
+        Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal)
+        Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal)
+        '查找对应的 DLL
+        Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWithF(p))
+        If Prefix Is Nothing Then Return Nothing
+        '加载 DLL
+        If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object()
+        SyncLock Locks(Prefix)
+            If Not LoadedAssembly.ContainsKey(Prefix) Then
+                Log($"[Start] 加载 DLL:{Prefix}")
+                LoadedAssembly(Prefix) = Assembly.Load(GetResources(Prefix))
+                'WebP 特判
+                If Prefix = "Imazen.WebP" Then
+                    SetDllDirectory(PathPure.TrimEnd("\"c))
+                    Try
+                        WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
+                    Catch ex As Exception
+                        Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
+                    End Try
                 End If
-                Return AssemblyImazenWebp
-            End SyncLock
-        Else
-            Return Nothing
-        End If
+            End If
+            Return LoadedAssembly(Prefix)
+        End SyncLock
     End Function
 
     '切换窗口
 
     '控件模板事件
     Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
-        Select Case Setup.Get("LoginType")
+        Select Case Settings.Get("LoginType")
             Case McLoginType.Ms
                 '微软
-                Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
+                Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
                 MsJson.Remove(sender.Tag)
-                Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
+                Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
                 If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
                 FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
             Case McLoginType.Legacy
                 '离线
                 Dim Names As New List(Of String)
-                Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
+                Names.AddRange(Settings.Get("LoginLegacyName").ToString.Split("¨"))
                 Names.Remove(sender.Tag)
-                Setup.Set("LoginLegacyName", Join(Names, "¨"))
+                Settings.Set("LoginLegacyName", Names.Join("¨"c))
                 FrmLoginLegacy.ComboName.ItemsSource = Names
                 FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
             Case Else
                 '第三方
-                Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
+                Dim Token As String = GetStringFromEnum(Settings.Get("LoginType"))
                 Dim Dict As New Dictionary(Of String, String)
                 Dim Names As New List(Of String)
                 Dim Passs As New List(Of String)
-                If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨"))
-                If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨"))
+                If Not Settings.Get("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get("Login" & Token & "Email").ToString.Split("¨"))
+                If Not Settings.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get("Login" & Token & "Pass").ToString.Split("¨"))
                 For i = 0 To Names.Count - 1
                     Dict.Add(Names(i), Passs(i))
                 Next
                 Dict.Remove(sender.Tag)
-                Setup.Set("Login" & Token & "Email", Join(Dict.Keys, "¨"))
-                Setup.Set("Login" & Token & "Pass", Join(Dict.Values, "¨"))
+                Settings.Set("Login" & Token & "Email", Dict.Keys.Join("¨"c))
+                Settings.Set("Login" & Token & "Pass", Dict.Values.Join("¨"c))
                 Select Case Token
                     Case "Nide"
                         FrmLoginNide.ComboName.ItemsSource = Dict.Keys

+ 192 - 0
Plain Craft Launcher 2/Controls/Behaviors/ClipboardInterceptor.vb

@@ -0,0 +1,192 @@
+' Author: uye (owner of the MaaAssistantArknights team)
+' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
+' License: Apache License 2.0 (this file only)
+'
+' This file is originally developed for MaaAssistantArknights and licensed under AGPL v3.0.
+' As the original author and copyright holder,
+' I hereby re-license this file under the Apache License 2.0 for use in the Plain Craft Launcher project.
+'
+' This file is contributed under the spirit of good faith and open cooperation.
+' It does not implement any core launcher functions of PCL.
+'
+' Description:
+' Provides a WPF clipboard handling fix to avoid OpenClipboard exceptions
+' in TextBox, RichTextBox, and DataGrid under Windows focus issues or clipboard hooks.
+'
+' Date: 2025-07-03
+
+Imports System.Windows
+Imports System.Windows.Controls
+Imports System.Windows.Input
+Imports System.Windows.Documents
+Imports System.Linq
+
+Namespace Controls.Behaviors
+    Public NotInheritable Class ClipboardInterceptor
+        Private Sub New()
+        End Sub
+
+        Public Shared ReadOnly EnableSafeClipboardProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("EnableSafeClipboard", GetType(Boolean), GetType(ClipboardInterceptor),
+                                                New PropertyMetadata(False, AddressOf OnEnableSafeClipboardChanged))
+
+        Public Shared Sub SetEnableSafeClipboard(element As DependencyObject, value As Boolean)
+            element.SetValue(EnableSafeClipboardProperty, value)
+        End Sub
+
+        Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
+            Return element.GetValue(EnableSafeClipboardProperty)
+        End Function
+
+        Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
+            If TypeOf d Is TextBox AndAlso CBool(e.NewValue) Then
+                AddCommandBindingsToTextBox(DirectCast(d, TextBox))
+            ElseIf TypeOf d Is RichTextBox AndAlso CBool(e.NewValue) Then
+                AddCommandBindingsToRichTextBox(DirectCast(d, RichTextBox))
+            ElseIf TypeOf d Is DataGrid AndAlso CBool(e.NewValue) Then
+                AddCommandBindingsToDataGrid(DirectCast(d, DataGrid))
+            End If
+        End Sub
+
+        Private Shared Sub AddCommandBindingsToTextBox(tb As TextBox)
+            tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyTextBox))
+            tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutTextBox))
+            tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteTextBox))
+        End Sub
+
+        Private Shared Sub AddCommandBindingsToRichTextBox(rtb As RichTextBox)
+            rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyRichTextBox))
+            rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutRichTextBox))
+            rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteRichTextBox))
+        End Sub
+
+        Private Shared Sub AddCommandBindingsToDataGrid(dg As DataGrid)
+            dg.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyDataGrid))
+        End Sub
+
+        Private Shared Sub OnCopyTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim tb = TryCast(sender, TextBox)
+            If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
+
+            Try
+                Forms.Clipboard.Clear()
+                Forms.Clipboard.SetDataObject(tb.SelectedText, True)
+            Catch
+            End Try
+
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnCutTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim tb = TryCast(sender, TextBox)
+            If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
+
+            Try
+                Forms.Clipboard.Clear()
+                Forms.Clipboard.SetDataObject(tb.SelectedText, True)
+            Catch
+            End Try
+
+            tb.SelectedText = String.Empty
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnPasteTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim tb = TryCast(sender, TextBox)
+            If tb Is Nothing Then Return
+
+            If Forms.Clipboard.ContainsText() Then
+                Dim pasteText = Forms.Clipboard.GetText()
+
+                '将换行符替换为空格(#7825)
+                If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
+
+                Dim start = tb.SelectionStart
+
+                tb.SelectedText = pasteText
+                tb.CaretIndex = start + pasteText.Length
+                tb.SelectionLength = 0
+            End If
+
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnCopyRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim rtb = TryCast(sender, RichTextBox)
+            If rtb Is Nothing Then Return
+
+            Dim textRange = New TextRange(rtb.Selection.Start, rtb.Selection.End)
+            If String.IsNullOrEmpty(textRange.Text) Then Return
+
+            Try
+                Forms.Clipboard.Clear()
+                Forms.Clipboard.SetDataObject(textRange.Text, True)
+            Catch
+            End Try
+
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnCutRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim rtb = TryCast(sender, RichTextBox)
+            If rtb Is Nothing Then Return
+
+            Dim selection = New TextRange(rtb.Selection.Start, rtb.Selection.End)
+            If String.IsNullOrEmpty(selection.Text) Then Return
+
+            Try
+                Forms.Clipboard.Clear()
+                Forms.Clipboard.SetDataObject(selection.Text, True)
+            Catch
+            End Try
+
+            selection.Text = String.Empty
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnPasteRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim rtb = TryCast(sender, RichTextBox)
+            If rtb Is Nothing Then Return
+
+            If Not Forms.Clipboard.ContainsText() Then Return
+
+            Dim pasteText = Forms.Clipboard.GetText()
+            Dim selection = rtb.Selection
+
+            selection.Text = pasteText
+
+            Dim caretPos = selection.End
+            rtb.CaretPosition = caretPos
+            rtb.Selection.Select(caretPos, caretPos)
+
+            e.Handled = True
+        End Sub
+
+        Private Shared Sub OnCopyDataGrid(sender As Object, e As ExecutedRoutedEventArgs)
+            Dim dg = TryCast(sender, DataGrid)
+            If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return
+
+            Dim sb = New StringBuilder
+            Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item)
+
+            For Each row In rowGroups
+                Dim rowText = String.Join(vbTab, row.Select(
+                Function(cell)
+                    Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
+                    Return If(tb IsNot Nothing, tb.Text, "")
+                End Function))
+                sb.AppendLine(rowText)
+            Next
+
+            Dim sbStr = sb.ToString().TrimEnd(ControlChars.Cr, ControlChars.Lf)
+
+            Try
+                Forms.Clipboard.Clear()
+                Forms.Clipboard.SetDataObject(sbStr, True)
+            Catch
+            End Try
+
+            e.Handled = True
+        End Sub
+    End Class
+End Namespace

+ 23 - 0
Plain Craft Launcher 2/Controls/Behaviors/Interfaces.vb

@@ -0,0 +1,23 @@
+Imports System.Windows.Threading
+
+''' <summary>
+''' 指示页面可以通过按下 F5 或以其他方式刷新。
+''' </summary>
+Public Interface IRefreshable
+    Sub Refresh()
+End Interface
+
+''' <summary>
+''' 指示页面可以处理未捕获的异常。
+''' </summary>
+Public Interface IDispatcherUnhandledException
+    Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
+End Interface
+
+''' <summary>
+''' 指示该控件是可勾选的。
+''' </summary>
+Public Interface IMyRadio
+    Event Check(sender As Object, e As RouteEventArgs)
+    Event Changed(sender As Object, e As RouteEventArgs)
+End Interface

+ 46 - 0
Plain Craft Launcher 2/Controls/Behaviors/LazyLoadBehavior.vb

@@ -0,0 +1,46 @@
+Public Class LazyLoadBehavior
+
+    ''' <summary>
+    ''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
+    ''' </summary>
+    Public Shared Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
+        obj.SetValue(IsInViewportProperty, value)
+    End Sub
+
+    Private Shared ReadOnly IsInViewportProperty As DependencyProperty =
+        DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
+        New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
+
+    Private Shared Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
+        Dim Element = TryCast(d, FrameworkElement)
+        If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
+
+        Dim Handled As Boolean = False
+        Dim Handler As EventHandler =
+        Sub()
+            If Handled Then Return
+            '判断元素是否可见
+            If Element.RenderSize.Width < Double.Epsilon Then Return
+            If Not Element.IsVisible Then Return
+            '判断是否在 ScrollViewer 的可视区域内
+            Dim Scroll = FindParentScrollViewer(Element)
+            If Scroll Is Nothing Then Return
+            If Not New Rect(0, 0, Scroll.ViewportWidth, Scroll.ViewportHeight).IntersectsWith(
+               Element.TransformToAncestor(Scroll).TransformBounds(New Rect(New Point(0, 0), Element.RenderSize))) Then Return
+            '执行
+            Handled = True
+            CType(e.NewValue, Action).Invoke()
+            RemoveHandler Element.LayoutUpdated, Handler
+        End Sub
+        AddHandler Element.LayoutUpdated, Handler
+    End Sub
+
+    Private Shared Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
+        While d IsNot Nothing
+            If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
+            d = VisualTreeHelper.GetParent(d)
+        End While
+        Return Nothing
+    End Function
+
+End Class

+ 0 - 4
Plain Craft Launcher 2/Controls/IMyRadio.vb

@@ -1,4 +0,0 @@
-Public Interface IMyRadio
-    Event Check(sender As Object, e As RouteEventArgs)
-    Event Changed(sender As Object, e As RouteEventArgs)
-End Interface

+ 3 - 28
Plain Craft Launcher 2/Controls/MyButton.xaml.vb

@@ -140,39 +140,14 @@ Public Class MyButton
         End Try
     End Sub
 
-    '实现自定义事件
+    '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
+    Private IsMouseDown As Boolean = False
     Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
         If Not IsMouseDown Then Return
         Log("[Control] 按下按钮:" & Text)
         RaiseEvent Click(sender, e)
-        If Not String.IsNullOrEmpty(Tag) Then
-            If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
-                Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
-            End If
-        End If
-        ModEvent.TryStartEvent(EventType, EventData)
+        RaiseCustomEvent() '自定义事件
     End Sub
-    Public Property EventType As String
-        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(MyButton), 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(MyButton), New PropertyMetadata(Nothing))
-
-    '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
-    Private IsMouseDown As Boolean = False
     Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
         IsMouseDown = True
         Focus()

+ 67 - 64
Plain Craft Launcher 2/Controls/MyCard.vb

@@ -90,8 +90,9 @@
             MainGrid.Children.Add(MainSwap)
         End If
         '改变默认的折叠
-        If IsSwaped AndAlso SwapControl IsNot Nothing Then
+        If IsSwapped AndAlso SwapControl IsNot Nothing Then
             MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
+            SwapControl.Visibility = Visibility.Collapsed
             '取消由于高度变化被迫触发的高度动画
             Dim RawUseAnimation As Boolean = UseAnimation
             UseAnimation = False
@@ -109,28 +110,24 @@
         '这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
         '但是现在……反正勉强能用……懒得改了就这样吧.jpg
         '别骂了别骂了.jpg
-        If IsNothing(Stack.Tag) Then Return
+        If Stack.Tag Is Nothing Then Return
         '排序
+        Dim HasDuplicates As Boolean = False
         Select Case Type
             Case 3
-                Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
+                Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.DisplayName, b.DisplayName))
             Case 4, 10
-                Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
+                Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.Inherit, b.Inherit))
             Case 6
-                Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version)
+                Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
             Case 8, 9
-                Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
+                Stack.Tag = CType(Stack.Tag, List(Of CompFile)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
+                HasDuplicates =
+                    CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
+                    CType(Stack.Tag, List(Of CompFile)).Count
         End Select
         '控件转换
         Select Case Type
-            Case 5
-                Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
-                Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
-                LoadingPickaxe.State = Loader
-                Loader.Start(Stack.Tag)
-                AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
-                AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
-                Stack.Children.Add(LoadingPickaxe)
             Case 6
                 ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
             Case 8
@@ -140,37 +137,24 @@
         For Each Data As Object In Stack.Tag
             Select Case Type
                 Case 0
-                    Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
+                    Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
                 Case 2
                     Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
                 Case 3
                     Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
-                Case 4
-                    Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
-                Case 5
                 Case 6
                     Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
                 Case 7
                     '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
                     Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
                 Case 8
-                    If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
-                       CType(Stack.Tag, List(Of CompFile)).Count Then
-                        '存在重复的名称(#1344)
-                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
-                    Else
-                        '不存在重复的名称,正常加载
-                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
-                    End If
+                    '若存在重复的版本名,则显示文件名而非版本名(#1344)
+                    Stack.Children.Add(CType(Data, CompFile).ToListItem(
+                        AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
                 Case 9
-                    If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
-                       CType(Stack.Tag, List(Of CompFile)).Count Then
-                        '存在重复的名称(#1344)
-                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
-                    Else
-                        '不存在重复的名称,正常加载
-                        Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
-                    End If
+                    '若存在重复的版本名,则显示文件名而非版本名(#1344)
+                    Stack.Children.Add(CType(Data, CompFile).ToListItem(
+                        AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
                 Case 10
                     Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
                 Case 11
@@ -224,7 +208,7 @@
     Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
     Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
         If Not UseAnimation Then Return
-        Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
+        Dim DeltaHeight As Double = If(IsSwapped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
         '卡片的进入时动画已被页面通用切换动画替代
         If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
         StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
@@ -269,18 +253,18 @@
         Sub()
             IsHeightAnimating = False
             Height = ActualUsedHeight
-            If IsSwaped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
+            If IsSwapped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
         End Sub,, True))
         AniStart(AnimList, "MyCard Height " & Uuid)
         IsHeightAnimating = True
-        ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
+        ActualUsedHeight = If(IsSwapped, SwapedHeight, Height)
         Height = PreviousHeight
     End Sub
     ''' <summary>
-    ''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。
+    ''' 通知 MyCard,控件内容已改变,需要中断动画并瞬间更新高度。
     ''' </summary>
     Public Sub TriggerForceResize()
-        Height = If(IsSwaped, SwapedHeight, Double.NaN)
+        Height = If(IsSwapped, SwapedHeight, Double.NaN)
         AniStop("MyCard Height " & Uuid)
         IsHeightAnimating = False
     End Sub
@@ -291,7 +275,7 @@
 
     '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
     '这是因为不能直接在 XAML 中设置 SwapControl
-    Public SwapControl As Object
+    Public SwapControl As FrameworkElement
     Public Property CanSwap As Boolean = False
     ''' <summary>
     ''' 被折叠的种类,用于控件虚拟化。
@@ -300,59 +284,78 @@
     ''' <summary>
     ''' 是否已被折叠。
     ''' </summary>
-    Public Property IsSwaped As Boolean
+    Public Property IsSwapped As Boolean
         Get
-            Return _IsSwaped
+            Return _IsSwapped
         End Get
         Set(value As Boolean)
-            If _IsSwaped = value Then Return
-            _IsSwaped = value
+            If _IsSwapped = value Then Return
+            _IsSwapped = value
             If SwapControl Is Nothing Then Return
             '展开
-            If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
+            If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
             '若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
             If Not IsLoaded Then Return
             '更新高度
             SwapControl.Visibility = Visibility.Visible
             TriggerForceResize()
             '改变箭头
-            AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
+            AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
+        End Set
+    End Property
+    Private _IsSwapped As Boolean = False
+    <Obsolete("IsSwaped 存在拼写错误,请换用 IsSwapped 属性。")>
+    Public Property IsSwaped As Boolean
+        Get
+            Return GetValue(IsSwapedProperty)
+        End Get
+        Set(value As Boolean)
+            SetValue(IsSwapedProperty, value)
         End Set
     End Property
-    Private _IsSwaped As Boolean = False
+    Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
+    Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
 
     Public Property SwapLogoRight As Boolean = False
-    Private IsMouseDown As Boolean = False
+    Private IsSwapMouseDown As Boolean = False '用于触发卡片展开/折叠的 MouseDown
+    Private IsCustomMouseDown As Boolean = False '用于触发自定义事件的 MouseDown
     Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
     Public Event Swap(sender As Object, e As RouteEventArgs)
     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
-            (SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
-        IsMouseDown = True
+        If Not IsSwapped AndAlso
+            (Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return
+        IsCustomMouseDown = True
+        If Not IsSwapped AndAlso
+            (SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
+        IsSwapMouseDown = True
     End Sub
-    Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
-        If Not IsMouseDown Then Return
-        IsMouseDown = False
+    Private Sub MyCard_MouseLeftButtonUp() Handles Me.MouseLeftButtonUp
+        If Not IsCustomMouseDown Then Return
+        IsCustomMouseDown = False
+        RaiseCustomEvent() '触发自定义事件
+
+        If Not IsSwapMouseDown Then Return
+        IsSwapMouseDown = False
 
         Dim Pos As Double = Mouse.GetPosition(Me).Y
-        If Not IsSwaped AndAlso
-            (SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
+        If Not IsSwapped AndAlso
+            (SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
 
-        Dim ee = New RouteEventArgs(True)
-        RaiseEvent PreviewSwap(Me, ee)
-        If ee.Handled Then
-            IsMouseDown = False
+        Dim e = New RouteEventArgs(True)
+        RaiseEvent PreviewSwap(Me, e)
+        If e.Handled Then
+            IsSwapMouseDown = False
             Return
         End If
 
-        IsSwaped = Not IsSwaped
-        Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
-        RaiseEvent Swap(Me, ee)
+        IsSwapped = Not IsSwapped
+        Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
+        RaiseEvent Swap(Me, e)
     End Sub
     Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
-        IsMouseDown = False
+        IsSwapMouseDown = False
     End Sub
 
 #End Region

+ 28 - 13
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb

@@ -2,6 +2,7 @@
 
 <ContentProperty("Inlines")>
 Public Class MyCheckBox
+    Implements ISettingControl
 
     '基础
 
@@ -12,9 +13,6 @@ Public Class MyCheckBox
     ''' <param name="user">是否为用户手动改变的勾选状态。</param>
     Public Event Change(sender As Object, user As Boolean)
     Public Event PreviewChange(sender As Object, e As RouteEventArgs)
-    Public Sub RaiseChange()
-        RaiseEvent Change(Me, False)
-    End Sub '使外部程序引发本控件的 Change 事件
 
     '自定义属性
     Public Property Checked As Boolean
@@ -59,6 +57,7 @@ Public Class MyCheckBox
 
             '更改动画
             SyncUI()
+            RaiseCustomEvent()
         Catch ex As Exception
             Log(ex, "设置 Checked 失败")
         End Try
@@ -74,7 +73,7 @@ Public Class MyCheckBox
                       AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
                  }, "MyCheckBox Scale " & Uuid)
                 AniStart({
-                      AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
+                      AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray5"), AnimationTimeOfCheck)
                  }, "MyCheckBox BorderColor " & Uuid)
                 AniStart({
                       AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -87,7 +86,7 @@ Public Class MyCheckBox
                       AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
                  }, "MyCheckBox Scale " & Uuid)
                 AniStart({
-                      AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
+                      AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfCheck)
                  }, "MyCheckBox BorderColor " & Uuid)
                 AniStart({
                       AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -101,11 +100,11 @@ Public Class MyCheckBox
             If Checked Then
                 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
                 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
-                ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
+                ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
             Else
                 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
                 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
-                ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
+                ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
             End If
         End If
     End Sub
@@ -180,18 +179,18 @@ Public Class MyCheckBox
             Else
                 '不可用
                 AniStart({
-                         AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
+                         AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray5 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
                  }, "MyCheckBox BorderColor " & Uuid)
                 AniStart({
-                         AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut)
+                         AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut)
                  }, "MyCheckBox TextColor " & Uuid)
             End If
         Else
             '无动画
             AniStop("MyCheckBox TextColor " & Uuid)
             AniStop("MyCheckBox BorderColor " & Uuid)
-            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
-            ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
+            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
+            ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
         End If
     End Sub
     Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -205,11 +204,27 @@ Public Class MyCheckBox
     Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
         If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
         AniStart({
-                 AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut)
+                 AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut)
          }, "MyCheckBox TextColor " & Uuid)
         AniStart({
-                 AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut)
+                 AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut)
          }, "MyCheckBox BorderColor " & Uuid)
     End Sub
 
+#Region "设置"
+
+    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
+        Checked = Boolean.Parse(NewValue)
+    End Sub
+
+    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
+        Return Checked.ToString
+    End Function
+
+    Private Sub SaveSetting() Handles Me.Change
+        SettingService.SaveSetting(Me)
+    End Sub
+
+#End Region
+
 End Class

+ 53 - 9
Plain Craft Launcher 2/Controls/MyComboBox.vb

@@ -1,5 +1,6 @@
 Public Class MyComboBox
     Inherits ComboBox
+    Implements ISettingControl
     Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
 
     '基础
@@ -117,15 +118,14 @@
     Private IsTextChanging As Boolean = False
     Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
         If IsTextChanging OrElse Not IsEditable Then Return
-        If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
-            Dim RawText As String = Text
-            Dim RawSelectionStart As Integer = TextBox.SelectionStart
-            IsTextChanging = True
-            SelectedItem = Nothing
-            Text = RawText
-            TextBox.SelectionStart = RawSelectionStart
-            IsTextChanging = False
-        End If
+        If SelectedItem Is Nothing OrElse Text = SelectedItem.ToString Then Return
+        Dim RawText As String = Text
+        Dim RawSelectionStart As Integer = TextBox.SelectionStart
+        IsTextChanging = True
+        SelectedItem = Nothing
+        Text = RawText
+        TextBox.SelectionStart = RawSelectionStart
+        IsTextChanging = False
     End Sub
 
     Public ReadOnly Property ContentPresenter As ContentPresenter
@@ -134,4 +134,48 @@
         End Get
     End Property
 
+    Private Sub MyComboBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles Me.SelectionChanged
+        If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent()
+    End Sub
+
+#Region "设置"
+
+    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
+        Dim TargetItem = Items.OfType(Of DependencyObject)().FirstOrDefault(Function(i) Val(If(SettingService.GetValue(i), -1)) = NewValue)
+        If TargetItem IsNot Nothing Then
+            SelectedItem = TargetItem
+        ElseIf Items.Count > NewValue Then
+            SelectedIndex = NewValue
+        Else
+            Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项", LogLevel.Debug)
+            SelectedIndex = -1
+            SelectedItem = Nothing
+            'Dim Key As String = SettingService.GetKey(Me)
+            'Dim DefaultValue = Settings.GetDefault(Key)
+            'If DefaultValue = NewValue Then
+            '    Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,这可能是因为程序版本太老了", LogLevel.Hint)
+            'Else
+            '    Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,已重置该设置", LogLevel.Debug)
+            '    Settings.Reset(Key)
+            '    RefreshSetting(DefaultValue)
+            'End If
+        End If
+    End Sub
+
+    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
+        If SelectedItem Is Nothing Then Return Nothing
+        If TypeOf SelectedItem Is DependencyObject Then
+            Return Val(If(SettingService.GetValue(SelectedItem), SelectedIndex))
+        Else
+            Return SelectedIndex
+        End If
+    End Function
+
+    Private Sub SaveSetting() Handles Me.SelectionChanged
+        If SelectedItem Is Nothing Then Return
+        SettingService.SaveSetting(Me)
+    End Sub
+
+#End Region
+
 End Class

+ 32 - 29
Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb

@@ -53,25 +53,26 @@
         Set(value As Boolean)
             If _Show = value Then Return
             _Show = value
-            RunInUi(Sub()
-                        If value Then
-                            '有了
-                            Visibility = Visibility.Visible
-                            AniStart({
-                                AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)),
-                                AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)),
-                                AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak))
-                            }, "MyExtraButton MainScale " & Uuid)
-                        Else
-                            '没了
-                            AniStart({
-                                AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)),
-                                AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()),
-                                AaCode(Sub() Visibility = Visibility.Collapsed,, True)
-                            }, "MyExtraButton MainScale " & Uuid)
-                        End If
-                        IsHitTestVisible = value '防止缩放动画中依然可以点进去
-                    End Sub)
+            RunInUi(
+            Sub()
+                If value Then
+                    '有了
+                    Visibility = Visibility.Visible
+                    AniStart({
+                        AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)),
+                        AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)),
+                        AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak))
+                    }, "MyExtraButton MainScale " & Uuid)
+                Else
+                    '没了
+                    AniStart({
+                        AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)),
+                        AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()),
+                        AaCode(Sub() Visibility = Visibility.Collapsed,, True)
+                    }, "MyExtraButton MainScale " & Uuid)
+                End If
+                IsHitTestVisible = value '防止缩放动画中依然可以点进去
+            End Sub)
         End Set
     End Property
     Public Delegate Function ShowCheckDelegate() As Boolean
@@ -137,6 +138,7 @@
                 AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
             }, "MyExtraButton Scale " & Uuid)
         End If
+        If IsLeftMouseHeld Then RaiseCustomEvent()
         IsLeftMouseHeld = False
         RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
     End Sub
@@ -199,16 +201,17 @@
     ''' 发出一圈波浪效果提示。
     ''' </summary>
     Public Sub Ribble()
-        RunInUi(Sub()
-                    Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
-                    Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
-                    PanScale.Children.Insert(0, Shape)
-                    AniStart({
-                       AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)),
-                       AaOpacity(Shape, -Shape.Opacity, 1000),
-                       AaCode(Sub() PanScale.Children.Remove(Shape), After:=True)
-                    }, "ExtraButton Ribble " & GetUuid())
-                End Sub)
+        RunInUi(
+        Sub()
+            Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
+            Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
+            PanScale.Children.Insert(0, Shape)
+            AniStart({
+                AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)),
+                AaOpacity(Shape, -Shape.Opacity, 1000),
+                AaCode(Sub() PanScale.Children.Remove(Shape), After:=True)
+            }, "ExtraButton Ribble " & GetUuid())
+        End Sub)
     End Sub
 
 End Class

+ 6 - 6
Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb

@@ -81,12 +81,12 @@ Public Class MyExtraTextButton
 
     '触发点击事件
     Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
-        If IsLeftMouseHeld Then
-            Log("[Control] 按下附加图标按钮:" & Text)
-            RaiseEvent Click(sender, e)
-            e.Handled = True
-            Button_LeftMouseUp()
-        End If
+        If Not IsLeftMouseHeld Then Return
+        Log("[Control] 按下附加图标按钮:" & Text)
+        RaiseEvent Click(sender, e)
+        e.Handled = True
+        RaiseCustomEvent()
+        Button_LeftMouseUp()
     End Sub
 
     '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)

+ 6 - 21
Plain Craft Launcher 2/Controls/MyHint.xaml.vb

@@ -99,21 +99,24 @@ Public Class MyHint
     End Property
     Public Property RelativeSetup As String = ""
     Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
-        If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
+        If CanClose AndAlso Settings.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
     End Sub
     Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
-        Setup.Set(RelativeSetup, True)
+        Settings.SetSafe(RelativeSetup, True)
         AniDispose(Me, False)
     End Sub
 
     '触发点击事件
+    Public Event Click(sender As Object, e As MouseButtonEventArgs)
     Private IsMouseDown As Boolean = False
     Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
         If Not IsMouseDown Then Return
         IsMouseDown = False
         Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
+        RaiseEvent Click(sender, e)
+        If e.Handled Then Return
         e.Handled = True
-        ModEvent.TryStartEvent(EventType, EventData)
+        RaiseCustomEvent() '自定义事件
     End Sub
     Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
         IsMouseDown = True
@@ -121,24 +124,6 @@ Public Class MyHint
     Private Sub MyHint_MouseLeave() Handles Me.MouseLeave
         IsMouseDown = False
     End Sub
-    Public Property EventType As String
-        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(MyHint), 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(MyHint), New PropertyMetadata(Nothing))
 
 End Class
 Partial Public Module ModAnimation

+ 3 - 24
Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb

@@ -48,36 +48,16 @@
         End Set
     End Property
 
-    '触发点击事件
+    '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
+    Private IsMouseDown As Boolean = False
     Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
         If Not IsMouseDown Then Return
         Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
         RaiseEvent Click(sender, e)
         e.Handled = True
         Button_MouseUp()
-        ModEvent.TryStartEvent(EventType, EventData)
+        RaiseCustomEvent() '自定义事件
     End Sub
-    Public Property EventType As String
-        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(MyIconButton), 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(MyIconButton), New PropertyMetadata(Nothing))
-
-    '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
-    Private IsMouseDown As Boolean = False
     Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
         IsMouseDown = True
         Focus()
@@ -102,7 +82,6 @@
         RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
     End Sub
 
-    '自定义事件
     '务必放在 IsMouseDown 更新之后
     Private Const AnimationColorIn As Integer = 120
     Private Const AnimationColorOut As Integer = 150

+ 1 - 22
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb

@@ -8,9 +8,6 @@ Public Class MyIconTextButton
     Public Uuid As Integer = GetUuid()
     Public Event Check(sender As Object, raiseByMouse As Boolean)
     Public Event Change(sender As Object, raiseByMouse As Boolean)
-    Public Sub RaiseChange()
-        RaiseEvent Change(Me, False)
-    End Sub '使外部程序可以引发本控件的 Change 事件
 
     '自定义属性
 
@@ -76,7 +73,7 @@ Public Class MyIconTextButton
         Log("[Control] 按下带图标按钮:" & Text)
         IsMouseDown = False
         RaiseEvent Click(Me, New RouteEventArgs(True))
-        ModEvent.TryStartEvent(EventType, EventData)
+        RaiseCustomEvent() '自定义事件
         RefreshColor()
     End Sub
     Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
@@ -87,24 +84,6 @@ Public Class MyIconTextButton
         IsMouseDown = False
         RefreshColor()
     End Sub
-    Public Property EventType As String
-        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(MyIconTextButton), 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(MyIconTextButton), New PropertyMetadata(Nothing))
 
     '动画
 

+ 26 - 59
Plain Craft Launcher 2/Controls/MyImage.vb

@@ -25,7 +25,7 @@
 
     ''' <summary>
     ''' 与 Image 的 Source 类似。
-    ''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。
+    ''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存。
     ''' 支持 WebP 格式的图片。
     ''' </summary>
     Public Shadows Property Source As String '覆写 Image 的 Source 属性
@@ -46,7 +46,7 @@
     Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
 
     ''' <summary>
-    ''' 当 Source 首次下载失败时,会从该备用地址加载图片。
+    ''' 若 Source 是一个网络图片,该地址将作为第二图片源。
     ''' </summary>
     Public Property FallbackSource As String
         Get
@@ -85,8 +85,8 @@
             If _ActualSource = value Then Return
             _ActualSource = value
             Try
-                Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
-                RunInUiWait(Sub() MyBase.Source = Bitmap)
+                Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
+                RunInUi(Sub() MyBase.Source = Bitmap)
             Catch ex As Exception
                 Log(ex, $"加载图片失败({value})")
                 Try
@@ -111,79 +111,46 @@
             Return
         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
+        Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串,避免冲突
+        Dim TempFile As New FileInfo(TempPath)
         If EnableCache AndAlso TempFile.Exists Then
-            ActualSource = TempPath
+            ActualSource = TempPath '显示缓存的图片
             If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
+        Else
+            ActualSource = LoadingSource '显示加载中图片
         End If
         RunInNewThread(
         Sub()
-            Dim TempDownloadingPath As String = Nothing
+            Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
             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)
-                    FileSystem.Rename(TempDownloadingPath, TempPath)
-                    RunInUi(Sub() ActualSource = TempPath)
-                Else
-                    '直接显示
-                    RunInUiWait(Sub() ActualSource = TempDownloadingPath)
-                    File.Delete(TempDownloadingPath)
-                End If
+                NetDownloadByLoader(
+                    If(FallbackSource IsNot Nothing AndAlso FallbackSource.StartsWithF("http") AndAlso Source <> FallbackSource,
+                        {Source, FallbackSource}, {Source}),
+                    TempPath, SimulateBrowserHeaders:=True)
+                ActualSource = TempPath
+                If Not EnableCache Then File.Delete(TempPath)
             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
-                        Return
-                    End If
-                    '本地图片
-                    If Not Url.StartsWithF("http") Then
-                        ActualSource = Url
+                '加载本地备用图片
+                If IsLocalFallback Then
+                    Try
+                        ActualSource = FallbackSource
+                        Log(ex, $"下载图片失败,使用本地备用图片({Source})")
                         Return
-                    End If
-                    '从缓存加载网络图片
-                    TempPath = GetTempPath(Url)
-                    TempFile = New FileInfo(TempPath)
-                    If EnableCache AndAlso TempFile.Exists() Then
-                        ActualSource = TempPath
-                        If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Return '无需刷新缓存
-                    End If
-                    '下载
-                    If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
-                    GoTo RetryStart
+                    Catch exx As Exception
+                        Log(ex, $"下载图片失败({Source})", LogLevel.Hint)
+                        Log(exx, $"加载备用图片失败({FallbackSource})", LogLevel.Hint)
+                    End Try
                 Else
-                    Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
+                    Log(ex, $"下载图片失败({Source},备用:{FallbackSource})", 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

+ 9 - 27
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb

@@ -396,6 +396,7 @@ Public Class MyListItem
                 Dim CheckedCount As Integer = 0
                 '收集控件列表与选中个数
                 For Each Control In CType(Parent, Object).Children
+                    Control = MyVirtualizingElement.TryInit(Control)
                     If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
                         RadioboxList.Add(Control)
                         If Control.Checked Then CheckedCount += 1
@@ -506,8 +507,8 @@ Public Class MyListItem
         RaiseEvent Click(sender, e)
         If e.Handled Then Return
         '触发自定义事件
-        If Not String.IsNullOrEmpty(EventType) Then
-            ModEvent.TryStartEvent(EventType, EventData)
+        If CustomEventService.GetEventType(sender) <> CustomEvent.EventType.None Then
+            RaiseCustomEvent()
             e.Handled = True
         End If
         If e.Handled Then Return
@@ -537,26 +538,6 @@ Public Class MyListItem
         If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
     End Sub
 
-    '实现自定义事件
-    Public Property EventType As String
-        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(MyListItem), 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(MyListItem), New PropertyMetadata(Nothing))
-
 #End Region
 
     Private StateLast As String
@@ -564,7 +545,7 @@ Public Class MyListItem
     Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
         '菜单虚拟化检测
         If ContentHandler IsNot Nothing Then
-            ContentHandler(sender, e)
+            ContentHandler(Me, e)
             ContentHandler = Nothing
         End If
         '判断当前颜色
@@ -657,13 +638,14 @@ Public Class MyListItem
             SetResourceReference(ForegroundProperty, "ColorBrush1")
         End If
         ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
-        If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
+        If CustomEventService.GetEventType(Me) = CustomEvent.EventType.打开帮助 AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
             Try
-                Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
+                Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
+                Entry.SetToListItem(Me)
             Catch ex As Exception
                 Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
-                EventType = Nothing
-                EventData = Nothing
+                CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
+                CustomEventService.SetEventData(Me, "")
             End Try
         End If
     End Sub

+ 24 - 29
Plain Craft Launcher 2/Controls/MyLoading.xaml.vb

@@ -79,11 +79,7 @@ Public Class MyLoading
                         Do While Ex.InnerException IsNot Nothing
                             Ex = Ex.InnerException
                         Loop
-                        LabText.Text = StrTrim(Ex.Message)
-                        If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
-                            "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
-                            LabText.Text = "网络环境不佳,请稍后重试,或使用 VPN 以改善网络环境"
-                        End If
+                        LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
                     End If
                 Else
                     LabText.Text = TextError
@@ -187,30 +183,29 @@ Public Class MyLoading
         IsLooping = True
         ErrorAnimationWaiting = True
         AniStart({
-                    AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
-                    AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
-                    AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
-                    AaCode(Sub()
-                               PathLeft.Opacity = 1
-                               PathLeft.Margin = New Thickness(7, 41, 0, 0)
-                               PathRight.Opacity = 1
-                               PathRight.Margin = New Thickness(14, 41, 0, 0)
-                               ErrorAnimationWaiting = False
-                           End Sub),
-                    AaOpacity(PathLeft, -1, 100, 50),
-                    AaX(PathLeft, -5, 180,, New AniEaseOutFluent),
-                    AaY(PathLeft, -6, 180,, New AniEaseOutFluent),
-                    AaOpacity(PathRight, -1, 100, 50),
-                    AaX(PathRight, 5, 180,, New AniEaseOutFluent),
-                    AaY(PathRight, -6, 180,, New AniEaseOutFluent),
-                    AaCode(Sub()
-                               IsLooping = False
-                               AniLoop()
-                           End Sub,, True)
-            }, "MyLoader Loop " & Uuid & "/" & GetUuid())
-        If ShowProgress Then
-
-        End If
+            AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
+            AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
+            AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
+            AaCode(
+            Sub()
+                PathLeft.Opacity = 1
+                PathLeft.Margin = New Thickness(7, 41, 0, 0)
+                PathRight.Opacity = 1
+                PathRight.Margin = New Thickness(14, 41, 0, 0)
+                ErrorAnimationWaiting = False
+            End Sub),
+            AaOpacity(PathLeft, -1, 100, 50),
+            AaX(PathLeft, -5, 180,, New AniEaseOutFluent),
+            AaY(PathLeft, -6, 180,, New AniEaseOutFluent),
+            AaOpacity(PathRight, -1, 100, 50),
+            AaX(PathRight, 5, 180,, New AniEaseOutFluent),
+            AaY(PathRight, -6, 180,, New AniEaseOutFluent),
+            AaCode(
+            Sub()
+                IsLooping = False
+                AniLoop()
+            End Sub,, True)
+        }, "MyLoader Loop " & Uuid & "/" & GetUuid())
     End Sub
 
     ''' <summary>

+ 4 - 1
Plain Craft Launcher 2/Controls/MyMenuItem.vb

@@ -7,7 +7,7 @@
             If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
         End If
         '对父级设置透明度
-        CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
+        CType(Parent, ContextMenu).Opacity = Settings.Get("UiLauncherTransparent") / 1000 + 0.4
     End Sub
 
     '基础
@@ -54,4 +54,7 @@
         End If
     End Sub
 
+    Private Sub MyMenuItem_Click(sender As Object, e As RoutedEventArgs) Handles Me.Click
+        RaiseCustomEvent()
+    End Sub
 End Class

+ 3 - 1
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb

@@ -21,7 +21,9 @@
             ShapeLine.StrokeThickness = GetWPFSize(1)
             '添加选择控件
             Btn1.IsEnabled = False
-            For Each Selection As IMyRadio In Converter.Content
+            For Each Content In Converter.Content
+                Content = MyVirtualizingElement.TryInit(Content)
+                Dim Selection As IMyRadio = Content
                 PanSelection.Children.Add(Selection)
                 AddHandler Selection.Check, AddressOf OnChecked
                 If TypeOf Selection Is MyListItem Then

+ 5 - 8
Plain Craft Launcher 2/Controls/MyPageLeft.vb

@@ -3,15 +3,15 @@
     Private Uuid As Integer = GetUuid()
 
     '执行逐个进入动画的控件
-    Public Property AnimatedControl As FrameworkElement
+    Public Property AnimatedControl As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
         Get
             Return GetValue(AnimatedControlProperty)
         End Get
-        Set(value As FrameworkElement)
+        Set(value As String)
             SetValue(AnimatedControlProperty, value)
         End Set
     End Property
-    Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing))
+    Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing))
 
     Public Sub TriggerShowAnimation()
         If AnimatedControl Is Nothing Then
@@ -30,6 +30,7 @@
             Dim AniList As New List(Of AniData)
             Dim Id As Integer = 0, Delay As Integer = 0
             For Each Element As FrameworkElement In GetAllAnimControls(True)
+                Element = MyVirtualizingElement.TryInit(Element)
                 If Element.Visibility = Visibility.Collapsed Then
                     '还原之前的隐藏动画可能导致的改变(#2436)
                     Element.Opacity = 1
@@ -84,7 +85,7 @@
     '遍历获取所有需要生成动画的控件
     Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
         Dim AllControls As New List(Of FrameworkElement)
-        GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
+        GetAllAnimControls(FindName(AnimatedControl), AllControls, IgnoreInvisibility)
         Return AllControls
     End Function
     Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
@@ -105,7 +106,3 @@
     End Sub
 
 End Class
-
-Public Interface IRefreshable
-    Sub Refresh()
-End Interface

+ 19 - 14
Plain Craft Launcher 2/Controls/MyPageRight.vb

@@ -3,16 +3,16 @@
     Public PageUuid As Integer = GetUuid()
 
     '“返回顶部” 按钮检测的滚动区域
-    Public Property PanScroll As MyScrollViewer
+    Public Property PanScroll As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
         Get
             Return GetValue(PanScrollProperty)
         End Get
-        Set(value As MyScrollViewer)
+        Set(value As String)
             SetValue(PanScrollProperty, value)
         End Set
     End Property
     Private Shared ReadOnly PanScrollProperty =
-        DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing))
+        DependencyProperty.Register("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing))
 
     '当前状态
     Public Enum PageStates
@@ -129,30 +129,31 @@
         RaiseEvent PageEnter()
         Select Case PageState
             Case PageStates.Empty
-                If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then
-                    '如果加载器在进入页面时不启动(例如 HiPer 联机),那么在此时就会有 State = Waiting
+                If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
+                    '如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting
                     PageState = PageStates.ContentEnter
                     TriggerEnterAnimation(PanAlways, If(PanContent, Child))
                 ElseIf PageLoader.State = LoadState.Loading Then
                     PageState = PageStates.LoaderWait
-                    AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
+                    AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
                 Else 'PageLoader.State = LoadState.Failed
                     PageState = PageStates.LoaderEnter
                     TriggerEnterAnimation(PanAlways, PanLoader)
                 End If
             Case PageStates.ContentExit
                 '和上面的一样,但是不管 PanAlways
-                If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then
+                If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
                     PageState = PageStates.ContentEnter
                     TriggerEnterAnimation(If(PanContent, Child))
                 ElseIf PageLoader.State = LoadState.Loading Then
                     PageState = PageStates.LoaderWait
-                    AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
+                    AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
                 Else 'PageLoader.State = LoadState.Failed
                     PageState = PageStates.LoaderEnter
                     TriggerEnterAnimation(PanLoader)
                 End If
-            Case PageStates.ContentEnter '重复调用 PageOnEnter,直接忽略
+            Case PageStates.ContentEnter
+                '重复调用 PageOnEnter,直接忽略
             Case Else
                 Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
         End Select
@@ -207,8 +208,8 @@
     Public Sub PageOnContentExit()
         If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
         If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
-            Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
             'Loading 的加载器可能触发进一步变化,难以预测会触发子页面的动画还是加载器完成的动画
+            Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
         End If
         Select Case PageState
             Case PageStates.ContentEnter, PageStates.ContentStay
@@ -219,8 +220,12 @@
             Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay
                 PageState = PageStates.ContentExit
                 TriggerExitAnimation(PanLoader)
-            Case PageStates.LoaderWait, PageStates.Empty
+            Case PageStates.LoaderWait
                 PageOnEnter()
+            Case PageStates.Empty
+                '可能是在离开页面后,其他后台线程调用了本函数,此时不应触发 PageOnEnter()
+                '例如:在加入联机房间后,切换到其他页面,然后联机房间被解散
+                If IsLoaded Then PageOnEnter()
         End Select
     End Sub
 
@@ -313,9 +318,9 @@
                     Case PageStates.LoaderExit
                         PageState = PageStates.ContentExit
                 End Select
-            Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting
+            Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
                 If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
-                If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
+                If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Interrupt)")
                 '运行结束
                 '需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
                 Select Case PageState
@@ -373,7 +378,7 @@
         End If
         '结束
         AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
-        AniStart(AniList, "PageRight PageChange " & PageUuid)
+        AniStart(AniList, "PageRight PageChange " & PageUuid, True)
     End Sub
 
     '逐个退出动画

+ 33 - 16
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb

@@ -2,7 +2,7 @@
 
 <ContentProperty("Inlines")>
 Public Class MyRadioBox
-    Implements IMyRadio
+    Implements IMyRadio, ISettingControl
 
     '基础
 
@@ -89,14 +89,15 @@ Public Class MyRadioBox
                     End If
             End Select
 
-            '触发事件
             If IsChanged Then
+                '触发事件
                 If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
                 RaiseEvent Changed(Me, New RouteEventArgs(user))
+                RaiseCustomEvent()
+                '更改动画
+                SyncUI()
             End If
 
-            '更改动画
-            SyncUI()
         Catch ex As Exception
             Log(ex, "单选框勾选改变错误", LogLevel.Hint)
         End Try
@@ -115,7 +116,7 @@ Public Class MyRadioBox
                           AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
                      }, "MyRadioBox Dot " & Uuid)
                 AniStart({
-                          AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
+                          AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray5")), AnimationTimeOfCheck)
                      }, "MyRadioBox BorderColor " & Uuid)
             Else
                 '由有变无
@@ -127,7 +128,7 @@ Public Class MyRadioBox
                           AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
                      }, "MyRadioBox Dot " & Uuid)
                 AniStart({
-                          AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
+                          AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray5")), AnimationTimeOfCheck)
                      }, "MyRadioBox BorderColor " & Uuid)
             End If
         Else
@@ -140,13 +141,13 @@ Public Class MyRadioBox
                 ShapeDot.Height = 9
                 ShapeDot.Opacity = 1
                 ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
-                ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
+                ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
             Else
                 ShapeDot.Width = 0
                 ShapeDot.Height = 0
                 ShapeDot.Opacity = 0
                 ShapeDot.Margin = New Thickness(10, 0, 0, 0)
-                ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
+                ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
             End If
         End If
     End Sub
@@ -208,15 +209,15 @@ Public Class MyRadioBox
                 Radiobox_MouseLeaveAnimation()
             Else
                 '不可用
-                AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray4 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
-                AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
+                AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray5 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
+                AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
             End If
         Else
             '无动画
             AniStop("MyRadioBox BorderColor " & Uuid)
             AniStop("MyRadioBox TextColor " & Uuid)
-            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
-            ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
+            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
+            ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
         End If
     End Sub
     Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -226,14 +227,30 @@ Public Class MyRadioBox
     Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
         If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
         If IsLoaded AndAlso AniControlEnabled = 0 Then
-            AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
-            AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
+            AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
+            AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
         Else
             AniStop("MyRadioBox BorderColor " & Uuid)
             AniStop("MyRadioBox TextColor " & Uuid)
-            ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
-            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
+            ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
+            LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
         End If
     End Sub
 
+#Region "设置"
+
+    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
+        Checked = NewValue = SettingService.GetValue(Me)
+    End Sub
+
+    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
+        Return If(Checked, SettingService.GetValue(Me), Nothing)
+    End Function
+
+    Private Sub SaveSetting() Handles Me.Check
+        SettingService.SaveSetting(Me)
+    End Sub
+
+#End Region
+
 End Class

+ 6 - 10
Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb

@@ -7,10 +7,6 @@ Public Class MyRadioButton
 
     Public Uuid As Integer = GetUuid()
     Public Event Check(sender As Object, raiseByMouse As Boolean)
-    Public Event Change(sender As Object, raiseByMouse As Boolean)
-    Public Sub RaiseChange()
-        RaiseEvent Change(Me, False)
-    End Sub '使外部程序可以引发本控件的 Change 事件
 
     '自定义属性
 
@@ -46,23 +42,22 @@ Public Class MyRadioButton
     ''' 手动设置 Checked 属性。
     ''' </summary>
     ''' <param name="value">新的 Checked 属性。</param>
-    ''' <param name="user">是否由用户引发。</param>
+    ''' <param name="raiseByMouse">是否由用户引发。</param>
     ''' <param name="anime">是否执行动画。</param>
-    Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
+    Public Sub SetChecked(value As Boolean, raiseByMouse As Boolean, anime As Boolean)
         Try
 
             '自定义属性基础
 
             Dim IsChanged As Boolean = False
-            If IsLoaded AndAlso Not value = _Checked Then RaiseEvent Change(Me, user)
-            If Not value = _Checked Then
+            If _Checked <> value Then
                 _Checked = value
                 IsChanged = True
             End If
 
             '保证只有一个单选框选中
 
-            If IsNothing(Parent) Then Return
+            If Parent Is Nothing Then Return
             Dim RadioboxList As New List(Of MyRadioButton)
             Dim CheckedCount As Integer = 0
             '收集控件列表与选中个数
@@ -105,7 +100,8 @@ Public Class MyRadioButton
             RefreshColor(Nothing, anime)
 
             '触发事件
-            If Checked Then RaiseEvent Check(Me, user)
+            If Checked Then RaiseEvent Check(Me, raiseByMouse)
+            RaiseCustomEvent()
 
         Catch ex As Exception
             Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)

+ 3 - 0
Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb

@@ -39,4 +39,7 @@
         TextBox.Focus()
     End Sub
 
+    Private Sub MySearchBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
+        If e.Key = Key.Enter Then RaiseCustomEvent()
+    End Sub
 End Class

+ 17 - 0
Plain Craft Launcher 2/Controls/MySlider.xaml.vb

@@ -1,4 +1,5 @@
 Public Class MySlider
+    Implements ISettingControl
 
     '基础
 
@@ -188,4 +189,20 @@
         End If
     End Sub
 
+#Region "设置"
+
+    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
+        Value = Val(NewValue)
+    End Sub
+
+    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
+        Return Value
+    End Function
+
+    Private Sub SaveSetting() Handles Me.Change
+        SettingService.SaveSetting(Me)
+    End Sub
+
+#End Region
+
 End Class

+ 30 - 2
Plain Craft Launcher 2/Controls/MyTextBox.vb

@@ -1,5 +1,6 @@
 Public Class MyTextBox
     Inherits TextBox
+    Implements ISettingControl
 
     '自定义属性
 
@@ -44,7 +45,13 @@
 
     Public Uuid As Integer = GetUuid()
     Public Shared Event ValidateChanged(sender As Object, e As EventArgs)
-    Public ChangedEventList As New List(Of RoutedEventHandler)
+    Private _ChangedEventList As List(Of RoutedEventHandler)
+    Public ReadOnly Property ChangedEventList As List(Of RoutedEventHandler)
+        Get
+            If _ChangedEventList Is Nothing Then _ChangedEventList = New List(Of RoutedEventHandler)
+            Return _ChangedEventList
+        End Get
+    End Property
     Public Custom Event ValidatedTextChanged As RoutedEventHandler
         AddHandler(value As RoutedEventHandler)
             ChangedEventList.Add(value)
@@ -264,7 +271,7 @@
             If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
                 '有动画
                 AniStart({
-                         AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
+                         AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
                          AaColor(Me, BackgroundProperty, BackColorName, AnimationTime)
                      }, "MyTextBox Color " & Uuid)
             Else
@@ -291,4 +298,25 @@
         End If
     End Sub
 
+    '在按下回车时触发自定义事件
+    Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
+        If e.Key = Key.Enter Then RaiseCustomEvent()
+    End Sub
+
+#Region "设置"
+
+    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
+        Text = NewValue
+    End Sub
+
+    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
+        Return Text
+    End Function
+
+    Private Sub SaveSetting() Handles Me.ValidatedTextChanged
+        SettingService.SaveSetting(Me)
+    End Sub
+
+#End Region
+
 End Class

+ 16 - 39
Plain Craft Launcher 2/Controls/MyTextButton.vb

@@ -22,15 +22,15 @@
         End Set
     End Property
     Public Shared ReadOnly TextProperty As DependencyProperty =
-        DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("", Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
-                                                                                                                 If Not e.OldValue = e.NewValue Then
-                                                                                                                     AniStart({
-                                                                                                                              AaOpacity(sender, -sender.Opacity, 50),
-                                                                                                                              AaCode(Sub() sender.Content = e.NewValue,, True),
-                                                                                                                              AaOpacity(sender, 1, 170)
-                                                                                                                        }, "MyTextButton Text " & sender.Uuid)
-                                                                                                                 End If
-                                                                                                             End Sub))
+        DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("",
+        Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
+            If e.OldValue = e.NewValue Then Return
+            AniStart({
+                AaOpacity(sender, -sender.Opacity, 50),
+                AaCode(Sub() sender.Content = e.NewValue,, True),
+                AaOpacity(sender, 1, 170)
+            }, "MyTextButton Text " & sender.Uuid)
+        End Sub))
 
     '鼠标事件
 
@@ -43,13 +43,12 @@
         IsMouseDown = False
     End Sub
     Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
-        If IsMouseDown Then
-            IsMouseDown = False
-            Log("[Control] 按下文本按钮:" & Text)
-            RaiseEvent Click(Me, Nothing)
-            ModEvent.TryStartEvent(EventType, EventData)
-            e.Handled = True
-        End If
+        If Not IsMouseDown Then Return
+        IsMouseDown = False
+        Log("[Control] 按下文本按钮:" & Text)
+        RaiseEvent Click(Me, Nothing)
+        RaiseCustomEvent()
+        e.Handled = True
     End Sub
 
     '指向动画
@@ -57,7 +56,7 @@
     Private Const AnimationTimeIn As Integer = 100
     Private Const AnimationTimeOut As Integer = 200
     Private ColorName As String
-    Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
+    Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
         '判断当前颜色
         Dim ForeName As String
         Dim Time As Integer
@@ -85,26 +84,4 @@
         End If
     End Sub
 
-    '实现自定义事件
-    Public Property EventType As String
-        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 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))
-
 End Class

+ 70 - 0
Plain Craft Launcher 2/Controls/MyVirtualizingElement.vb

@@ -0,0 +1,70 @@
+Public Class MyVirtualizingElement(Of T As FrameworkElement)
+    Inherits FrameworkElement
+
+    Private Initializer As Func(Of T)
+    Public Sub New(Initializer As Func(Of T))
+        Me.Initializer = Initializer
+        LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
+    End Sub
+
+    ''' <summary>
+    ''' 实例化此控件。
+    ''' </summary>
+    Public Function Init() As T
+        Dim Element As T = Initializer()
+        If Parent IsNot Nothing Then
+            If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
+            Dim ParentPanel As Panel = Parent
+            Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
+            ParentPanel.Children.RemoveAt(CurrentIndex)
+            ParentPanel.Children.Insert(CurrentIndex, Element)
+        End If
+        Return Element
+    End Function
+    Public Shared Widening Operator CType(Virtualized As MyVirtualizingElement(Of T)) As T
+        Return Virtualized.Init()
+    End Operator
+
+End Class
+
+'非泛型形式
+Public Class MyVirtualizingElement
+    Inherits FrameworkElement
+
+    Private Initializer As Func(Of FrameworkElement)
+    Public Sub New(Initializer As Func(Of FrameworkElement))
+        Me.Initializer = Initializer
+        LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
+    End Sub
+
+    ''' <summary>
+    ''' 实例化此控件。
+    ''' </summary>
+    Public Function Init() As FrameworkElement
+        Dim Element As FrameworkElement = Initializer()
+        If Parent IsNot Nothing Then
+            If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
+            Dim ParentPanel As Panel = Parent
+            Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
+            ParentPanel.Children.RemoveAt(CurrentIndex)
+            ParentPanel.Children.Insert(CurrentIndex, Element)
+        End If
+        Return Element
+    End Function
+
+    ''' <summary>
+    ''' 获取实例化后的控件。
+    ''' 如果该控件没有实例化,则会立即实例化。
+    ''' 如果类型错误,则返回原值。
+    ''' </summary>
+    Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
+        If GetType(MyVirtualizingElement(Of )).IsInstanceOfGenericType(Element) Then
+            Return CType(Element, Object).Init()
+        ElseIf TypeOf Element Is MyVirtualizingElement Then
+            Return CType(Element, MyVirtualizingElement).Init()
+        Else
+            Return Element
+        End If
+    End Function
+
+End Class

+ 2 - 1
Plain Craft Launcher 2/FormMain.xaml

@@ -95,7 +95,8 @@
                     <RowDefinition Height="Auto" />
                     <RowDefinition />
                 </Grid.RowDefinitions>
-                <Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality" />
+                <Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality"
+                        HorizontalAlignment="Stretch" VerticalAlignment="Stretch" />
                 <Grid x:Name="PanTitle" Height="48">
                     <Grid.Background>
                         <LinearGradientBrush EndPoint="1,0" StartPoint="0,0">

Разница между файлами не показана из-за своего большого размера
+ 475 - 235
Plain Craft Launcher 2/FormMain.xaml.vb


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


+ 52 - 45
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb

@@ -8,7 +8,12 @@ Public Module ModAnimation
     ''' <summary>
     ''' 动画速度。最大为 200。
     ''' </summary>
-    Public AniSpeed As Double = 1
+    Public ReadOnly Property AniSpeed As Double
+        Get
+            Dim Setting = PCL.Settings.Get("SystemDebugAnim")
+            Return If(Setting >= 30, 200, MathClamp(Setting * 0.1 + 0.1, 0.1, 3))
+        End Get
+    End Property
     ''' <summary>
     ''' 动画组列表。
     ''' </summary>
@@ -467,7 +472,7 @@ Public Module ModAnimation
     ''' 按照 WPF 方式旋转控件的动画。
     ''' </summary>
     ''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param>
-    ''' <param name="Value">大小改变的百分比(如-0.6)。</param>
+    ''' <param name="Value">旋转角度(度)。</param>
     ''' <param name="Time">动画长度(毫秒)。</param>
     ''' <param name="Delay">动画延迟执行的时间(毫秒)。</param>
     ''' <param name="Ease">插值器类型。</param>
@@ -743,9 +748,9 @@ Public Module ModAnimation
     ''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param>
     ''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param>
     Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
-        If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟,导致动画突然结束
+        If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟,导致动画突然结束
         '添加到正在执行的动画组
-        Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()}
+        Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeMs()}
         If Name = "" Then
             Name = NewEntry.Uuid
         Else
@@ -788,48 +793,50 @@ Public Module ModAnimation
     ''' </summary>
     Public Sub AniStart()
         '初始化计时器
-        AniLastTick = GetTimeTick()
+        AniLastTick = GetTimeMs()
         AniFPSTimer = AniLastTick
         AniRunning = True '标记动画执行开始
 
-        RunInNewThread(Sub()
-                           Try
-                               Log("[Animation] 动画线程开始")
-                               Do While True
-                                   '两帧之间的间隔时间
-                                   Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
-                                   If DeltaTime < 3 Then GoTo Sleeper
-                                   AniLastTick = GetTimeTick()
-                                   '记录 FPS
-                                   If ModeDebug Then
-                                       If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
-                                           AniFPS = AniFPSCounter
-                                           AniFPSCounter = 0
-                                           AniFPSTimer = AniLastTick
-                                       End If
-                                       AniFPSCounter += 2
-                                   End If
-                                   '执行动画
-                                   RunInUiWait(Sub()
-                                                   AniCount = 0
-                                                   AniTimer(DeltaTime * AniSpeed)
-                                                   '#If DEBUG Then
-                                                   '    FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
-                                                   '#Else
-                                                   '    If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
-                                                   '#End If
-                                                   If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
-                                                       Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "(" & GetString(NetManager.Speed) & "/s)")
-                                                   End If
-                                               End Sub)
+        RunInNewThread(
+        Sub()
+            Try
+                Log("[Animation] 动画线程开始")
+                Do While True
+                    '两帧之间的间隔时间
+                    Dim DeltaTime As Long = MathClamp(GetTimeMs() - AniLastTick, 0, 100000)
+                    If DeltaTime < 3 Then GoTo Sleeper
+                    AniLastTick = GetTimeMs()
+                    '记录 FPS
+                    If ModeDebug Then
+                        If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
+                            AniFPS = AniFPSCounter
+                            AniFPSCounter = 0
+                            AniFPSTimer = AniLastTick
+                        End If
+                        AniFPSCounter += 2
+                    End If
+                    '执行动画
+                    RunInUiWait(
+                    Sub()
+                        AniCount = 0
+                        AniTimer(DeltaTime * AniSpeed)
+                        '#If DEBUG Then
+                        '    FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
+                        '#Else
+                        '    If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
+                        '#End If
+                        If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
+                            Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "(" & GetString(NetManager.Speed) & "/s)")
+                        End If
+                    End Sub)
 Sleeper:
-                                   '控制 FPS
-                                   Thread.Sleep(1)
-                               Loop
-                           Catch ex As Exception
-                               Log(ex, "动画帧执行失败", LogLevel.Critical)
-                           End Try
-                       End Sub, "Animation", ThreadPriority.AboveNormal)
+                    '控制 FPS
+                    Thread.Sleep(1)
+                Loop
+            Catch ex As Exception
+                Log(ex, "动画帧执行失败", LogLevel.Critical)
+            End Try
+        End Sub, "Animation", ThreadPriority.AboveNormal)
     End Sub
 
     ''' <summary>
@@ -838,7 +845,7 @@ Sleeper:
     Public Sub AniTimer(DeltaTick As Integer)
         Try
 
-            If DeltaTick / AniSpeed > 200 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
+            If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
             Dim i As Integer = -1
             '循环每个动画组
             Do While i + 1 < AniGroups.Count
@@ -996,7 +1003,7 @@ NextAni:
                 Case AniType.ScaleTransform
                     Dim Obj As FrameworkElement = Ani.Obj
                     If TypeOf Obj.RenderTransform IsNot ScaleTransform Then
-                        Obj.RenderTransformOrigin = New Point(0.5, 0.5)
+                        If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
                         Obj.RenderTransform = New ScaleTransform(1, 1)
                     End If
                     Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
@@ -1006,7 +1013,7 @@ NextAni:
                 Case AniType.RotateTransform
                     Dim Obj As FrameworkElement = Ani.Obj
                     If TypeOf Obj.RenderTransform IsNot RotateTransform Then
-                        Obj.RenderTransformOrigin = New Point(0.5, 0.5)
+                        If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
                         Obj.RenderTransform = New RotateTransform(0)
                     End If
                     Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))

Разница между файлами не показана из-за своего большого размера
+ 315 - 227
Plain Craft Launcher 2/Modules/Base/ModBase.vb


+ 73 - 54
Plain Craft Launcher 2/Modules/Base/ModLoader.vb

@@ -8,6 +8,7 @@
         Implements ILoadingTrigger
 
         Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader
+        Protected Shared LogBlackList As String() = {"EasyTier CLI"}
 
         '基础属性
         ''' <summary>
@@ -87,9 +88,9 @@
             Set(value As LoadState)
                 If _State = value Then Return
                 Dim OldState = _State
-                If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
+                If value = LoadState.Finished AndAlso Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
                 _State = value
-                Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
+                If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变:{GetStringFromEnum(value)}")
                 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
                 RunInUi(
                 Sub()
@@ -148,7 +149,7 @@
                     Case LoadState.Waiting
                         Return 0
                     Case LoadState.Loading
-                        Return If(_Progress = -1, 0.02, _Progress)
+                        Return If(_Progress = -1, 0, _Progress)
                     Case Else
                         Return 1
                 End Select
@@ -169,7 +170,8 @@
 
         '状态变化
         Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
-        Public MustOverride Sub Abort()
+        Public MustOverride Sub Interrupt()
+        Public MustOverride Sub Failed(Ex As Exception)
 
         '等待结束
         Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -185,7 +187,7 @@
             Loop
             If State = LoadState.Finished Then
                 Return
-            ElseIf State = LoadState.Aborted Then
+            ElseIf State = LoadState.Interrupted Then
                 Throw New ThreadInterruptedException("加载器执行已中断。")
             ElseIf IsNothing([Error]) Then
                 Throw New Exception("未知错误!")
@@ -208,7 +210,7 @@
             Loop
             If State = LoadState.Finished Then
                 Return
-            ElseIf State = LoadState.Aborted Then
+            ElseIf State = LoadState.Interrupted Then
                 Throw New ThreadInterruptedException("加载器执行已中断。")
             ElseIf IsNothing([Error]) Then
                 Throw New Exception("未知错误!")
@@ -239,16 +241,16 @@
         ''' <summary>
         ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。
         ''' </summary>
-        Public ReadOnly Property IsAborted As Boolean
+        Public ReadOnly Property IsInterrupted As Boolean
             Get
-                Return IsAbortedWithThread(Thread.CurrentThread)
+                Return IsInterruptedWithThread(Thread.CurrentThread)
             End Get
         End Property
         ''' <summary>
         ''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。
         ''' </summary>
-        Public Function IsAbortedWithThread(Thread As Thread) As Boolean
-            Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted
+        Public Function IsInterruptedWithThread(Thread As Thread) As Boolean
+            Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted
         End Function
         ''' <summary>
         ''' 在输入相同时使用原有结果的超时,单位为毫秒。
@@ -290,18 +292,20 @@
             '检验输入以确定情况
             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 '则不重试
+
+            If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
+               (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
+               LastFinishedTime = 0 OrElse GetTimeMs() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
+                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)
             '确认是否开始加载
             If ShouldStart(Input, IsForceRestart) Then
                 '输入不同或失败,开始加载
-                If State = LoadState.Loading Then TriggerThreadAbort()
+                If State = LoadState.Loading Then TriggerThreadInterrupt()
                 Me.Input = Input
                 SyncLock LockState
                     State = LoadState.Loading
@@ -315,44 +319,57 @@
             Sub()
                 Try
                     IsForceRestarting = IsForceRestart
-                    If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
+                    If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
                     LoadDelegate(Me)
-                    If IsAborted Then
+                    If IsInterrupted Then
                         Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
                         Return
                     End If
-                    If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
+                    If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
                     RaisePreviewFinish()
                     State = LoadState.Finished
-                    LastFinishedTime = GetTimeTick() '未中断,本次输出有效
+                    LastFinishedTime = GetTimeMs() '未中断,本次输出有效
                 Catch ex As CancelledException
                     If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
-                    If Not IsAborted Then State = LoadState.Aborted
+                    If Not IsInterrupted Then State = LoadState.Interrupted
                 Catch ex As ThreadInterruptedException
                     If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
-                    '如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted
-                    '如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
-                    If Not IsAborted Then State = LoadState.Aborted
+                    '如果线程是因为判断到 IsInterrupted 而提前中止,则代表已有新线程被重启,此时不应当改为 Interrupted
+                    '如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Interrupted
+                    If Not IsInterrupted Then State = LoadState.Interrupted
                 Catch ex As Exception
-                    If IsAborted Then Return
-                    Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
-                    [Error] = ex
-                    State = LoadState.Failed
+                    Failed(ex)
                 End Try
-            End Sub) With {.Name = Name, .Priority = ThreadPriority}
-            LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
+            End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
+            Try
+                LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsInterrupted
+            Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
+                Thread.Sleep(500)
+                LastRunningThread.Start()
+            End Try
+        End Sub
+        Public Overrides Sub Failed(ex As Exception)
+            [Error] = ex
+            SyncLock LockState
+                If IsInterrupted OrElse State >= LoadState.Finished Then Return
+                State = LoadState.Failed
+            End SyncLock
+            Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
+            TriggerThreadInterrupt()
         End Sub
-        Public Overrides Sub Abort()
-            If State <> LoadState.Loading Then Return
+        Public Overrides Sub Interrupt()
             SyncLock LockState
-                State = LoadState.Aborted
+                If State <> LoadState.Loading Then Return
+                State = LoadState.Interrupted
             End SyncLock
-            TriggerThreadAbort()
+            TriggerThreadInterrupt()
         End Sub
-        Private Sub TriggerThreadAbort()
+        Private Sub TriggerThreadInterrupt()
             If LastRunningThread Is Nothing Then Return
-            If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
-            If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
+            If LastRunningThread.IsAlive Then
+                LastRunningThread.Interrupt()
+                If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
+            End If
             LastRunningThread = Nothing
         End Sub
 
@@ -434,11 +451,11 @@
             End If
             RunInThread(AddressOf Update)
         End Sub
-        Public Overrides Sub Abort()
+        Public Overrides Sub Interrupt()
             '改变状态
             SyncLock LockState
                 If State = LoadState.Loading OrElse State = LoadState.Waiting Then
-                    State = LoadState.Aborted
+                    State = LoadState.Interrupted
                 Else
                     Return
                 End If
@@ -447,10 +464,21 @@
             Sub()
                 '中断加载器
                 For Each Loader In Loaders
-                    Loader.Abort()
+                    Loader.Interrupt()
                 Next
             End Sub)
         End Sub
+        Public Overrides Sub Failed(Ex As Exception)
+            [Error] = Ex '先设置错误再调整状态,防止父加载器获取不到异常
+            SyncLock LockState
+                If State >= LoadState.Finished Then Return
+                State = LoadState.Failed
+            End SyncLock
+            For Each Loader In Loaders
+                Loader.Interrupt()
+            Next
+            FrmMain.BtnExtraDownload.ShowRefresh()
+        End Sub
 
         ''' <summary>
         ''' 子任务状态变更。
@@ -465,28 +493,19 @@
                 Case LoadState.Finished
                     '正常结束,触发刷新
                     Update()
-                Case LoadState.Aborted
+                Case LoadState.Interrupted
                     '被中断,这个任务也中断
-                    Abort()
-                Case Else
+                    Interrupt()
+                Case LoadState.Failed
                     '完蛋,出错了
-                    SyncLock LockState
-                        If State >= LoadState.Finished Then Return
-                        [Error] = New Exception(Loader.Name & "失败", Loader.Error)
-                        State = Loader.State
-                    End SyncLock
-                    For Each Loader In Loaders
-                        Loader.Abort()
-                    Next
-                    FrmMain.BtnExtraDownload.ShowRefresh()
-                    Return
+                    Failed(New Exception(Loader.Name & "失败", Loader.Error))
             End Select
         End Sub
         ''' <summary>
         ''' 触发一次更新,以启动新加载器或完成。
         ''' </summary>
         Private Sub Update()
-            If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Return
+            If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Interrupted Then Return
             Dim IsFinished As Boolean = True
             Dim Blocked As Boolean = False
             Dim Input As Object = Me.Input
@@ -588,7 +607,7 @@ Restart:
             '若单个任务已中止,或全部任务已完成,则刷新并移除
             For Each Task In LoaderTaskbar
                 If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
-                   (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Aborted) Then
+                   (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
                     FrmSpeedLeft?.TaskRefresh(Task)
                     LoaderTaskbar.Remove(Task)
                     Log($"[Taskbar] {Task.Name} 已移出任务列表")

Разница между файлами не показана из-за своего большого размера
+ 308 - 506
Plain Craft Launcher 2/Modules/Base/ModNet.vb


+ 47 - 21
Plain Craft Launcher 2/Modules/Base/ModValidate.vb

@@ -114,10 +114,10 @@ Public Class ValidateInteger
     End Sub
     Public Overrides Function Validate(Str As String) As String
         If Str.Length > 9 Then Return "请输入一个大小合理的数字!"
-        Dim Valed As Integer = Val(Str)
-        If Valed.ToString <> Str Then Return "请输入一个整数!"
-        If Val(Str) > Max Then Return "不可超过 " & Max & "!"
-        If Val(Str) < Min Then Return "不可低于 " & Min & "!"
+        Dim Valed As Integer
+        If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数!"
+        If Valed > Max Then Return "不可超过 " & Max & "!"
+        If Valed < Min Then Return "不可低于 " & Min & "!"
         Return ""
     End Function
 End Class
@@ -148,7 +148,7 @@ End Class
 ''' </summary>
 Public Class ValidateExcept
     Inherits Validate
-    Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
+    Public Property Excepts As New ObjectModel.Collection(Of String)
     Public Property ErrorMessage As String
     Public Sub New()
         ErrorMessage = "输入内容不能包含 %"
@@ -157,12 +157,15 @@ Public Class ValidateExcept
         Me.Excepts = Excepts
         Me.ErrorMessage = ErrorMessage
     End Sub
-    Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %")
-        Me.Excepts = New ObjectModel.Collection(Of String)
-        Me.ErrorMessage = ErrorMessage
-        For Each Data As String In Excepts
-            Me.Excepts.Add(Data)
-        Next
+    Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
+        Me.New(
+            New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
+            ErrorMessage)
+    End Sub
+    Public Sub New(Excepts As IEnumerable(Of Char), Optional ErrorMessage As String = "输入内容不能包含 %")
+        Me.New(
+            New ObjectModel.Collection(Of String)(Excepts.Select(Function(c) c.ToString).ToList),
+            ErrorMessage)
     End Sub
     Public Overrides Function Validate(Str As String) As String
         For Each Ch As String In Excepts
@@ -181,7 +184,7 @@ End Class
 ''' </summary>
 Public Class ValidateExceptSame
     Inherits Validate
-    Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
+    Public Property Excepts As New ObjectModel.Collection(Of String)
     Public Property ErrorMessage As String
     Public Property IgnoreCase As Boolean = False
     Public Sub New()
@@ -191,19 +194,21 @@ Public Class ValidateExceptSame
         Me.ErrorMessage = ErrorMessage
         Me.IgnoreCase = IgnoreCase
     End Sub
-    Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
-        Me.Excepts = New ObjectModel.Collection(Of String)
-        For Each Data As String In Excepts
-            Me.Excepts.Add(Data)
-        Next
-        Me.ErrorMessage = ErrorMessage
-        Me.IgnoreCase = IgnoreCase
+    Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
+        Me.New(
+            New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
+            ErrorMessage, IgnoreCase)
+    End Sub
+    Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
+        Me.New(
+            New ObjectModel.Collection(Of String) From {Except},
+            ErrorMessage, IgnoreCase)
     End Sub
     Public Overrides Function Validate(Str As String) As String
         If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")
         For Each Ch As String In Excepts
             If IgnoreCase Then
-                If Str.ToLower = Ch.ToLower Then Return ErrorMessage.Replace("%", Ch)
+                If Str.Lower = Ch.Lower Then Return ErrorMessage.Replace("%", Ch)
             Else
                 If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写
             End If
@@ -213,6 +218,27 @@ Public Class ValidateExceptSame
 
 End Class
 
+''' <summary>
+''' 必须为特定字符串。
+''' </summary>
+Public Class ValidateSame
+    Inherits Validate
+    Public Property Required As String
+    Public Property ErrorMessage As String
+    Public Property IgnoreCase As Boolean = False
+    Public Sub New()
+    End Sub
+    Public Sub New(Required As String, Optional ErrorMessage As String = "输入内容有误", Optional IgnoreCase As Boolean = False)
+        Me.Required = Required
+        Me.ErrorMessage = ErrorMessage
+        Me.IgnoreCase = IgnoreCase
+    End Sub
+    Public Overrides Function Validate(Str As String) As String
+        Return If(String.Compare(Str, Required, IgnoreCase) = 0, "", ErrorMessage)
+    End Function
+
+End Class
+
 ''' <summary>
 ''' 对文件夹名的粗略的特化检测。
 ''' </summary>
@@ -350,7 +376,7 @@ Public Class ValidateFolderPath
         '检查开头
         If Str.StartsWithF("\\Mac\") Then GoTo Fin
         For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
-            If Str.ToUpper = Drive.Name Then Return ""
+            If Str.Upper = Drive.Name Then Return ""
             If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
         Next
         Return "文件夹路径头存在错误!"

+ 19 - 16
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb

@@ -4,11 +4,6 @@ Imports System.Drawing.Imaging
 
 Public Class MyBitmap
 
-    ''' <summary>
-    ''' 位图缓存。
-    ''' </summary>
-    Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
-
     ''' <summary>
     ''' 存储的图片
     ''' </summary>
@@ -30,14 +25,17 @@ Public Class MyBitmap
     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)
+        Dim BitmapPic As System.Drawing.Bitmap = Image.Pic
+        Dim rect = New System.Drawing.Rectangle(0, 0, BitmapPic.Width, BitmapPic.Height)
+        Dim bitmapData = BitmapPic.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
         Try
-            Dim size = rect.Width * rect.Height * 4
-            Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride)
+            Dim Result = BitmapSource.Create(BitmapPic.Width, BitmapPic.Height, BitmapPic.HorizontalResolution, BitmapPic.VerticalResolution,
+                                       PixelFormats.Bgra32, Nothing, bitmapData.Scan0,
+                                       rect.Width * rect.Height * 4, bitmapData.Stride)
+            Result.Freeze()
+            Return Result
         Finally
-            Bitmap.UnlockBits(bitmapData)
+            BitmapPic.UnlockBits(bitmapData)
         End Try
     End Operator
     Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
@@ -65,15 +63,16 @@ Public Class MyBitmap
             FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
             If FilePathOrResourceName.StartsWithF(PathImage) Then
                 '使用缓存
-                If BitmapCache.ContainsKey(FilePathOrResourceName) Then
-                    Pic = BitmapCache(FilePathOrResourceName).Pic
+                Static Cache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
+                If Cache.ContainsKey(FilePathOrResourceName) Then
+                    Pic = Cache(FilePathOrResourceName).Pic
                 Else
                     Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
-                    BitmapCache.TryAdd(FilePathOrResourceName, Pic)
+                    Cache.TryAdd(FilePathOrResourceName, Pic)
                 End If
             Else
                 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
-                Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
+                Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
                     '判断是否为 WebP 文件头
                     Dim Header(1) As Byte
                     InputStream.Read(Header, 0, 2)
@@ -92,7 +91,11 @@ Public Class MyBitmap
             Pic = My.Application.TryFindResource(FilePathOrResourceName)
             If Pic Is Nothing Then
                 Pic = New System.Drawing.Bitmap(1, 1)
-                Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex)
+                If TypeOf ex Is ArgumentException Then
+                    Throw New Exception($"图片格式不支持,或图片文件损坏({FilePathOrResourceName})", ex)
+                Else
+                    Throw New Exception($"加载 MyBitmap 意外失败({FilePathOrResourceName})", ex)
+                End If
             Else
                 Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
                 Exit Try

Разница между файлами не показана из-за своего большого размера
+ 339 - 299
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb


+ 83 - 63
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb

@@ -2,7 +2,9 @@
 
     '构造函数
     Private TempFolder As String
-    Public Sub New(UUID As Integer)
+    Private TargetInstance As McInstance
+    Public Sub New(Optional TargetInstance As McInstance = Nothing)
+        Me.TargetInstance = TargetInstance
         '构建文件结构
         TempFolder = RequestTaskTempFolder()
         Directory.CreateDirectory(TempFolder & "Temp\")
@@ -77,7 +79,7 @@
             End Try
         Next
         If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
-            Dim RawOutput As String = Join(LatestLog, vbCrLf)
+            Dim RawOutput As String = LatestLog.Join(vbCrLf)
             Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
             WriteFile(TempFolder & "RawOutput.log", RawOutput)
             AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
@@ -96,7 +98,7 @@
         Try
             Dim Info As New FileInfo(FilePath)
             If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
-                ExtractFile(FilePath, TempFolder & "Temp\")
+                ExtractCompressedFile(FilePath, TempFolder & "Temp\")
                 Log("[Crash] 已解压导入的日志文件:" & FilePath)
                 GoTo Extracted
             End If
@@ -111,7 +113,7 @@ Extracted:
         For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
             Try
                 If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
-                Dim Ext As String = TargetFile.Extension.ToLower
+                Dim Ext As String = TargetFile.Extension.Lower
                 If Ext = ".log" OrElse Ext = ".txt" Then
                     AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
                 Else
@@ -145,7 +147,7 @@ Extracted:
         DirectFile = Nothing
         Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
         For Each LogFile In AnalyzeRawFiles
-            Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
+            Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower
             Dim TargetType As AnalyzeFileType
             If MatchName.StartsWithF("hs_err") Then
                 TargetType = AnalyzeFileType.HsErr
@@ -227,7 +229,7 @@ Extracted:
                         '创建文件名词典
                         Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
                         For Each SelectedFile In SelectedFiles
-                            FileNameDict(GetFileNameFromPath(SelectedFile.Key).ToLower) = SelectedFile
+                            FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
                             OutputFiles.Add(SelectedFile.Key)
                             Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志")
                         Next
@@ -305,7 +307,7 @@ Extracted:
     ''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
     ''' </summary>
     Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
-        If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf)
+        If Raw.Length <= HeadLines + TailLines Then Return Raw.Distinct.Join(vbLf)
         Dim Lines As New List(Of String)
         Dim RealHeadLines As Integer = 0, ViewedLines As Integer
         For ViewedLines = 0 To Raw.Length - 1
@@ -339,6 +341,7 @@ Extracted:
     ''' 导致崩溃的原因枚举。
     ''' </summary>
     Private Enum CrashReason
+        Java虚拟机参数有误
         Mod文件被解压
         MixinBootstrap缺失
         内存不足
@@ -388,7 +391,7 @@ Extracted:
     ''' <summary>
     ''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
     ''' </summary>
-    Public Sub Analyze(Optional Version As McVersion = Nothing)
+    Public Sub Analyze()
         Log("[Crash] 步骤 3:分析崩溃原因")
         LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
 
@@ -445,7 +448,7 @@ Done:
         Else
             Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
             For Each Reason In CrashReasons
-                Log("[Crash]  - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", ""))
+                Log("[Crash]  - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Reason.Value.Join(";"c) & ")", ""))
             Next
         End If
     End Sub
@@ -461,7 +464,7 @@ Done:
         Else
             CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
         End If
-        Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", ""))
+        Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Additional.Join(";"c) & ")", ""))
     End Sub
     Private Sub AppendReason(Reason As CrashReason, Additional As String)
         AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -482,10 +485,12 @@ Done:
         '崩溃报告分析,高优先级
         If LogCrash IsNot Nothing Then
             If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
+            If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
         End If
 
         '游戏日志分析
         If LogMc IsNot Nothing Then
+            If LogMc.Contains("Unrecognized option:") Then AppendReason(CrashReason.Java虚拟机参数有误)
             If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
             If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
             If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
@@ -508,13 +513,13 @@ Done:
             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.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
+            If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void 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))
             If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
             If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
             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("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") AndAlso Not CrashReasons.ContainsKey(CrashReason.Mod配置文件导致游戏崩溃) 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名称包含特殊字符)
@@ -533,12 +538,12 @@ Done:
             '确定的 Mod 导致崩溃
             If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
             '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("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\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))
-            If LogMc.Contains("Incompatible mods found!") Then '#5006
-                AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
+            If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
+                AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息:").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
             End If
             If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
                 AppendReason(CrashReason.Mod缺少前置或MC版本错误,
@@ -602,7 +607,7 @@ Done:
                 Return True
             End If
             'JSON 名称匹配
-            For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
+            For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
                 AppendReason(CrashReason.ModMixin失败,
                              TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
                 Return True
@@ -618,9 +623,9 @@ Done:
             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)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\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)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
-            If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
+            If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
+            If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
+            If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
             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
@@ -654,7 +659,7 @@ Done:
             End If
             'Mod 解析错误(常见于 Fabric 前置校验失败)
             If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
-            'Mixin 失败可以导致大量 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! 不一定是崩溃原因,它可能是单纯的警报
         End If
@@ -707,20 +712,20 @@ NextStack:
                 Dim Word As String = Splited(i)
                 If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
                 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", "lwjgl",
-                    "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",
+                    "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task",
+                    "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes",
+                    "fabric", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
+                    "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network",
+                    "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external",
                     "injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
-                    "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill"
-                   }.Contains(Word.ToLower) Then Continue For
+                    "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
+                   }.Contains(Word.Lower) Then Continue For
                 PossibleWords.Add(Word.Trim)
             Next
         Next
         PossibleWords = PossibleWords.Distinct.ToList
         Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
-        If PossibleWords.Any Then Log("[Crash]  - " & Join(PossibleWords, ", "))
+        If PossibleWords.Any Then Log("[Crash]  - " & PossibleWords.Join(", "))
         If PossibleWords.Count > 10 Then
             Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
             Return New List(Of String)
@@ -768,8 +773,8 @@ NextStack:
             Dim HintLines As New List(Of String)
             For Each KeyWord As String In Keywords
                 For Each ModString As String In ModNameLines
-                    Dim RealModString As String = ModString.ToLower.Replace("_", "")
-                    If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
+                    Dim RealModString As String = ModString.Lower.Replace("_", "")
+                    If Not RealModString.Contains(KeyWord.Lower.Replace("_", "")) Then Continue For
                     If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
                     HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
                     Exit For
@@ -856,20 +861,21 @@ NextStack:
     ''' <summary>
     ''' 弹出崩溃弹窗,并指导导出崩溃报告。
     ''' </summary>
-    Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
+    Public Sub Output(IsManualAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
         '弹窗提示
         FrmMain.ShowWindowToTop()
-        Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
-            "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
-            Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
+        Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
+        Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
+            "确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"),
+            Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing,
             Sub()
                 '弹窗选择:查看日志
                 If File.Exists(DirectFile.Value.Key) Then
-                    ShellOnly(DirectFile.Value.Key)
+                    StartProcess(DirectFile.Value.Key)
                 Else
                     Dim FilePath As String = PathTemp & "Crash.txt"
-                    WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
-                    ShellOnly(FilePath)
+                    WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
+                    StartProcess(FilePath)
                 End If
             End Sub))
             Case 3
@@ -902,8 +908,7 @@ NextStack:
                         If File.Exists(OutputFile) Then
                             If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
                             Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
-                            FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
-                            FileContent = FilterUserName(FileContent, "*")
+                            FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
                             WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
                             Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
                         End If
@@ -911,13 +916,18 @@ NextStack:
                     '导出报告
                     Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
                     DeleteDirectory(TempFolder & "Report\")
-                    Hint("错误报告已导出!", HintType.Finish)
+                    Hint("错误报告已导出!", HintType.Green)
                 Catch ex As Exception
                     Log(ex, "导出错误报告失败", LogLevel.Feedback)
                     Return
                 End Try
                 OpenExplorer(FileAddress)
         End Select
+        '上报
+        If IsManualAnalyze Then Return
+        Telemetry("Minecraft 崩溃",
+                  "Version", If(TargetInstance Is Nothing, "null", TargetInstance.VersionDisplayName),
+                  "Detail", FilterUserName(Detail, "*"))
     End Sub
     ''' <summary>
     ''' 获取崩溃分析的结果描述。
@@ -938,6 +948,8 @@ NextStack:
         For Each Reason In CrashReasons
             Dim Additional As List(Of String) = Reason.Value
             Select Case Reason.Key
+                Case CrashReason.Java虚拟机参数有误
+                    Results.Add("由于 Java 参数有误,导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
                 Case CrashReason.Mod文件被解压
                     Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
                 Case CrashReason.内存不足
@@ -962,35 +974,35 @@ 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 - " & Additional.Join("\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
                     Else
                         Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
                     End If
                 Case CrashReason.堆栈分析发现关键字
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
                     Else
-                        Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
+                        Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Additional.Join(", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
                     End If
                 Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
                     Else
-                        Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
+                        Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
                     End If
                 Case CrashReason.确定Mod导致游戏崩溃
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle 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 - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
                     End If
                 Case CrashReason.ModMixin失败
                     If Additional.Count = 0 Then
                         Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
-                    ElseIf Additional.Count = 1 Then
+                    ElseIf Additional.IsSingle 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")
+                        Results.Add("以下 Mod 导致了游戏出错:\n - " & Additional.Join("\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
                     End If
                 Case CrashReason.Mod配置文件导致游戏崩溃
                     If Additional(1) Is Nothing Then
@@ -999,28 +1011,36 @@ NextStack:
                         Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
                     End If
                 Case CrashReason.Mod初始化失败
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle 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 - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
                     End If
                 Case CrashReason.特定方块导致崩溃
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h")
                     Else
                         Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
                     End If
                 Case CrashReason.Mod重复安装
                     If Additional.Count >= 2 Then
-                        Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
+                        Results.Add("你重复安装了多个相同的 Mod:\n - " & Additional.Join("\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
                     Else
                         Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
                     End If
                 Case CrashReason.特定实体导致崩溃
-                    If Additional.Count = 1 Then
-                        Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h")
+                    If Additional.IsSingle Then
+                        If Additional.First.Contains("minecraft:player") Then
+                            If Additional.First.Contains(" ") Then
+                                Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
+                            Else
+                                Results.Add($"游戏因为玩家实体导致了崩溃。\h")
+                            End If
+                        Else
+                            Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
+                        End If
                     Else
-                        Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
+                        Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、"c)}\h")
                     End If
                 Case CrashReason.OptiFine与Forge不兼容
                     Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
@@ -1057,31 +1077,31 @@ NextStack:
                 Case CrashReason.Forge安装不完整
                     Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
                 Case CrashReason.Fabric报错
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
                     Else
                         Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
                     End If
                 Case CrashReason.Mod互不兼容
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle 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
+                    If Additional.IsSingle Then
                         Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
                     Else
                         Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
                     End If
                 Case CrashReason.Fabric报错并给出解决方案
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
                     Else
                         Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
                     End If
                 Case CrashReason.Forge报错
-                    If Additional.Count = 1 Then
+                    If Additional.IsSingle Then
                         Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
                     Else
                         Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
@@ -1093,7 +1113,7 @@ NextStack:
             End Select
         Next
 
-        Return Join(Results, "\n\n此外,").
+        Return Results.Join("\n\n此外,").
                     Replace("\n", vbCrLf).
                     Replace("\h", "").
                     Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
@@ -1102,7 +1122,7 @@ NextStack:
                 If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
                     vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" &
                     If(If(PageSetupSystem.IsLauncherNewest(), True), "",
-                    vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
+                    vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 [设置 → 其他 → 启动器 → 检查更新] 更新 PCL。"))
     End Function
 
 End Class

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

@@ -6,40 +6,40 @@
     ''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。
     ''' 失败则抛出异常,不需要下载则返回 Nothing。
     ''' </summary>
-    Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
+    Public Function DlClientJarGet(Instance As McInstance, ReturnNothingOnFileUseable As Boolean) As NetFile
         '获取底层继承版本
         Try
-            Do While Not String.IsNullOrEmpty(Version.InheritVersion)
-                Version = New McVersion(Version.InheritVersion)
+            Do While Not String.IsNullOrEmpty(Instance.InheritName)
+                Instance = New McInstance(Instance.InheritName)
             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 文件下载信息")
+        If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
+            Throw New Exception("底层版本 " & Instance.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 AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
+        Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
+        If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.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)
+        Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
+        Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Instance.PathVersion & Instance.Name & ".jar", Checker)
     End Function
 
     ''' <summary>
     ''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。
     ''' 若未找到,则会返回 Legacy 资源文件或 Nothing。
     ''' </summary>
-    Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile
+    Public Function DlClientAssetIndexGet(Instance As McInstance) As NetFile
         '获取底层继承版本
-        Do While Not String.IsNullOrEmpty(Version.InheritVersion)
-            Version = New McVersion(Version.InheritVersion)
+        Do While Not String.IsNullOrEmpty(Instance.InheritName)
+            Instance = New McInstance(Instance.InheritName)
         Loop
         '获取信息
-        Dim IndexInfo = McAssetsGetIndex(Version, True, True)
-        Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json"
-        Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
+        Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
+        Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
+        Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
         Dim IndexUrl As String = If(IndexInfo("url"), "")
         If IndexUrl = "" Then
             Return Nothing
@@ -51,12 +51,12 @@
     ''' <summary>
     ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
     ''' </summary>
-    Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
+    Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
         Dim Loaders As New List(Of LoaderBase)
 
 #Region "下载支持库文件"
         Dim LoadersLib As New List(Of LoaderBase) From {
-            New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
+            New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibNetFilesFromInstance(Instance)) With {.ProgressWeight = 1},
             New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
         }
         '构造加载器
@@ -64,7 +64,7 @@
 #End Region
 
 #Region "下载资源文件"
-        If ShouldIgnoreFileCheck(Version) Then
+        If ShouldIgnoreFileCheck(Instance) Then
             Log("[Download] 已跳过所有 Assets 检查")
         Else
             Dim LoadersAssets As New List(Of LoaderBase)
@@ -72,9 +72,11 @@
             LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
             Sub(Task As LoaderTask(Of String, List(Of NetFile)))
                 Try
-                    Dim IndexFile = DlClientAssetIndexGet(Version)
-                    Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
-                    If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
+                    Dim IndexFile = DlClientAssetIndexGet(Instance)
+                    If IndexFile Is Nothing Then
+                        Task.Output = New List(Of NetFile)
+                        Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
+                    ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
                         Task.Output = New List(Of NetFile)
                     Else
                         Task.Output = New List(Of NetFile) From {IndexFile}
@@ -92,7 +94,12 @@
                 Dim RealAddress As String = Nothing
                 LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
                 Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-                    Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
+                    Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
+                    If BackAssetsFile Is Nothing Then
+                        Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
+                        Task.Interrupt()
+                        Throw New ThreadInterruptedException
+                    End If
                     RealAddress = BackAssetsFile.LocalPath
                     TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
                     BackAssetsFile.LocalPath = TempAddress
@@ -100,7 +107,7 @@
                     '检查是否需要更新:每天只更新一次
                     If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
                         Log("[Download] 无需更新资源文件索引,取消")
-                        Task.Abort()
+                        Task.Interrupt()
                     End If
                 End Sub))
                 LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
@@ -114,14 +121,12 @@
                 Updater.Start()
             End If
             '获取资源文件地址
-            LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
-            Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-                Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
-            End Sub) With {.ProgressWeight = 3})
+            LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
+                Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
             '下载资源文件
             LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
             '构造加载器
-            Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 30.5})
+            Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
         End If
 #End Region
 
@@ -146,6 +151,25 @@
 
 #Region "DlClientList | Minecraft 客户端 版本列表"
 
+    ''' <summary>
+    ''' 所有正式版的 Minecraft Drop 序数。
+    ''' 若从未完成过获取,返回 Nothing;否则必定存在元素,且从高到低排列。
+    ''' </summary>
+    Public Property AllDrops As List(Of Integer)
+        Get
+            If _AllDrops Is Nothing Then
+                _AllDrops = Settings.Get("CacheDrops").ToString.
+                    Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
+            End If
+            Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing,以防止反复获取设置尝试初始化
+        End Get
+        Set(value As List(Of Integer))
+            _AllDrops = value
+            Settings.Set("CacheDrops", value.Join(","c))
+        End Set
+    End Property
+    Private _AllDrops As List(Of Integer) = Nothing
+
     '主加载器
     Public Structure DlClientListResult
         ''' <summary>
@@ -160,10 +184,6 @@
         ''' 获取到的 Json 数据。
         ''' </summary>
         Public Value As JObject
-        '''' <summary>
-        '''' 官方源的失败原因。若没有则为 Nothing。
-        '''' </summary>
-        'Public OfficialError As Exception
     End Structure
     ''' <summary>
     ''' Minecraft 客户端 版本列表,主加载器。
@@ -171,7 +191,7 @@
     ''' </summary>
     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")
+        Select Case Settings.Get("ToolDownloadVersion")
             Case 0
                 DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
                     New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -188,6 +208,14 @@
                     New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
                 }, Loader.IsForceRestarting)
         End Select
+        '提取所有 Drop 序数
+        Dim Drops As New List(Of Integer)
+        For Each Version As JObject In Loader.Output.Value("versions")
+            Dim Drop As Integer = McVersion.VersionToDrop(Version("id"))
+            If Drop = 209 Then Continue For
+            Drops.Add(Drop)
+        Next
+        AllDrops = Drops.Distinct.OrderByDescending(Function(d) d).ToList()
     End Sub
 
     '各个下载源的分加载器
@@ -195,16 +223,15 @@
     ''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
     ''' </summary>
     Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
-    Private IsNewClientVersionHinted As Boolean = False
     Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
-        Dim StartTime As Long = GetTimeTick()
-        Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
+        Dim StartTime As Long = GetTimeMs()
+        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
         Try
             Dim Versions As JArray = Json("versions")
             If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
             '确定官方源是否可用
             If Not DlPreferMojang Then
-                Dim DeltaTime = GetTimeTick() - StartTime
+                Dim DeltaTime = GetTimeMs() - StartTime
                 DlPreferMojang = DeltaTime < 4000
                 Log($"[Download] Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
             End If
@@ -212,20 +239,25 @@
             If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
             '返回
             Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
-            '解析更新提示(Release)
-            Dim Version As String = Json("latest")("release")
-            If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then
+            'MC 更新提示
+            Static IsHinted As Boolean = False
+            Dim Version As String
+            '快照版
+            Version = Json("latest")("snapshot")
+            If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
+               Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
+                IsHinted = True
                 McDownloadClientUpdateHint(Version, Json)
-                IsNewClientVersionHinted = True
             End If
-            McVersionHighest = Version.Split(".")(1)
-            Setup.Set("ToolUpdateReleaseLast", Version)
-            '解析更新提示(Snapshot)
-            Version = Json("latest")("snapshot")
-            If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version AndAlso Not IsNewClientVersionHinted Then
+            Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
+            '正式版
+            Version = Json("latest")("release")
+            If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
+               Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
+                IsHinted = True
                 McDownloadClientUpdateHint(Version, Json)
             End If
-            Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
+            Settings.Set("ToolUpdateReleaseLast", Version)
         Catch ex As Exception
             Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
         End Try
@@ -235,7 +267,7 @@
     ''' </summary>
     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)
+        Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
         Try
             Dim Versions As JArray = Json("versions")
             If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -274,7 +306,7 @@
                     DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
                 Case LoadState.Loading
                     DlClientListLoader.WaitForExit(Id)
-                Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
+                Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
                     DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
             End Select
             '重新查找版本
@@ -312,15 +344,15 @@
         ''' <summary>
         ''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
         ''' </summary>
-        Public NameDisplay As String
+        Public DisplayName As String
         ''' <summary>
         ''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
         ''' </summary>
-        Public NameFile As String
+        Public FileName As String
         ''' <summary>
         ''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。
         ''' </summary>
-        Public NameVersion As String
+        Public InstanceName As String
         ''' <summary>
         ''' 是否为测试版。
         ''' </summary>
@@ -353,7 +385,7 @@
     ''' </summary>
     Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
     Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -377,7 +409,7 @@
     ''' </summary>
     Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain)
     Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
-        Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
+        Dim Result As String = NetRequestByClientRetry("https://optifine.net/downloads", Encoding:=Encoding.Default)
         If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
         Try
             '获取所有版本信息
@@ -392,14 +424,14 @@
             For i = 0 To ReleaseTime.Count - 1
                 Name(i) = Name(i).Replace("_", " ")
                 Dim Entry As New DlOptiFineListEntry With {
-                             .NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
-                             .ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
-                             .IsPreview = Name(i).ContainsF("pre", True),
-                             .Inherit = Name(i).ToString.Split(" ")(0),
-                             .NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
-                             .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
+                    .DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
+                    .ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
+                    .IsPreview = Name(i).ContainsF("pre", True),
+                    .Inherit = Name(i).ToString.Split(" ")(0),
+                    .FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
+                    .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
                 If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
-                Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
+                Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
                 Versions.Add(Entry)
             Next
             Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -413,20 +445,20 @@
     ''' </summary>
     Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
     Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
-        Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
+        Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
         Try
             Dim Versions As New List(Of DlOptiFineListEntry)
             For Each Token As JObject In Json
                 Dim Entry As New DlOptiFineListEntry With {
-                             .NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
-                             .ReleaseTime = "",
-                             .IsPreview = Token("patch").ToString.ContainsF("pre", True),
-                             .Inherit = Token("mcversion").ToString,
-                             .NameFile = Token("filename").ToString,
-                             .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
-                         }
+                    .DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
+                    .ReleaseTime = "",
+                    .IsPreview = Token("patch").ToString.ContainsF("pre", True),
+                    .Inherit = Token("mcversion").ToString,
+                    .FileName = Token("filename").ToString,
+                    .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
+                }
                 If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
-                Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
+                Entry.InstanceName = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
                 Versions.Add(Entry)
             Next
             Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
@@ -459,7 +491,7 @@
     ''' </summary>
     Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
     Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -483,10 +515,10 @@
     ''' </summary>
     Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
     Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
-        Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True)
+        Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
         If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
         '获取所有版本信息
-        Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
+        Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)")
         Names.Add("1.2.4") '1.2.4 不会被匹配上
         If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
         Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -497,11 +529,10 @@
     ''' </summary>
     Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
     Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
-        Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
-        If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
-        '获取所有版本信息
-        Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
-        If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
+        Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
+                                                       Encoding:=Encoding.Default, RequireJson:=True))
+        Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
+        If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
         Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
     End Sub
 
@@ -510,60 +541,47 @@
 #Region "DlForgeVersion | Forge 版本列表"
 
     Public MustInherit Class DlForgelikeEntry
+        Implements IComparable(Of DlForgelikeEntry)
+
         Public IsNeoForge As Boolean
         ''' <summary>
         ''' 加载器名称。Forge 或 NeoForge。
         ''' </summary>
-        Public ReadOnly Property LoaderName As String
-            Get
-                Return If(IsNeoForge, "NeoForge", "Forge")
-            End Get
-        End Property
+        Public MustOverride ReadOnly Property LoaderName As String
         ''' <summary>
         ''' 文件扩展名。不以小数点开头。
         ''' </summary>
-        Public ReadOnly Property FileExtension As String
-            Get
-                If IsNeoForge Then
-                    Return "jar"
-                Else
-                    Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
-                End If
-            End Get
-        End Property
+        Public MustOverride ReadOnly Property FileExtension As String
         ''' <summary>
-        ''' Forge:MC 版本是否小于 1.13。
-        ''' NeoForge:MC 版本是否为 1.20.1。
-        ''' </summary>
-        Public ReadOnly Property IsLegacy As Boolean
-            Get
-                '虽然很抽象,但确实可以这样判断
-                'Forge:1.13+ 的版本号首位都大于 20
-                'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
-                Return Version.Major < 20
-            End Get
-        End Property
-        ''' <summary>
-        ''' 标准化后的版本号,仅可用于比较与排序。
+        ''' 标准化后的版本号,仅可用于比较与排序,且 NeoForge 项不包含 alpha/beta 编号!
         ''' 格式:Major.Minor.Build.Revision
         ''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
         ''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
         ''' </summary>
         Public Version As Version
         ''' <summary>
-        ''' 可对玩家显示的非格式化版本名。
+        ''' 可读的非格式化版本名。
         ''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
         ''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
         ''' </summary>
         Public VersionName As String
         ''' <summary>
-        ''' 对应的 Minecraft 版本,如“1.12.2”。
+        ''' 对应的 Minecraft 版本,如 1.12.2、26.1-snapshot-1。
         ''' </summary>
         Public Inherit As String
+
+        Public Function CompareTo(other As DlForgelikeEntry) As Integer Implements IComparable(Of DlForgelikeEntry).CompareTo
+            If Version <> other.Version Then
+                Return Version.CompareTo(other.Version)
+            Else
+                Return CompareVersion(VersionName, other.VersionName)
+            End If
+        End Function
     End Class
 
     Public Class DlForgeVersionEntry
         Inherits DlForgelikeEntry
+
         ''' <summary>
         ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
         ''' </summary>
@@ -585,6 +603,23 @@
         ''' </summary>
         Public FileVersion As String
 
+        ''' <summary>
+        ''' 加载器名称。Forge 或 NeoForge。
+        ''' </summary>
+        Public Overrides ReadOnly Property LoaderName As String
+            Get
+                Return "Forge"
+            End Get
+        End Property
+        ''' <summary>
+        ''' 文件扩展名。不以小数点开头。
+        ''' </summary>
+        Public Overrides ReadOnly Property FileExtension As String
+            Get
+                Return If(Category = "installer", "jar", "zip")
+            End Get
+        End Property
+
         Public Sub New(Version As String, Branch As String, Inherit As String)
             '司马版本的特殊处理
             If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
@@ -594,8 +629,9 @@
             VersionName = Version
             Me.Version = New Version(Version)
             Me.Inherit = Inherit
-            FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
+            FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
         End Sub
+
     End Class
 
     ''' <summary>
@@ -604,7 +640,7 @@
     Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
         Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
         Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -629,12 +665,12 @@
     Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
         Dim Result As String
         Try
-            Result = NetGetCodeByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
+            Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
                                           Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
-                                          ".html", UseBrowserUserAgent:=True)
+                                          ".html", SimulateBrowserHeaders:=True)
         Catch ex As Exception
-            If GetExceptionSummary(ex).Contains("(404)") Then
-                Throw New Exception("不可用")
+            If ex.GetBrief().Contains("(404)") Then
+                Throw New Exception("无")
             Else
                 Throw
             End If
@@ -692,7 +728,7 @@
         Catch ex As Exception
             Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
         End Try
-        If Not Versions.Any() Then Throw New Exception("不可用")
+        If Not Versions.Any() Then Throw New Exception("无")
         Loader.Output = Versions
     End Sub
 
@@ -700,9 +736,8 @@
     ''' Forge 版本列表,BMCLAPI。
     ''' </summary>
     Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
-        Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
-                                                      Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
-                                                      IsJson:=True)
+        Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
+            Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4,#4057
         Dim Versions As New List(Of DlForgeVersionEntry)
         Try
             Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -747,7 +782,7 @@
         Catch ex As Exception
             Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
         End Try
-        If Not Versions.Any() Then Throw New Exception("不可用")
+        If Not Versions.Any() Then Throw New Exception("无")
         Loader.Output = Versions
     End Sub
 
@@ -772,6 +807,7 @@
 
     Public Class DlNeoForgeListEntry
         Inherits DlForgelikeEntry
+
         ''' <summary>
         ''' 是否是 Beta 版。
         ''' </summary>
@@ -785,23 +821,51 @@
         ''' </summary>
         Public ReadOnly Property UrlBase As String
             Get
-                Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
+                Dim PackageName As String = If(Inherit = "1.20.1", "forge", "neoforge")
                 Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
             End Get
         End Property
 
+        ''' <summary>
+        ''' 加载器名称。Forge 或 NeoForge。
+        ''' </summary>
+        Public Overrides ReadOnly Property LoaderName As String
+            Get
+                Return "NeoForge"
+            End Get
+        End Property
+        ''' <summary>
+        ''' 文件扩展名。不以小数点开头。
+        ''' </summary>
+        Public Overrides ReadOnly Property FileExtension As String
+            Get
+                Return "jar"
+            End Get
+        End Property
+
         Public Sub New(ApiName As String)
             IsNeoForge = True
             Me.ApiName = ApiName
-            IsBeta = ApiName.Contains("beta")
+            IsBeta = ApiName.ContainsF("beta", True) OrElse ApiName.ContainsF("alpha", True)
             If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
                 VersionName = ApiName.Replace("1.20.1-", "")
                 Version = New Version("19." & VersionName)
                 Inherit = "1.20.1"
-            Else '20.4.30-beta
+            ElseIf ApiName.StartsWithF("0.") Then '0.25w14craftmine.3-beta
+                VersionName = ApiName
+                Dim Segments = ApiName.BeforeFirst("-").Split("."c)
+                Version = New Version(0, 0, Segments.Last)
+                Inherit = Segments(1)
+            Else '20.4.30-beta;26.1.0.0-alpha.1+snapshot-1
                 VersionName = ApiName
                 Version = New Version(ApiName.BeforeFirst("-"))
-                Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
+                If Version.Major >= 24 Then
+                    Inherit = $"{Version.Major}.{Version.Minor}.{Version.Build}"
+                Else
+                    Inherit = $"1.{Version.Major}.{Version.Minor}"
+                End If
+                If Inherit.EndsWithF(".0") Then Inherit = Left(Inherit, Inherit.Length - 2)
+                If VersionName.Contains("+") Then Inherit &= "-" & VersionName.AfterFirst("+")
             End If
         End Sub
     End Class
@@ -811,7 +875,7 @@
     ''' </summary>
     Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
     Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -836,8 +900,8 @@
     Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
     Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
         '获取版本列表 JSON
-        Dim ResultLatest As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
-        Dim ResultLegacy As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
+        Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
         If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
         '解析
         Try
@@ -854,8 +918,8 @@
     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 = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
-        Dim ResultLegacy As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
+        Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
+        Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
         If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
         '解析
         Try
@@ -868,12 +932,12 @@
 
     Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
         Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
-            "(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg
+            "(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
         Dim Versions = VersionNames.
             Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
-            Select(Function(name) New DlNeoForgeListEntry(name)).ToList
-        If Not Versions.Any() Then Throw New Exception("不可用")
-        Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
+            Select(Function(name) New DlNeoForgeListEntry(name)).
+            OrderByDescending(Function(a) a).ToList
+        If Not Versions.Any() Then Throw New Exception("无")
         Return Versions
     End Function
 
@@ -936,7 +1000,7 @@
     ''' </summary>
     Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
     Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -960,7 +1024,7 @@
     ''' </summary>
     Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
     Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
-        Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True)
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
         Try
             Dim Json As JObject = Result("versions")
             Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -970,7 +1034,7 @@
                 Versions.Add(New DlLiteLoaderListEntry With {
                              .Inherit = Pair.Key,
                              .IsLegacy = Pair.Key.Split(".")(1) < 8,
-                             .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
+                             .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
                              .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
                              .MD5 = RealEntry("md5"),
                              .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -988,7 +1052,7 @@
     ''' </summary>
     Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
     Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
-        Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
         Try
             Dim Json As JObject = Result("versions")
             Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -998,7 +1062,7 @@
                 Versions.Add(New DlLiteLoaderListEntry With {
                              .Inherit = Pair.Key,
                              .IsLegacy = Pair.Key.Split(".")(1) < 8,
-                             .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
+                             .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
                              .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
                              .MD5 = RealEntry("md5"),
                              .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1035,7 +1099,7 @@
     ''' </summary>
     Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
     Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
-        Select Case Setup.Get("ToolDownloadVersion")
+        Select Case Settings.Get("ToolDownloadVersion")
             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),
@@ -1059,7 +1123,7 @@
     ''' </summary>
     Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
     Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
-        Dim Result As JObject = NetGetCodeByRequestRetry("https://meta.fabricmc.net/v2/versions", IsJson:=True)
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
         Try
             Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
             If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1074,7 +1138,7 @@
     ''' </summary>
     Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
     Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
-        Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True)
+        Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
         Try
             Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
             If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1101,72 +1165,37 @@
 #Region "DlMod | Mod 镜像源请求"
 
     ''' <summary>
-    ''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
-    ''' 调用 NetGetCodeByRequest,会进行重试。
-    ''' </summary>
-    Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
-        Dim Urls As New List(Of KeyValuePair(Of String, Integer))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
-        'Dim McimUrl As String = DlSourceModGet(Url)
-        'If McimUrl <> Url Then
-        '    Select Case Setup.Get("ToolDownloadMod")
-        '        Case 0
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '        Case 1
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '        Case Else
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '            Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '    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
-
-    ''' <summary>
-    ''' 对可能涉及 Mod 镜像源的请求进行处理。
+    ''' 对可能涉及 Mod 镜像源的请求进行处理,返回 JToken。
     ''' 调用 NetRequest,会进行重试。
     ''' </summary>
-    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
+    Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
+                                 Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
         Dim Urls As New List(Of KeyValuePair(Of String, Integer))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
-        'Dim McimUrl As String = DlSourceModGet(Url)
-        'If McimUrl <> Url Then
-        '   Select Case Setup.Get("ToolDownloadMod")
-        '       Case 0
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '       Case 1
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '       Case Else
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
-        '           Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
-        '   End Select
-        'End If
+        Dim McimUrl As String = DlSourceModGet(Url)
+        If McimUrl <> Url Then
+            Select Case Settings.Get("ToolDownloadMod")
+                Case 0
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+                Case 1
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s,要不然 Modrinth 返回不过来
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+                Case Else
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+            End Select
+        Else
+            Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
+            Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+        End If
         Dim Exs As String = ""
         For Each Source In Urls
             Try
-                Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
+                Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
             Catch ex As Exception
                 Exs += ex.Message + vbCrLf
             End Try
@@ -1184,7 +1213,7 @@
     ''' </summary>
     Public ReadOnly Property DlSourcePreferMojang As Boolean
         Get
-            Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
+            Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
         End Get
     End Property
     ''' <summary>
@@ -1198,7 +1227,7 @@
     ''' </summary>
     Public ReadOnly Property DlVersionListPreferMojang As Boolean
         Get
-            Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
+            Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
         End Get
     End Property
     ''' <summary>
@@ -1269,7 +1298,14 @@
 
     'Mod 下载源
     Public Function DlSourceModGet(Original As String) As String
-        Return Original
+        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
 
     'Loader 自动切换
@@ -1290,7 +1326,7 @@
                 If SubLoader.Key.State = LoadState.Finished Then
                     '检查加载器成功
                     MainLoader.Output = SubLoader.Key.Output
-                    DlSourceLoaderAbort(LoaderList)
+                    DlSourceLoaderInterrupt(LoaderList)
                     Return
                 ElseIf BeforeLoadersAllFailed Then
                     '此前的加载器全部失败,直接启动后续加载器
@@ -1316,13 +1352,13 @@
                     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
+                            If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message = "无" Then
                                 ErrorInfo = LoaderList(ii).Key.Error
                             End If
                         End If
                     Next
                     If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
-                    DlSourceLoaderAbort(LoaderList)
+                    DlSourceLoaderInterrupt(LoaderList)
                     Throw ErrorInfo
                 End If
                 Exit For
@@ -1331,15 +1367,15 @@
             Thread.Sleep(10)
             WaitCycle += 1
             '检查父加载器中断
-            If MainLoader.IsAborted Then
-                DlSourceLoaderAbort(LoaderList)
+            If MainLoader.IsInterrupted Then
+                DlSourceLoaderInterrupt(LoaderList)
                 Return
             End If
         Loop
     End Sub
-    Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
+    Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
         For Each Loader In LoaderList
-            If Loader.Key.State = LoadState.Loading Then Loader.Key.Abort()
+            If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
         Next
     End Sub
 

+ 97 - 119
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb

@@ -10,7 +10,7 @@
 
         '路径
         ''' <summary>
-        ''' Java.exe 文件的完整路径。
+        ''' java.exe 文件的完整路径。
         ''' </summary>
         Public ReadOnly Property PathJava As String
             Get
@@ -18,15 +18,7 @@
             End Get
         End Property
         ''' <summary>
-        ''' Javaw.exe 文件的完整路径。
-        ''' </summary>
-        Public ReadOnly Property PathJavaw As String
-            Get
-                Return PathFolder & "javaw.exe"
-            End Get
-        End Property
-        ''' <summary>
-        ''' Javaw.exe 文件所在文件夹的路径,以 \ 结尾。
+        ''' java.exe 文件所在文件夹的路径,以 \ 结尾。
         ''' </summary>
         Public PathFolder As String
         ''' <summary>
@@ -43,7 +35,7 @@
         ''' <summary>
         ''' Java 的大版本号。
         ''' </summary>
-        Public ReadOnly Property VersionCode As Integer
+        Public ReadOnly Property MajorVersion As Integer
             Get
                 Return Version.Minor
             End Get
@@ -79,7 +71,7 @@
         Public Overrides Function ToString() As String
             Dim VersionString = Version.ToString
             If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
-            Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
+            Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
         End Function
 
         '构造
@@ -102,21 +94,16 @@
             Dim Output As String = Nothing
             Try
                 '确定文件存在
-                If Not File.Exists(PathJavaw) Then
-                    Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw)
-                End If
-                If Not File.Exists(PathFolder & "java.exe") Then
-                    Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
-                End If
-                If File.Exists(PathFolder & "pdf-bookmark") Then
-                    Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
-                End If
+                If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
+                If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
+                If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
                 IsJre = Not File.Exists(PathFolder & "javac.exe")
                 '运行 -version
-                Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
+                Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
                 If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
-                If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
+                If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output)
                 If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
+                If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java,该 Java 或系统存在问题")
                 '获取详细信息
                 Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
                 If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
@@ -135,17 +122,15 @@
                 End If
                 Is64Bit = Output.Contains("64-bit")
                 If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
-                '基于 #3649,在 64 位系统上禁用 32 位 Java
+                '#3649:在 64 位系统上禁用 32 位 Java
                 If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
-                '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
-                If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
             Catch ex As ApplicationException
                 Throw ex
             Catch ex As ThreadInterruptedException
                 Throw ex
             Catch ex As Exception
-                Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
-                Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex)
+                Log("[Java] 检查失败的 Java 输出:" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
+                Throw New Exception("检查 Java 失败(" & If(PathJava, "Nothing") & ")", ex)
             End Try
             IsChecked = True
         End Sub
@@ -180,13 +165,13 @@
     Public Sub JavaListInit()
         JavaList = New List(Of JavaEntry)
         Try
-            If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then
+            If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then
                 '不使用缓存
                 Log("[Java] 要求 Java 列表缓存更新")
-                Setup.Set("CacheJavaListVersion", JavaListCacheVersion)
+                Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
             Else
                 '使用缓存
-                For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll"))
+                For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
                     JavaList.Add(JavaEntry.FromJson(JsonEntry))
                 Next
             End If
@@ -199,7 +184,7 @@
             End If
         Catch ex As Exception
             Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
-            Setup.Set("LaunchArgumentJavaAll", "[]")
+            Settings.Set("LaunchArgumentJavaAll", "[]")
         End Try
     End Sub
 
@@ -213,19 +198,19 @@
     ''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
     ''' </summary>
     Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
-                               Optional RelatedVersion As McVersion = Nothing) As JavaEntry
+                               Optional GameInstance As McInstance = Nothing) As JavaEntry
         Try
             Dim AllowedJavaList As New List(Of JavaEntry)
 
             '添加特定的 Java
             Dim JavaPreList As New Dictionary(Of String, Boolean)
-            If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
-                JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
+            If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
+                JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
             End If
-            JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
+            JavaSearchFolder(McFolderSelected, 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) '所选版本文件夹
+            If GameInstance IsNot Nothing Then JavaSearchFolder(GameInstance.PathVersion, JavaPreList, False, True) '所选版本文件夹
             Dim TargetJavaList As New List(Of JavaEntry)
             For Each Entry In JavaPreList
                 TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
@@ -246,8 +231,8 @@
 
             '获取版本独立设置中指定的 Java
             Dim VersionSelect As String = ""
-            If RelatedVersion IsNot Nothing Then
-                VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
+            If GameInstance IsNot Nothing Then
+                VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
                 If VersionSelect.StartsWithF("{") Then
                     Try
                         UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -256,22 +241,22 @@
                         Throw
                     Catch ex As Exception
                         UserJava = Nothing
-                        Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
+                        Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
                         Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
                     End Try
                 End If
             End If
 
             '获取全局设置中指定的 Java
-            If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
+            If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then
                 Try
-                    UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
+                    UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
                     UserJava.Check()
                 Catch ex As ThreadInterruptedException
                     Throw
                 Catch ex As Exception
                     UserJava = Nothing
-                    Setup.Reset("LaunchArgumentJavaSelect")
+                    Settings.Reset("LaunchArgumentJavaSelect")
                     Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
                 End Try
             End If
@@ -290,7 +275,7 @@ RetryGet:
             Select Case JavaSearchLoader.State
                 Case LoadState.Failed
                     Throw JavaSearchLoader.Error
-                Case LoadState.Aborted
+                Case LoadState.Interrupted
                     Throw New ThreadInterruptedException("Java 搜索加载器已中断")
             End Select
 
@@ -344,8 +329,8 @@ RetryGet:
                 Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
                 Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
             End If
-            Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
-            If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then
+            Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
+            If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
                 '直接跳过弹窗
                 Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
                 AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -386,7 +371,7 @@ ExitUserJavaCheck:
 UserPass:
 
             '对适合的 Java 进行排序
-            AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
+            AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
             Log($"[Java] 排序后的 Java 优先顺序:")
             For Each Java In AllowedJavaList
                 Log($"[Java]  - {Java}")
@@ -422,12 +407,12 @@ UserPass:
     ''' <summary>
     ''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。
     ''' </summary>
-    Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean
+    Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
         Try
             '检查强制指定
-            Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
-            If RelatedVersion IsNot Nothing Then
-                Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
+            Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
+            If GameInstance IsNot Nothing Then
+                Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
                 If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
             End If
             If UserSetup <> "" Then
@@ -436,7 +421,7 @@ UserPass:
                     UserJava = JavaEntry.FromJson(GetJson(UserSetup))
                 Catch ex As Exception
                     Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java")
-                    Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion)
+                    Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
                     GoTo NoUserJava
                 End Try
                 For Each Java In JavaList
@@ -451,7 +436,7 @@ NoUserJava:
             Return False
         Catch ex As Exception
             Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
-            Setup.Set("LaunchArgumentJavaSelect", "")
+            Settings.Set("LaunchArgumentJavaSelect", "")
             Return True
         End Try
     End Function
@@ -459,13 +444,15 @@ NoUserJava:
     ''' 将 Java 按照适用性排序。
     ''' </summary>
     Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
+        Dim PathInfo As New DirectoryInfo(Path)
+        Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
         '1. 尽量在当前文件夹或当前 Minecraft 文件夹
         Dim ProgramPathParent As String, MinecraftPathParent As String = ""
-        ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
-        If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
+        ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
+        If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
         If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
         If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
-        If PathMcFolder <> "" Then
+        If McFolderSelected <> "" Then
             If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
             If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
         End If
@@ -476,10 +463,11 @@ NoUserJava:
         If Left.IsJre AndAlso Not Right.IsJre Then Return True
         If Not Left.IsJre AndAlso Right.IsJre Then Return False
         '4. Java 大版本
-        If Left.VersionCode <> Right.VersionCode Then
-            '                             Java  7   8   9  10  11  12 13 14 15  16  17  18  19  20  21  22  23...
-            Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18}
-            Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
+        If Left.MajorVersion <> Right.MajorVersion Then
+            '                             Java  7   8   9  10  11  12 13 14 15  16  17  18  19  20
+            Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17} '更高的版本指定为 20,且越低越好
+            Return If(Left.MajorVersion > 20, 20 - Left.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Left.MajorVersion)) >=
+                   If(Right.MajorVersion > 20, 20 - Right.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Right.MajorVersion))
         End If
         '5. 最次级版本号更接近 51
         Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
@@ -499,11 +487,11 @@ NoUserJava:
                 FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
             End Sub)
         End If
-        If FrmVersionSetup IsNot Nothing Then
+        If FrmInstanceSetup IsNot Nothing Then
             RunInUiWait(
             Sub()
-                FrmVersionSetup.ComboArgumentJava.Items.Clear()
-                FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
+                FrmInstanceSetup.ComboArgumentJava.Items.Clear()
+                FrmInstanceSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
             End Sub)
         End If
 
@@ -529,15 +517,14 @@ NoUserJava:
                 If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
                 JavaSearchFolder(Disk.Name, JavaPreList, False)
             Next
-            '查找 APPDATA 文件夹中的 Java
-            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
-            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
+            '查找用户文件夹中的 Java
+            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), JavaPreList, False)
+            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
+            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
             '查找启动器目录中的 Java
             JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
             '查找所选 Minecraft 文件夹中的 Java
-            If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then
-                JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
-            End If
+            If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
 
             '若不全为符号链接,则清除符号链接的地址
             Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -571,7 +558,7 @@ NoUserJava:
 
 #Region "添加玩家手动导入的 Java"
 
-            Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll")
+            Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
             Try
                 For Each JavaJsonObject In GetJson(ImportedJava)
                     Dim Entry = JavaEntry.FromJson(JavaJsonObject)
@@ -579,24 +566,24 @@ NoUserJava:
                 Next
             Catch ex As Exception
                 Log(ex, "Java 列表已损坏", LogLevel.Feedback)
-                Setup.Set("LaunchArgumentJavaAll", "[]")
+                Settings.Set("LaunchArgumentJavaAll", "[]")
             End Try
 
 #End Region
 
             '确保可用并获取详细信息,转入正式列表
             Dim NewJavaList As New List(Of JavaEntry)
-            For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
+            For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
                 NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
             Next
-            NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
+            NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
 
             '修改设置项
             Dim AllList As New JArray
             For Each Java In NewJavaList
                 AllList.Add(Java.ToJson)
             Next
-            Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
+            Settings.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
             JavaList = NewJavaList
 
         Catch ex As Exception
@@ -605,8 +592,8 @@ NoUserJava:
         End Try
 
         Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java")
-        If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox())
-        If FrmVersionSetup IsNot Nothing Then RunInUi(Sub() FrmVersionSetup.RefreshJavaComboBox())
+        If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
+        If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
     End Sub
 
     ''' <summary>
@@ -656,7 +643,7 @@ Wait:
     Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
         Try
             Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找:" & OriginalPath)
-            JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch)
+            JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
         Catch ex As UnauthorizedAccessException
             Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath)
         Catch ex As Exception
@@ -677,19 +664,19 @@ Wait:
             '若该目录有 Java,则加入结果
             If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
             '查找其下的所有文件夹
-            '不应使用网易的 Java:https://github.com/Hex-Dragon/PCL2/issues/1279#issuecomment-2761489121
-            Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
-                            "soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
-                            "游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
-                            "应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
-                            "runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
-                            "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
-                            "4297127d64ec6", "1.", "启动"}
+            '不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
+            Static Keywords As String() = {
+                "java", "jdk", "jre", "env", "环境", "run", "软件", "mc", "dragon", "well", "bin", "sdk", "candidate", "current",
+                "software", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
+                "游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
+                "应用", "运行", "前置", "mojang", "官启", "官方", "新建文件夹", "eclipse", "microsoft", "hotspot",
+                "runtime", "x86", "x64", "arm", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "forge", "fabric",
+                "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
             For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
                 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
-                Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
+                Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).Lower '用于搜索的字符串
                 If IsFullSearch OrElse
-                   OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
+                   OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
                     JavaSearchFolder(FolderInfo, Results, Source)
                 End If
             Next
@@ -705,34 +692,18 @@ Wait:
 #Region "下载"
 
     ''' <summary>
-    ''' 提示 Java 缺失,并弹窗确认是否自动下载。返回玩家选择是否下载。
-    ''' </summary>
-    Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean
-        If ForcedManualDownload Then
-            MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
-                     $"请自行搜索并安装 {VersionDescription},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
-                     "未找到 Java")
-            Return False
-        Else
-            Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
-                            $"如果你已经安装了 {VersionDescription},可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
-                            "自动下载 Java?", "自动下载", "取消") = 1
-        End If
-    End Function
-
-    ''' <summary>
-    ''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
+    ''' 获取下载 Java 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
     ''' </summary>
-    Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
+    Public Function GetJavaDownloadLoader() As LoaderCombo(Of String)
         Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
-        Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", {
-            New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
+        Dim Loader = New LoaderCombo(Of String)($"下载 Java", {
+            New LoaderTask(Of String, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
             JavaDownloadLoader,
             JavaSearchLoader
         })
         AddHandler JavaDownloadLoader.OnStateChangedThread,
         Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
-            If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then
+            If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
                 Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug)
                 DeleteDirectory(LastJavaBaseDir)
             ElseIf NewState = LoadState.Finished Then
@@ -743,22 +714,29 @@ Wait:
         Return Loader
     End Function
     Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
-    Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
+    Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
         Log("[Java] 开始获取 Java 下载信息")
-        Dim IndexFileStr As String = NetGetCodeByLoader(DlVersionListOrder(
+        Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
             {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
             {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
         ), IsJson:=True)
-        '获取下载地址
-        Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
-        Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
-            SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
-        Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
-        Dim Address As String = TargetEntry.Value("manifest")("url")
-        Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
+        '查找要下载的目标 Java
+        Dim TargetEntry As JProperty = Nothing
+        Dim Components As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
+        If Components.ContainsKey(Loader.Input) Then '精确匹配
+            TargetEntry = Components.Property(Loader.Input)
+        Else '模糊匹配
+            TargetEntry = Components.Properties.FirstOrDefault(
+                Function(c) c.Value IsNot Nothing AndAlso c.Value.ToArray.FirstOrDefault()?("version")("name").ToString.StartsWithF(Loader.Input))
+            If TargetEntry Is Nothing Then Throw New Exception($"未能找到所需的 Java {Loader.Input}")
+        End If
+        Dim TargetComponent = TargetEntry.Value.ToArray.FirstOrDefault
+        If TargetComponent Is Nothing Then Throw New Exception($"Mojang 未提供所需的 Java {Loader.Input}")
         '获取文件列表
-        Dim ListFileStr As String = NetGetCodeByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
-        LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
+        Dim Address As String = TargetComponent("manifest")("url")
+        McLaunchLog($"准备下载 Java {TargetComponent("version")("name")}({TargetEntry.Name}):{Address}")
+        Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
+        LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Name & "\"
         Dim Results As New List(Of NetFile)
         For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
             If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For

Разница между файлами не показана из-за своего большого размера
+ 296 - 235
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb


Разница между файлами не показана из-за своего большого размера
+ 455 - 358
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb


+ 122 - 522
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb

@@ -1,7 +1,7 @@
 Imports System.IO.Compression
 
 Public Module ModMod
-    Private Const LocalModCacheVersion As Integer = 7
+    Private Const LocalModCacheVersion As Integer = 13
 
     Public Class McMod
 
@@ -46,10 +46,7 @@ Public Module ModMod
         ''' </summary>
         Public ReadOnly Property State As McModState
             Get
-                Load()
-                If Not IsFileAvailable Then
-                    Return McModState.Unavailable
-                ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
+                If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
                     Return McModState.Disabled
                 Else
                     Return McModState.Fine
@@ -59,7 +56,6 @@ Public Module ModMod
         Public Enum McModState As Integer
             Fine = 0
             Disabled = 1
-            Unavailable = 2
         End Enum
 
 #End Region
@@ -67,18 +63,23 @@ Public Module ModMod
 #Region "信息项"
 
         ''' <summary>
-        ''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。
+        ''' 当任何信息在初始化后更新时触发。
         ''' </summary>
-        Public Property Name As String
+        Public Event OnUpdate(sender As McMod)
+
+        ''' <summary>
+        ''' Mod 的可读名称。
+        ''' 可能为无扩展的文件名,但不会是 Nothing。
+        ''' </summary>
+        Public Property DisplayName As String
             Get
-                If _Name Is Nothing Then Load()
-                If _Name Is Nothing Then _Name = _ModId
-                If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path)
+                If _Name Is Nothing Then _Name = CompFile?.DisplayName
+                If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
                 Return _Name
             End Get
             Set(value As String)
                 If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
-                   value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
+                   value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
                     _Name = value
                 End If
             End Set
@@ -87,226 +88,67 @@ Public Module ModMod
 
         ''' <summary>
         ''' Mod 的描述信息。
+        ''' 可能为 Nothing。
         ''' </summary>
         Public Property Description As String
             Get
-                If _Description Is Nothing Then Load()
-                If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message
-                'If _Description Is Nothing Then _Description = Path
                 Return _Description
             End Get
             Set(value As String)
                 If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
                     _Description = value.ToString.Trim(vbLf)
                     '优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号
-                    If _Description.ToLower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
+                    If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
                 End If
             End Set
         End Property
         Private _Description As String = Nothing
 
         ''' <summary>
-        ''' Mod 的版本,不保证符合版本格式规范。
+        ''' Mod 的版本。
+        ''' 不保证符合版本格式规范,且可能为 Nothing。
         ''' </summary>
         Public Property Version As String
             Get
-                If _Version Is Nothing Then Load()
+                If _Version Is Nothing Then _Version = CompFile?.Version
                 Return _Version
             End Get
             Set(value As String)
                 If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
-                If value?.ContainsF("version", True) Then value = "version" '需要修改的标识
+                If value IsNot Nothing AndAlso value.ContainsF("version", True) Then value = "version" '需要修改的标识
                 _Version = value
             End Set
         End Property
         Public _Version As String = Nothing
 
-        ''' <summary>
-        ''' 用于依赖检查的 ModID。
-        ''' </summary>
-        Public Property ModId As String
-            Get
-                If _ModId Is Nothing Then Load()
-                Return _ModId
-            End Get
-            Set(value As String)
-                If value Is Nothing Then Return
-                value = RegexSeek(value, "[0-9a-zA-Z_-]+")
-                If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
-                If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
-                If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
-                If _ModId Is Nothing Then _ModId = value
-            End Set
-        End Property
-        Private _ModId As String = Nothing
-        ''' <summary>
-        ''' 其他可能的 ModID。
-        ''' </summary>
-        Public PossibleModId As New List(Of String)
-
-        ''' <summary>
-        ''' Mod 的主页。
-        ''' </summary>
-        Public Property Url As String
-            Get
-                If _Url Is Nothing Then Load()
-                Return _Url
-            End Get
-            Set(value As String)
-                If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
-                    _Url = value
-                End If
-            End Set
-        End Property
-        Private _Url As String = Nothing
-
-        ''' <summary>
-        ''' Mod 的作者列表。
-        ''' </summary>
-        Public Property Authors As String
-            Get
-                If _Authors Is Nothing Then Load()
-                Return _Authors
-            End Get
-            Set(value As String)
-                If _Authors Is Nothing AndAlso Not String.IsNullOrWhiteSpace(value) Then
-                    _Authors = value
-                End If
-            End Set
-        End Property
-        Private _Authors As String = Nothing
-
-        ''' <summary>
-        ''' 依赖项,其中包括了 Minecraft 的版本要求。格式为 ModID - VersionRequirement,若无版本要求则为 Nothing。
-        ''' </summary>
-        Public ReadOnly Property Dependencies As Dictionary(Of String, String)
-            Get
-                Load()
-                Return _Dependencies
-            End Get
-        End Property
-        Private _Dependencies As New Dictionary(Of String, String)
-        Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
-            '确保信息正确
-            If ModID Is Nothing OrElse ModID.Count < 2 Then Return
-            ModID = ModID.ToLower
-            If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
-            If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
-                VersionRequirement = Nothing
-            Else
-                If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
-            End If
-            '向依赖项中添加
-            If _Dependencies.ContainsKey(ModID) Then
-                If _Dependencies(ModID) Is Nothing Then _Dependencies(ModID) = VersionRequirement
-            Else
-                _Dependencies.Add(ModID, VersionRequirement)
-            End If
-        End Sub
-
 #End Region
 
-#Region "加载步骤标记"
+#Region "从 JAR 获取信息"
 
-        '1. 进行文件可用性检查
-        '   成功:继续第二步。
-        '   失败:标记 FileUnavailableReason, 并停止后续加载。
-        ''' <summary>
-        ''' 是否已进行 Mod 文件的基础加载。(这包括第一步和第二步)
-        ''' </summary>
-        Private IsLoaded As Boolean = False
-        ''' <summary>
-        ''' Mod 文件是否可被正常读取。
-        ''' </summary>
-        Public ReadOnly Property IsFileAvailable As Boolean
-            Get
-                Load()
-                Return FileUnavailableReason Is Nothing
-            End Get
-        End Property
         ''' <summary>
-        ''' Mod 文件出错的原因。若无错误,则为 Nothing。
+        ''' 从 JAR 文件中获取 Mod 信息。
         ''' </summary>
-        Public ReadOnly Property FileUnavailableReason As Exception
-            Get
-                Load()
-                Return _FileUnavailableReason
-            End Get
-        End Property
-        Private _FileUnavailableReason As Exception = Nothing
-
-        '2. 进行 .class 以外的信息获取
-        '   成功:标记 IsInfoWithoutClassAvailable。
-        '   失败:什么也不干。如果需要补充信息的话,检测到 IsInfoWithoutClassAvailable 为 False,会自动继续加载。
-        ''' <summary>
-        ''' 是否已在不获取 .class 文件的前提下完成了所需信息的加载。
-        ''' </summary>
-        Private IsInfoWithoutClassAvailable As Boolean = False
-
-        '3. 尝试从 .class 文件中获取信息
-        '   成功:标记 IsInfoWithClassAvailable。
-        '   失败:什么也不干。
-        ''' <summary>
-        ''' 是否已进行 .class 文件的信息获取。
-        ''' </summary>
-        Private IsInfoWithClassLoaded As Boolean = False
-        ''' <summary>
-        ''' 是否已在 .class 文件中完成了所需信息的加载。
-        ''' </summary>
-        Private IsInfoWithClassAvailable As Boolean = False
-
-#End Region
-
-#Region "加载"
-
-        ''' <summary>
-        ''' 初始化所有数据。
-        ''' </summary>
-        Private Sub Init()
-            _Name = Nothing
-            _Description = Nothing
-            _Version = Nothing
-            _ModId = Nothing
-            PossibleModId = New List(Of String)
-            _Dependencies = New Dictionary(Of String, String)
-            IsLoaded = False
-            _FileUnavailableReason = Nothing
-            IsInfoWithClassLoaded = False
-            IsInfoWithClassAvailable = False
-        End Sub
-
-        ''' <summary>
-        ''' 进行文件可用性检查与 .class 以外的信息获取。
-        ''' </summary>
-        Public Sub Load(Optional ForceReload As Boolean = False)
-            If IsLoaded AndAlso Not ForceReload Then Return
-            '初始化
-            Init()
+        Public Sub LoadMetadataFromJar()
+            Static IsLoaded As Boolean = False
+            If IsLoaded Then Return
+            IsLoaded = True
             Dim Jar As ZipArchive = Nothing
             Try
                 '基础可用性检查、打开 Jar 文件
                 If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
                 If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
-                Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
+                Jar = New ZipArchive(New FileStream(Path, FileMode.Open, FileAccess.Read, FileShare.Read))
                 '信息获取
-                LookupMetadata(Jar)
+                LoadMetadataFromJar(Jar)
             Catch ex As UnauthorizedAccessException
                 Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
-                _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
             Catch ex As Exception
                 Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer)
-                _FileUnavailableReason = ex
             Finally
                 If Jar IsNot Nothing Then Jar.Dispose()
             End Try
-            '完成标记
-            IsLoaded = True
         End Sub
-
-        ''' <summary>
-        ''' 从 jar 文件中获取 Mod 信息。
-        ''' </summary>
-        Private Sub LookupMetadata(Jar As ZipArchive)
+        Private Sub LoadMetadataFromJar(Jar As ZipArchive)
 
 #Region "尝试使用 mcmod.info"
             Try
@@ -327,45 +169,9 @@ Public Module ModMod
                     InfoObject = JsonObject("modList")(0)
                 End If
                 '从文件中获取 Mod 信息项
-                Name = InfoObject("name")
+                DisplayName = InfoObject("name")
                 Description = InfoObject("description")
                 Version = InfoObject("version")
-                Url = InfoObject("url")
-                ModId = InfoObject("modid")
-                Dim AuthorJson As JArray = InfoObject("authorList")
-                If AuthorJson IsNot Nothing Then
-                    Dim Author As New List(Of String)
-                    For Each Token In AuthorJson
-                        Author.Add(Token.ToString)
-                    Next
-                    If Author.Any Then Authors = Join(Author, ", ")
-                End If
-                Dim Reqs As JArray = InfoObject("requiredMods")
-                If Reqs IsNot Nothing Then
-                    For Each Token As String In Reqs
-                        If Not String.IsNullOrEmpty(Token) Then
-                            Token = Token.Substring(Token.IndexOfF(":") + 1)
-                            If Token.Contains("@") Then
-                                AddDependency(Token.Split("@")(0), Token.Split("@")(1))
-                            Else
-                                AddDependency(Token)
-                            End If
-                        End If
-                    Next
-                End If
-                Reqs = InfoObject("dependancies")
-                If Reqs IsNot Nothing Then
-                    For Each Token As String In Reqs
-                        If Not String.IsNullOrEmpty(Token) Then
-                            Token = Token.Substring(Token.IndexOfF(":") + 1)
-                            If Token.Contains("@") Then
-                                AddDependency(Token.Split("@")(0), Token.Split("@")(1))
-                            Else
-                                AddDependency(Token)
-                            End If
-                        End If
-                    Next
-                End If
             Catch ex As Exception
                 Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
             End Try
@@ -383,37 +189,9 @@ Public Module ModMod
                 Dim FabricObject As JObject = GetJson(FabricText)
 GotFabric:
                 '从文件中获取 Mod 信息项
-                If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
+                If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
                 If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
                 If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
-                If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
-                If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
-                Dim AuthorJson As JArray = FabricObject("authors")
-                If AuthorJson IsNot Nothing Then
-                    Dim Author As New List(Of String)
-                    For Each Token In AuthorJson
-                        Author.Add(Token.ToString)
-                    Next
-                    If Author.Any Then Authors = Join(Author, ", ")
-                End If
-                'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
-                '    '添加 Minecraft 依赖
-                '    Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
-                '    If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
-                '    '添加其他依赖
-                '    Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
-                '    If Deps <> "" Then
-                '        For Each Dep In Deps.Split(";")
-                '            If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
-                '            Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
-                '            If Dep.Contains("@") Then
-                '                AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
-                '            Else
-                '                AddDependency(Dep)
-                '            End If
-                '        Next
-                '    End If
-                'End If
                 '加载成功
                 GoTo Finished
             Catch ex As Exception
@@ -474,10 +252,10 @@ GotFabric:
                                     End If
                                 Loop
                             End If
-                            Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
-                        ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then
+                            Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
+                        ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
                             '布尔型
-                            Value = (RawValue.ToLower = "true")
+                            Value = (RawValue.Lower = "true")
                         ElseIf Val(RawValue).ToString = RawValue Then
                             '数字型
                             Value = Val(RawValue)
@@ -500,22 +278,9 @@ GotFabric:
                     End If
                 Next
                 If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
-                ModId = ModEntry("modId")
-                If _ModId Is Nothing Then Exit Try '设置了无效的 ModID
-                If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName")
+                If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
                 If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
                 If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
-                If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL")
-                If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors")
-                For Each TomlSubData In TomlData
-                    If TomlSubData.Key.ToLower = $"dependencies.{ModId.ToLower}" Then
-                        Dim DepEntry As Dictionary(Of String, Object) = TomlSubData.Value
-                        If DepEntry.ContainsKey("modId") AndAlso DepEntry.ContainsKey("mandatory") AndAlso DepEntry("mandatory") AndAlso
-                           DepEntry.ContainsKey("side") AndAlso Not DepEntry("side").ToString.ToLower = "server" Then
-                            AddDependency(DepEntry("modId"), If(DepEntry.ContainsKey("versionRange"), DepEntry("versionRange"), Nothing))
-                        End If
-                    End If
-                Next
                 '加载成功
                 GoTo Finished
             Catch ex As Exception
@@ -551,41 +316,16 @@ GotFabric:
                 Exit Try
 Got:
                 '从文件中获取 Mod 信息项
-                If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then
-                    '要求使用 mcmod.info 中的信息
-                    Dim value As String = FmlObject("modid")("value")
-                    If value Is Nothing Then Exit Try
-                    value = RegexSeek(value.ToLower, "[0-9a-z_]+")
-                    If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
-                        If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
-                    End If
-                    Exit Try
-                End If
-                If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value")
+                If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
                 If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
-                If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value")
-                If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
-                    '添加 Minecraft 依赖
-                    Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "")
-                    If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
-                    '添加其他依赖
-                    Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
-                    If Deps <> "" Then
-                        For Each Dep In Deps.Split(";")
-                            If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
-                            Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
-                            If Dep.Contains("@") Then
-                                AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
-                            Else
-                                AddDependency(Dep)
-                            End If
-                        Next
-                    End If
-                End If
+                '加载成功
+                GoTo Finished
             Catch ex As Exception
                 Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
             End Try
 #End Region
+            Return '没能成功获取任何信息
+
 Finished:
 #Region "将 Version 代号转换为 META-INF 中的版本"
             If _Version = "version" Then
@@ -606,6 +346,7 @@ Finished:
             End If
             If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
 #End Region
+            RaiseEvent OnUpdate(Me)
 
         End Sub
 
@@ -613,11 +354,6 @@ Finished:
 
 #Region "网络信息"
 
-        ''' <summary>
-        ''' 当任何网络信息更新时触发。
-        ''' </summary>
-        Public Event OnCompUpdate(sender As McMod)
-
         ''' <summary>
         ''' 该 Mod 关联的网络项目。
         ''' </summary>
@@ -627,7 +363,7 @@ Finished:
             End Get
             Set(value As CompProject)
                 _Comp = value
-                RaiseEvent OnCompUpdate(Me)
+                RaiseEvent OnUpdate(Me)
             End Set
         End Property
         Private _Comp As CompProject
@@ -646,7 +382,7 @@ Finished:
             End Get
             Set(value As CompFile)
                 _UpdateFile = value
-                RaiseEvent OnCompUpdate(Me)
+                RaiseEvent OnUpdate(Me)
             End Set
         End Property
         Private _UpdateFile As CompFile
@@ -688,7 +424,7 @@ Finished:
         ''' </summary>
         Public ReadOnly Property CanUpdate As Boolean
             Get
-                Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
+                Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
             End Get
         End Property
 
@@ -787,10 +523,10 @@ Finished:
 #End Region
 
         ''' <summary>
-        ''' 是否可能为前置 Mod。
+        ''' 是否可能为前置 Mod。目前非常不准确。
         ''' </summary>
         Public Function IsPresetMod() As Boolean
-            Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
+            Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
         End Function
 
         ''' <summary>
@@ -798,7 +534,7 @@ Finished:
         ''' </summary>
         Public Shared Function IsModFile(Path As String)
             If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
-            Path = Path.ToLower
+            Path = Path.Lower
             If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
                Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
                Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
@@ -811,33 +547,33 @@ Finished:
     Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
     Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
         Try
-            RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
+            RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
 
             '等待 Mod 更新完成
-            If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
+            If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
                 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)
-                        If Loader.IsAborted Then Return
+                    RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
+                    Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
+                        If Loader.IsInterrupted Then Return
                         Thread.Sleep(100)
                     Loop
                 Finally
-                    RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
+                    RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
                 End Try
-                FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
+                FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
             End If
 
             '获取 Mod 文件夹下的可用文件列表
             Dim ModFileList As New List(Of FileInfo)
             If Directory.Exists(Loader.Input) Then
-                Dim RawName As String = Loader.Input.ToLower
+                Dim RawName As String = Loader.Input.Lower
                 For Each File As FileInfo In EnumerateFiles(Loader.Input)
-                    If File.DirectoryName.ToLower & "\" <> RawName Then
+                    If File.DirectoryName.Lower & "\" <> RawName Then
                         '仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
-                        If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso
-                                PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso
-                                File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then
+                        If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
+                                PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
+                                File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
                             Continue For
                         End If
                     End If
@@ -845,10 +581,6 @@ Finished:
                 Next
             End If
 
-            '确定是否显示进度
-            Loader.Progress = 0.05
-            If ModFileList.Count > 50 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True)
-
             '获取本地文件缓存
             Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
             Dim Cache As New JObject
@@ -869,14 +601,10 @@ Finished:
 
             '加载 Mod 列表
             Dim ModList As New List(Of McMod)
-            Dim ModUpdateList As New List(Of McMod)
             For Each ModFile As FileInfo In ModFileList
-                Loader.Progress += 0.94 / ModFileList.Count
-                If Loader.IsAborted Then Return
-                '加载 McMod 对象
+                If Loader.IsInterrupted Then Return
                 Dim ModEntry As New McMod(ModFile.FullName)
-                ModEntry.Load()
-                Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
+                Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件,名称相同,但一个启用一个禁用
                 If DumpMod IsNot Nothing Then
                     Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
                     Log($"[Mod] 重复的 Mod 文件:{DumpMod.FileName} 与 {ModEntry.FileName},已忽略 {DisabledMod.FileName}", LogLevel.Debug)
@@ -884,42 +612,22 @@ Finished:
                         Continue For
                     Else
                         ModList.Remove(DisabledMod)
-                        ModUpdateList.Remove(DisabledMod)
                     End If
                 End If
                 ModList.Add(ModEntry)
-                '读取 Comp 缓存
-                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))
-                    '如果缓存中的信息在 6 小时以内更新过,则无需重新获取
-                    If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
-                End If
-                ModUpdateList.Add(ModEntry)
             Next
-            Loader.Progress = 0.99
-            Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
+            Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
 
             '排序
-            ModList = ModList.Sort(
-            Function(Left As McMod, Right As McMod) As Boolean
-                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
-            End Function)
+            ModList = ModList.OrderBy(Function(m) m.FileName).ToList
 
             '回设
-            If Loader.IsAborted Then Return
+            If Loader.IsInterrupted Then Return
             Loader.Output = ModList
 
             '开始联网加载
-            If ModUpdateList.Any() Then
-                'TODO: 添加信息获取中提示
-                McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
-            End If
+            'TODO: 添加信息获取中提示
+            McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
 
         Catch ex As Exception
             Log(ex, "Mod 列表加载失败", LogLevel.Debug)
@@ -929,15 +637,31 @@ Finished:
     '联网加载 Mod 详情
     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
+        Dim Mods As New List(Of McMod)
         Dim Cache As JObject = Loader.Input.Value
+        '读取 Comp 缓存,获取需要更新的 Mod 列表
+        For Each ModEntry As McMod In Loader.Input.Key
+            If Loader.IsInterrupted Then Return
+            Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
+            If Cache.ContainsKey(CacheKey) Then
+                ModEntry.FromJson(Cache(CacheKey))
+                '如果缓存中的信息在 6 小时以内更新过,则无需重新获取
+                If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
+            End If
+            Mods.Add(ModEntry)
+        Next
+        Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
+        If Not Mods.Any Then
+            Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())  '从 JAR 中获取缺失的版本信息(下面有另一个分支)
+            Return
+        End If
         '获取作为检查目标的加载器和版本
         '此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
-        Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
+        Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
         Dim ModLoaders = GetTargetModLoaders()
-        Dim McVersion = TargetMcVersion.McName
+        Dim VanillaVersion = TargetMcVersion.VanillaName
         '开始网络获取
-        Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
+        Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
         Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
         Dim CurrentTaskThread As Thread = Thread.CurrentThread
         '从 Modrinth 获取信息
@@ -946,8 +670,8 @@ Finished:
             Try
                 '步骤 1:获取 Hash 与对应的工程 ID
                 Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
-                Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
-                    $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
+                Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
+                    $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
                 Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
                 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
                 If ModrinthVersion.Count = 0 Then Return
@@ -961,15 +685,18 @@ Finished:
                     ModrinthMapping(ProjectId).Add(Entry)
                     '记录对应的 CompFile
                     Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
-                    If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
+                    If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
+                        Entry.CompFile = File
+                    Else
+                        Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
+                    End If
                 Next
-                If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
+                If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
                 Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
                 '步骤 3:获取工程信息
                 If Not ModrinthMapping.Any() Then Return
-                Dim ModrinthProject = CType(GetJson(DlModRequest(
-                    $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
-                    "GET", "", "application/json")), JArray)
+                Dim ModrinthProject As JArray = DlModRequest(
+                    $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
                 For Each ProjectJson In ModrinthProject
                     Dim Project As New CompProject(ProjectJson)
                     For Each Entry In ModrinthMapping(Project.Id)
@@ -978,9 +705,9 @@ Finished:
                 Next
                 Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
                 '步骤 4:获取更新信息
-                Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
+                Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.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)
+                    ""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
                 For Each Entry In Mods
                     If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
                     Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -989,11 +716,11 @@ Finished:
                     If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
                     '设置更新日志与更新文件
                     If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
-                        Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}")
+                        Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
                         UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
                         Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
                     ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
-                        Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"}
+                        Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
                         Entry.UpdateFile = UpdateFile
                     End If
                 Next
@@ -1013,10 +740,10 @@ Finished:
                 Dim CurseForgeHashes As New List(Of UInteger)
                 For Each Entry In Mods
                     CurseForgeHashes.Add(Entry.CurseForgeHash)
-                    If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
+                    If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
                 Next
-                Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
-                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
+                Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
+                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
                 Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
                 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
                 If Not CurseForgeRaw.Any() Then Return
@@ -1034,12 +761,12 @@ Finished:
                         If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
                     Next
                 Next
-                If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
+                If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
                 Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
                 '步骤 3:获取工程信息
                 If Not CurseForgeMapping.Any() Then Return
-                Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
-                    $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
+                Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
+                    $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("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
@@ -1054,15 +781,15 @@ Finished:
                         Entry.Comp = Project
                     Next
                     '查找或许版本更新的文件列表
-                    If ModLoaders.Count = 1 Then
+                    If ModLoaders.IsSingle Then
                         Dim NewestVersion As String = Nothing
                         Dim NewestFileIds As New List(Of Integer)
                         For Each IndexEntry In ProjectJson("latestFilesIndexes")
                             If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
                             Dim IndexVersion As String = IndexEntry("gameVersion")
-                            If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
+                            If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
                             '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
-                            If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
+                            If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
                             If NewestVersion <> IndexVersion Then
                                 NewestVersion = IndexVersion
                                 NewestFileIds.Clear()
@@ -1079,8 +806,8 @@ Finished:
                 Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
                 '步骤 4:获取更新文件信息
                 If Not UpdateFileIds.Any() Then Return
-                Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
-                                    $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
+                Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
+                                    $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
                 Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
                 For Each FileJson In CurseForgeFiles
                     Dim File As New CompFile(FileJson, CompType.Mod)
@@ -1112,10 +839,12 @@ Finished:
                 EndedThreadCount += 1
             End Try
         End Sub, "Mod List Detail Loader CurseForge")
+        '从 JAR 中获取缺失的版本信息(上面有另一个分支)
+        Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())
         '等待线程结束
         Do Until EndedThreadCount = 2
-            If Loader.IsAborted Then Return
             Thread.Sleep(10)
+            If Loader.IsInterrupted Then Return
         Loop
         '保存缓存
         Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -1123,154 +852,25 @@ Finished:
         If Not Mods.Any() Then Return
         For Each Entry In Mods
             Entry.CompLoaded = Not IsFailed
-            Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
+            Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
         Next
         WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
         '刷新边栏
-        If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
-            RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
+        If Loader.IsInterrupted Then Return
+        If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
+            RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
         Else
-            RunInUi(Sub() FrmVersionMod?.RefreshBars())
+            RunInUi(Sub() FrmInstanceMod?.RefreshBars())
         End If
     End Sub
     Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
         Dim ModLoaders As New List(Of CompModLoaderType)
-        If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
-        If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
-        If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
-        If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
+        If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
+        If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
+        If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
+        If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
         If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
         Return ModLoaders
     End Function
 
-#If DEBUG Then
-    ''' <summary>
-    ''' 检查 Mod 列表中存在的错误,返回错误信息的集合。
-    ''' </summary>
-    Public Function McModCheck(Version As McVersion, Mods As List(Of McMod)) As List(Of String)
-        Dim Result As New List(Of String)
-        '令所有 Mod 进行基础检查,并归纳需要检查的 Mod
-        Dim CurrentModList As New List(Of McMod)
-        For Each ModEntity In Mods
-            If Not ModEntity.IsFileAvailable Then
-                Result.Add("无法读取的 Mod 文件。" & vbCrLf & " - " & ModEntity.Path)
-                Continue For
-            End If
-            If ModEntity.State = McMod.McModState.Fine AndAlso ModEntity.ModId IsNot Nothing Then CurrentModList.Add(ModEntity)
-        Next
-        '添加默认依赖
-        Dim CurrentDependencies As New Dictionary(Of String, String()) '{DependencyVersion, Path}
-        If Version.State = McVersionState.Forge Then CurrentDependencies.Add("forge", {Version.Version.ForgeVersion, "Forge"})
-        CurrentDependencies.Add("minecraft", {Version.Version.McName, "Minecraft"})
-        '检查重复的 Mod,并添加对应的依赖
-        For Each ModEntity In CurrentModList
-            For Each PossibleModId In ModEntity.PossibleModId
-                If CurrentDependencies.ContainsKey(PossibleModId) Then
-                    If CurrentDependencies(PossibleModId)(2) = 1 Then
-                        Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
-                            " - " & ModEntity.FileName & vbCrLf &
-                            " - " & CurrentDependencies(PossibleModId)(1))
-                    Else
-                        Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
-                            " - " & ModEntity.FileName & vbCrLf &
-                            " - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
-                    End If
-                Else
-                    CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
-                End If
-            Next
-        Next
-        '检查依赖
-        For Each ModEntity In CurrentModList
-            Try
-                For Each Dependency In ModEntity.Dependencies
-                    Dim ReqId As String = Dependency.Key
-                    If ReqId.Count < 2 Then Continue For '确保正常
-                    If ReqId = ModEntity.ModId Then Continue For '跳过自体引用
-                    If ReqId = "forgemultipartcbe" Then Continue For '跳过莫名其妙的引用
-                    If Dependency.Value IsNot Nothing Then
-                        '获取分段后的详细版本信息
-                        Dim ReqVersion As String = Dependency.Value
-                        Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
-                        Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
-                        Dim ReqVersionHead As String
-                        Dim ReqVersionTail As String
-                        If ReqVersion.Contains(",") Then
-                            ReqVersionHead = ReqVersion.Split(",")(0).Trim("([ ".ToCharArray())
-                            ReqVersionTail = ReqVersion.Split(",")(1).Trim("]) ".ToCharArray())
-                        Else
-                            ReqVersionHead = ReqVersion.Trim("([]) ".ToCharArray())
-                            ReqVersionTail = ReqVersionHead
-                            If ReqId = "minecraft" AndAlso ReqVersionHead.Split(".").Count = 2 Then
-                                ReqVersionTail = ReqVersionHead.Split(".")(0) & "." & (Val(ReqVersionHead.Split(".")(1)) + 1)
-                                ReqVersionTailCanEqual = False
-                            End If
-                        End If
-                        If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
-                        If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
-                        '获取报错描述文本
-                        Dim VersionRequire As String
-                        If ReqVersionHead = ReqVersionTail Then
-                            VersionRequire = "应为 " & ReqVersionHead
-                        ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
-                            VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
-                        ElseIf ReqVersionHead.Contains(".") Then
-                            If ReqVersionHeadCanEqual Then
-                                VersionRequire = "最低应为 " & ReqVersionHead
-                            Else
-                                VersionRequire = "应高于 " & ReqVersionHead
-                            End If
-                        ElseIf ReqVersionTail.Contains(".") Then
-                            If ReqVersionTailCanEqual Then
-                                VersionRequire = "最高应为 " & ReqVersionHead
-                            Else
-                                VersionRequire = "应低于 " & ReqVersionHead
-                            End If
-                        Else
-                            VersionRequire = ""
-                        End If
-                        '检查前置 Mod 是否存在,并获取其版本
-                        If Not CurrentDependencies.ContainsKey(ReqId) Then
-                            Result.Add("缺少前置 Mod:" & ReqId & If(VersionRequire = "", "", ",其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
-                            Continue For
-                        End If
-                        Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
-                        If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
-                        '对比前置 Mod 头部版本
-                        If ReqVersionHead.Contains(".") Then
-                            If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
-                                Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
-                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
-                                Continue For
-                            End If
-                        End If
-                        '对比前置 Mod 尾部版本
-                        If ReqVersionTail.Contains(".") Then
-                            If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
-                                Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
-                                           " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
-                                Continue For
-                            End If
-                        End If
-                    Else
-                        If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
-                            Result.Add("缺少前置 Mod:" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
-                            Continue For
-                        End If
-                    End If
-                Next
-            Catch ex As Exception
-                Result.Add("检查 Mod 时出错:" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
-                Log(ex, "检查 Mod 时出错")
-            End Try
-        Next
-        If Not Result.Any() Then
-            Log("[Minecraft] Mod 检查未发现异常")
-        Else
-            Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
-        End If
-        Return Result
-    End Function
-#End If
-
 End Module

+ 120 - 114
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb

@@ -24,14 +24,14 @@ Public Module ModModpack
     ''' 必须在工作线程执行。
     ''' </summary>
     ''' <exception cref="CancelledException" />
-    Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
+    Public Function ModpackInstall(File As String, Optional InstanceName 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 = ""
         Try
             '字符校验
-            Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
-            If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException
+            Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
+            If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Red) : Throw New CancelledException
             '获取整合包种类与关键 Json
             Dim PackType As Integer = -1
             Try
@@ -72,7 +72,7 @@ Public Module ModModpack
                     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
+                If ex.GetDetail(True).Contains("Error.WinIOError") Then
                     Throw New Exception("打开整合包文件失败", ex)
                 ElseIf File.EndsWithF(".rar", True) Then
                     Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
@@ -84,7 +84,7 @@ Public Module ModModpack
             Select Case PackType
                 Case 0
                     Log("[ModPack] 整合包种类:CurseForge")
-                    Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
+                    Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
                 Case 1
                     Log("[ModPack] 整合包种类:HMCL")
                     Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -93,10 +93,10 @@ Public Module ModModpack
                     Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
                 Case 3
                     Log("[ModPack] 整合包种类:MCBBS")
-                    Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
+                    Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
                 Case 4
                     Log("[ModPack] 整合包种类:Modrinth")
-                    Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
+                    Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
                 Case 9
                     Log("[ModPack] 整合包种类:带启动器的压缩包")
                     Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
@@ -112,19 +112,14 @@ Public Module ModModpack
     Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double)
         '解压文件
         Dim RetryCount As Integer = 1
-        Dim Encode = Encoding.GetEncoding("GB18030")
         Dim InitialProgress = Loader.Progress
         Try
 Retry:
             Loader.Progress = InitialProgress
             DeleteDirectory(InstallTemp)
-            ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
+            ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
         Catch ex As Exception
             Log(ex, "第 " & RetryCount & " 次解压尝试失败")
-            If TypeOf ex Is ArgumentException Then
-                Encode = Encoding.UTF8
-                Log("[ModPack] 已切换压缩包解压编码为 UTF8")
-            End If
             '完全不知道为啥会出现文件正在被另一进程使用的问题,总之加个重试
             If RetryCount < 5 Then
                 Thread.Sleep(RetryCount * 2000)
@@ -158,6 +153,7 @@ Retry:
         If File.Exists(OverridesIni) Then
             WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
             WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
+            WriteIni(OverridesIni, "IsStar", False)
             CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
         Else
             WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
@@ -165,12 +161,21 @@ Retry:
         End If
         IniClearCache(VersionIni) '重置缓存,避免被安装过程中写入的 ini 覆盖
     End Sub
+    ''' <summary>
+    ''' 弹窗提示整合包中存在不兼容的加载器。
+    ''' 如果取消,则抛出 CancelledException。
+    ''' </summary>
+    ''' <exception cref="CancelledException" />
+    Private Sub NotifyIncompatibleLoader(LoaderName As String)
+        If MyMsgBox($"整合包中存在不兼容的加载器:{LoaderName}{vbCrLf}如果你知道如何手动安装它,可以先选择跳过,然后在整合包下载结束后手动安装。",
+            "不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
+    End Sub
 
 #Region "不同类型整合包的安装方法"
 
     'CurseForge
     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)
+                                           Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
 
         '读取 Json 文件
         Dim Json As JObject
@@ -182,12 +187,12 @@ Retry:
         If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
 
         '获取版本名
-        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
+        If InstanceName Is Nothing Then
+            InstanceName = If(Json("name"), "")
+            Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
+            If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
+            If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
         End If
 
         '获取 Mod API 版本信息
@@ -195,7 +200,7 @@ Retry:
         Dim NeoForgeVersion As String = Nothing
         Dim FabricVersion As String = Nothing
         For Each Entry In If(Json("minecraft")("modLoaders"), {})
-            Dim Id As String = If(Entry("id"), "").ToString.ToLower
+            Dim Id As String = If(Entry("id"), "").ToString.Lower
             If Id.StartsWithF("forge-") Then
                 'Forge 指定
                 If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
@@ -210,7 +215,8 @@ Retry:
                 Log("[ModPack] 整合包 Fabric 版本:" & Id)
                 FabricVersion = Id.Replace("fabric-", "")
             Else
-                Log("[ModPack] 未知 Mod 加载器:" & Id)
+                'ElseIf Id.StartsWithF("quilt-") Then
+                NotifyIncompatibleLoader(Id)
             End If
         Next
         '解压
@@ -223,7 +229,7 @@ Retry:
                 ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
                 CopyOverrideDirectory(
                     InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
-                    $"{PathMcFolder}versions\{VersionName}",
+                    $"{McFolderSelected}versions\{InstanceName}",
                     Task, 0.4)
             End Sub) With {
             .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -244,7 +250,7 @@ Retry:
             '获取 Mod 下载信息
             ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
             Sub(Task As LoaderTask(Of Integer, JArray))
-                Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
+                Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
                 '如果文件已被删除,则 API 会跳过那一项
                 If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
             End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -267,7 +273,7 @@ Retry:
                     If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
                         Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
                         If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
-                           ModJson?("FileName")?.ToString?.EndsWithF(".jar", True) Then
+                           ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
                             TargetFolder = "mods" : Type = CompType.Mod
                         ElseIf ModuleNames.Contains("pack.mcmeta") Then
                             TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
@@ -281,7 +287,7 @@ Retry:
                     Dim File As New CompFile(ModJson, Type)
                     If Not File.Available Then Continue For
                     '实际的添加
-                    FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
+                    FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
                     Task.Progress += 1 / (1 + ModList.Count)
                 Next
                 Task.Output = FileList.Values.ToList
@@ -295,8 +301,8 @@ Retry:
 
         '构造加载器
         Dim Request As New McInstallRequest With {
-            .TargetVersionName = VersionName,
-            .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
+            .NewInstanceName = InstanceName,
+            .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
             .MinecraftName = Json("minecraft")("version").ToString,
             .ForgeVersion = ForgeVersion,
             .NeoForgeVersion = NeoForgeVersion,
@@ -310,7 +316,7 @@ Retry:
         Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
         Sub(Task As LoaderTask(Of String, String))
             '设置图标
-            Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
+            Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
             If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
                 File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
                 WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -324,22 +330,22 @@ Retry:
                     File.Delete(Target)
                 End If
             Next
-            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+            If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
                 Log("[ModPack] 删除安装整合包文件:" & FileAddress)
                 File.Delete(FileAddress)
             End If
         End Sub) With {.ProgressWeight = 0.1, .Show = False})
 
         '重复任务检查
-        Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
+        Dim LoaderName As String = "CurseForge 整合包安装:" & InstanceName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中!", HintType.Critical)
+            Hint("该整合包正在安装中!", HintType.Red)
             Throw New CancelledException
         End If
 
         '启动
         Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
-        Loader.Start(Request.TargetVersionFolder)
+        Loader.Start(Request.VersionFolder)
         LoaderTaskbarAdd(Loader)
         FrmMain.BtnExtraDownload.ShowRefresh()
         RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -347,7 +353,7 @@ Retry:
     End Function
 
     'Modrinth
-    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)
+    Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
 
         '读取 Json 文件
         Dim Json As JObject
@@ -363,7 +369,7 @@ Retry:
         Dim NeoForgeVersion As String = Nothing
         Dim FabricVersion As String = Nothing
         For Each Entry As JProperty In If(Json("dependencies"), {})
-            Select Case Entry.Name.ToLower
+            Select Case Entry.Name.Lower
                 Case "minecraft"
                     MinecraftVersion = Entry.Value.ToString
                 Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
@@ -375,21 +381,18 @@ Retry:
                 Case "fabric-loader" 'eg. 0.14.14
                     FabricVersion = Entry.Value.ToString
                     Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
-                Case "quilt-loader" 'eg. 1.0.0
-                    Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
-                    Throw New CancelledException
                 Case Else
-                    Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
-                    Throw New CancelledException
+                    'Case "quilt-loader" 'eg. 1.0.0
+                    NotifyIncompatibleLoader(Entry.Name)
             End Select
         Next
         '获取版本名
-        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
+        If InstanceName Is Nothing Then
+            InstanceName = If(Json("name"), "")
+            Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
+            If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
+            If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
         End If
         '解压
         Dim InstallTemp As String = RequestTaskTempFolder()
@@ -399,11 +402,11 @@ Retry:
             ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
             CopyOverrideDirectory(
                 InstallTemp & ArchiveBaseFolder & "overrides",
-                PathMcFolder & "versions\" & VersionName,
+                McFolderSelected & "versions\" & InstanceName,
                 Task, 0.4)
             CopyOverrideDirectory(
                 InstallTemp & ArchiveBaseFolder & "client-overrides",
-                PathMcFolder & "versions\" & VersionName,
+                McFolderSelected & "versions\" & InstanceName,
                 Task, 0.1)
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '获取下载文件列表
@@ -425,8 +428,8 @@ Retry:
             Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
             Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
             Urls = Urls.Distinct.ToList()
-            Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}"
-            If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then
+            Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
+            If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
                 MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True)
                 Throw New CancelledException
             End If
@@ -439,8 +442,8 @@ Retry:
 
         '构造加载器
         Dim Request As New McInstallRequest With {
-            .TargetVersionName = VersionName,
-            .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
+            .NewInstanceName = InstanceName,
+            .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
             .MinecraftName = MinecraftVersion,
             .ForgeVersion = ForgeVersion,
             .NeoForgeVersion = NeoForgeVersion,
@@ -454,7 +457,7 @@ Retry:
         Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
         Sub(Task As LoaderTask(Of String, String))
             '设置图标
-            Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
+            Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
             If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
                 File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
                 WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -468,22 +471,22 @@ Retry:
                     File.Delete(Target)
                 End If
             Next
-            If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
+            If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
                 Log("[ModPack] 删除安装整合包文件:" & FileAddress)
                 File.Delete(FileAddress)
             End If
         End Sub) With {.ProgressWeight = 0.1, .Show = False})
 
         '重复任务检查
-        Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} "
+        Dim LoaderName As String = $"Modrinth 整合包安装:{InstanceName} "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中!", HintType.Critical)
+            Hint("该整合包正在安装中!", HintType.Red)
             Throw New CancelledException
         End If
 
         '启动
         Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
-        Loader.Start(Request.TargetVersionFolder)
+        Loader.Start(Request.VersionFolder)
         LoaderTaskbarAdd(Loader)
         FrmMain.BtnExtraDownload.ShowRefresh()
         RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -500,11 +503,11 @@ Retry:
             Throw New Exception("HMCL 整合包安装信息存在问题", ex)
         End Try
         '获取版本名
-        Dim VersionName As String = 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
+        Dim InstanceName As String = If(Json("name"), "")
+        Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
+        If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
+        If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+        If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
         '解压
         Dim InstallTemp As String = RequestTaskTempFolder()
         Dim InstallLoaders As New List(Of LoaderBase)
@@ -513,14 +516,14 @@ Retry:
             ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
             CopyOverrideDirectory(
                 InstallTemp & ArchiveBaseFolder & "minecraft",
-                PathMcFolder & "versions\" & VersionName,
+                McFolderSelected & "versions\" & InstanceName,
                 Task, 0.4)
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '构造游戏本体安装加载器
         If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
         Dim Request As New McInstallRequest With {
-            .TargetVersionName = VersionName,
-            .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
+            .NewInstanceName = InstanceName,
+            .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
             .MinecraftName = Json("gameVersion").ToString
         }
         Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
@@ -530,14 +533,14 @@ Retry:
             New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
         }
         '重复任务检查
-        Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
+        Dim LoaderName As String = "HMCL 整合包安装:" & InstanceName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中!", HintType.Critical)
+            Hint("该整合包正在安装中!", HintType.Red)
             Throw New CancelledException
         End If
         '启动
         Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
-        Loader.Start(Request.TargetVersionFolder)
+        Loader.Start(Request.VersionFolder)
         LoaderTaskbarAdd(Loader)
         FrmMain.BtnExtraDownload.ShowRefresh()
         RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -555,21 +558,21 @@ Retry:
             Throw New Exception("MMC 整合包安装信息存在问题", ex)
         End Try
         '获取版本名
-        Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
-        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
+        Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
+        Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
+        If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
+        If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+        If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
         '解压
         Dim InstallTemp As String = RequestTaskTempFolder()
-        Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
+        Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
         Dim InstallLoaders As New List(Of LoaderBase)
         InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
         Sub(Task As LoaderTask(Of String, Integer))
             ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
             CopyOverrideDirectory(
                 InstallTemp & ArchiveBaseFolder & ".minecraft",
-                PathMcFolder & "versions\" & VersionName,
+                McFolderSelected & "versions\" & InstanceName,
                 Task, 0.4)
             '读取 MMC 设置文件(#2655)
             Try
@@ -581,7 +584,7 @@ Retry:
                         If Not Line.Contains("=") Then Continue For
                         Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
                     Next
-                    WriteFile(MMCSetupFile, Join(Lines, vbCrLf))
+                    WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
                     '读取文件
                     If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
                         Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
@@ -608,7 +611,7 @@ Retry:
                     If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
                         WriteIni(SetupFile, "LogoCustom", True)
                         WriteIni(SetupFile, "Logo", "PCL\Logo.png")
-                        CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
+                        CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
                         Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
                     End If
                     'JVM 参数
@@ -618,7 +621,7 @@ Retry:
                             WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
                             Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
                         Else
-                            JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
+                            JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
                             WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
                             Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
                         End If
@@ -630,11 +633,11 @@ Retry:
         End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
         '构造版本安装请求
         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
-                Case "org.lwjgl"
-                    Log("[ModPack] 已跳过 LWJGL 项")
+        Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
+        For Each Component As JObject In PackJson("components")
+            If Not Component.ContainsKey("uid") Then Continue For
+            Dim UID As String = Component("uid").ToString
+            Select Case UID
                 Case "net.minecraft"
                     Request.MinecraftName = Component("version")
                 Case "net.minecraftforge"
@@ -643,9 +646,13 @@ Retry:
                     Request.NeoForgeVersion = Component("version")
                 Case "net.fabricmc.fabric-loader"
                     Request.FabricVersion = Component("version")
-                Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
-                    Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
-                    Throw New CancelledException
+                    'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
+                Case Else
+                    If UID.StartsWithF("org.lwjgl") Then '#8210
+                        Log("[ModPack] 已跳过 LWJGL 项:" & UID)
+                    Else
+                        NotifyIncompatibleLoader(UID)
+                    End If
             End Select
         Next
         '构造加载器
@@ -656,15 +663,15 @@ Retry:
         Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
 
         '重复任务检查
-        Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
+        Dim LoaderName As String = "MMC 整合包安装:" & InstanceName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中!", HintType.Critical)
+            Hint("该整合包正在安装中!", HintType.Red)
             Throw New CancelledException
         End If
 
         '启动
         Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
-        Loader.Start(Request.TargetVersionFolder)
+        Loader.Start(Request.VersionFolder)
         LoaderTaskbarAdd(Loader)
         FrmMain.BtnExtraDownload.ShowRefresh()
         RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -673,7 +680,7 @@ Retry:
 
     'MCBBS
     Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
-                                      Optional VersionName As String = Nothing) As LoaderCombo(Of String)
+                                      Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
         '读取 Json 文件
         Dim Json As JObject
         Try
@@ -683,23 +690,23 @@ Retry:
             Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
         End Try
         '获取版本名
-        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
+        If InstanceName Is Nothing Then
+            InstanceName = If(Json("name"), "")
+            Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
+            If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
+            If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
         End If
         '解压
         Dim InstallTemp As String = RequestTaskTempFolder()
-        Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
+        Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
         Dim InstallLoaders As New List(Of LoaderBase)
         InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
         Sub(Task As LoaderTask(Of String, Integer))
             ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
             CopyOverrideDirectory(
                 InstallTemp & ArchiveBaseFolder & "overrides",
-                PathMcFolder & "versions\" & VersionName,
+                McFolderSelected & "versions\" & InstanceName,
                 Task, 0.4)
             'JVM 参数
             If Json("launchInfo") IsNot Nothing Then
@@ -716,12 +723,12 @@ Retry:
         Next
         If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
         If Addons.ContainsKey("quilt") Then
-            Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
+            Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Red)
             Throw New CancelledException
         End If
         Dim Request As New McInstallRequest With {
-            .TargetVersionName = VersionName,
-            .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
+            .NewInstanceName = InstanceName,
+            .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
             .MinecraftName = Addons("game"),
             .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
             .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
@@ -735,16 +742,16 @@ Retry:
         Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
 
         '重复任务检查
-        Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
+        Dim LoaderName As String = "MCBBS 整合包安装:" & InstanceName & " "
         If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
-            Hint("该整合包正在安装中!", HintType.Critical)
+            Hint("该整合包正在安装中!", HintType.Red)
             Throw New CancelledException
         End If
 
         '启动
         Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
         'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
-        Loader.Start(Request.TargetVersionFolder)
+        Loader.Start(Request.VersionFolder)
         LoaderTaskbarAdd(Loader)
         FrmMain.BtnExtraDownload.ShowRefresh()
         RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -757,7 +764,7 @@ Retry:
         MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
         Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
         If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
-        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
+        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
         '解压
         Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
             New LoaderTask(Of String, Integer)("解压压缩包",
@@ -786,7 +793,7 @@ Retry:
                     Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
                     If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
                         OpenExplorer(TargetFolder)
-                        ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
+                        StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
                         Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
                         FrmMain.EndProgram(False)
                         Return
@@ -796,11 +803,11 @@ Retry:
                 End If
                 OpenExplorer(TargetFolder)
                 '加入文件夹列表
-                Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
+                Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
                 Directory.CreateDirectory(TargetFolder & ".minecraft\")
                 PageSelectLeft.AddFolder(
                     TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
-                    VersionName, False)
+                    InstanceName, False)
                 '调用 modpack 文件进行安装
                 Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
                 Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
@@ -826,16 +833,15 @@ Retry:
                 Exit For
             End If
         Next
-        If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配
+        If Match Is Nothing Then Throw New Exception("文件结构不匹配,这可能不是 Minecraft 客户端压缩包?") '没有匹配
         Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
-        Dim VersionName As String = Match.Groups(1).Value
-        Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
+        Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & Match.Groups(1).Value)
         '获取解压路径
         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
+        If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Throw New CancelledException
+        If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
         '解压
         Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
             New LoaderTask(Of String, Integer)("解压压缩包",
@@ -844,7 +850,7 @@ Retry:
                 '加入文件夹列表
                 PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
                 Thread.Sleep(400) '避免文件争用
-                RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
+                RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
             End Sub)
         }) With {.OnStateChanged = AddressOf McInstallState}
         Loader.Start(TargetFolder)

+ 15 - 15
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb

@@ -33,13 +33,13 @@
         HasRunningMinecraft = False
         FrmMain.BtnExtraShutdown.ShowRefresh()
         '音乐播放
-        If Setup.Get("UiMusicStop") Then
+        If Settings.Get("UiMusicStop") Then
             RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放"))
-        ElseIf Setup.Get("UiMusicStart") Then
+        ElseIf Settings.Get("UiMusicStart") Then
             RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放"))
         End If
         '启动器可见性
-        Select Case Setup.Get("LaunchArgumentVisible")
+        Select Case Settings.Get("LaunchArgumentVisible")
             Case 2
                 '直接关闭
                 If TriggerLauncherShutdown Then
@@ -58,13 +58,13 @@
 
         '初始化
         Public GameProcess As Process
-        Public Version As McVersion
+        Public Instance As McInstance
         Private WindowTitle As String = ""
         Private PID As Integer
         Public Loader As LoaderTask(Of Process, Integer)
-        Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String)
+        Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
             Me.Loader = Loader
-            Me.Version = Version
+            Me.Instance = Instance
             Me.WindowTitle = WindowTitle
             Me.PID = Loader.Input.Id
             WatcherLog("开始 Minecraft 日志监控")
@@ -91,13 +91,13 @@
             RunInNewThread(
             Sub()
                 Try
-                    Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
+                    Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
                         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"))
+                                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)
@@ -164,7 +164,7 @@
                         '窗口未出现
                         WatcherLog("Minecraft 尚未加载完成,可能已崩溃")
                         Crashed()
-                    ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then
+                    ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then
                         '返回值不为 0 且未结束
                         WatcherLog("Minecraft 返回值异常,可能已崩溃")
                         Crashed()
@@ -277,7 +277,7 @@
                     WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
                     IsWindowFinished = True
                     '最大化
-                    If Setup.Get("LaunchArgumentWindowType") = 4 Then
+                    If Settings.Get("LaunchArgumentWindowType") = 4 Then
                         RunInNewThread(
                         Sub()
                             Try
@@ -349,19 +349,19 @@
             State = MinecraftState.Crashed
             '崩溃分析
             WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
-            Hint("检测到 Minecraft 出现错误,错误分析已开始……")
+            Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Red)
             FeedbackInfo()
             RunInNewThread(
             Sub()
                 Try
                     Thread.Sleep(2000)
                     WatcherLog("崩溃分析开始")
-                    Dim Analyzer As New CrashAnalyzer(PID)
-                    Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
+                    Dim Analyzer As New CrashAnalyzer(Instance)
+                    Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
                     Analyzer.Prepare()
-                    Analyzer.Analyze(Version)
+                    Analyzer.Analyze()
                     Analyzer.Output(False, New List(Of String) From
-                        {Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
+                        {Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
                 Catch ex As Exception
                     Log(ex, "崩溃分析失败", LogLevel.Feedback)
                 End Try

+ 305 - 80
Plain Craft Launcher 2/Modules/ModEvent.vb

@@ -1,125 +1,334 @@
-Public Module ModEvent
+
+#Region "附加属性"
 
-    Public Sub TryStartEvent(Type As String, Data As String)
-        If String.IsNullOrWhiteSpace(Type) Then Return
-        Dim RealData As String() = {""}
-        If Data IsNot Nothing Then RealData = Data.Split("|")
-        StartEvent(Type, RealData)
+''' <summary>
+''' 用于在 XAML 中初始化列表对象。
+''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象,因此需要一个包装类,然后在 XAML 中显式初始化。
+''' </summary>
+<Markup.ContentProperty("Events")>
+Public Class CustomEventCollection
+    Implements IEnumerable(Of CustomEvent)
+    Dim _Events As New List(Of CustomEvent)
+    Public ReadOnly Property Events As List(Of CustomEvent)
+        Get
+            Return _Events
+        End Get
+    End Property
+    Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
+        Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
+    End Function
+    Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
+        Return DirectCast(Events, IEnumerable).GetEnumerator()
+    End Function
+End Class
+
+''' <summary>
+''' 提供自定义事件的附加属性。
+''' </summary>
+Public Class CustomEventService
+
+    'Events
+    Public Shared ReadOnly EventsProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
+        d.SetValue(EventsProperty, value)
+    End Sub
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
+        If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
+        Return d.GetValue(EventsProperty)
+    End Function
+
+    'EventType
+    Public Shared ReadOnly EventTypeProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
+        d.SetValue(EventTypeProperty, value)
+    End Sub
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
+        Return d.GetValue(EventTypeProperty)
+    End Function
+
+    'EventData
+    Public Shared ReadOnly EventDataProperty As DependencyProperty =
+            DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Sub SetEventData(d As DependencyObject, value As String)
+        d.SetValue(EventDataProperty, value)
+    End Sub
+    <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
+    Public Shared Function GetEventData(d As DependencyObject) As String
+        Return d.GetValue(EventDataProperty)
+    End Function
+
+End Class
+
+Partial Public Module ModMain
+
+    ''' <summary>
+    ''' 触发该控件上的自定义事件。
+    ''' 事件会在新线程中执行。
+    ''' </summary>
+    <Runtime.CompilerServices.Extension>
+    Public Sub RaiseCustomEvent(Control As DependencyObject)
+        '收集事件列表
+        Dim Events = CustomEventService.GetEvents(Control).ToList
+        Dim EventType = CustomEventService.GetEventType(Control)
+        If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
+        '执行事件
+        If Not Events.Any Then Return
+        RunInNewThread(
+        Sub()
+            For Each e In Events
+                e.Raise()
+            Next
+        End Sub, "执行自定义事件 " & GetUuid())
+    End Sub
+
+End Module
+
+#End Region
+
+''' <summary>
+''' 自定义事件。
+''' </summary>
+Public Class CustomEvent
+    Inherits DependencyObject
+
+#Region "属性与触发"
+
+    Public Property Type As EventType
+        Get
+            Dim Value As EventType = EventType.None
+            RunInUiWait(Sub() Value = GetValue(TypeProperty))
+            Return Value
+        End Get
+        Set(value As EventType)
+            SetValue(TypeProperty, value)
+        End Set
+    End Property
+    Public Shared ReadOnly TypeProperty As DependencyProperty =
+        DependencyProperty.Register("Type", GetType(EventType), GetType(CustomEvent), New PropertyMetadata(EventType.None))
+
+    Public Property Data As String
+        Get
+            Dim Value As String = Nothing
+            RunInUiWait(Sub() Value = GetValue(DataProperty))
+            Return Value
+        End Get
+        Set(value As String)
+            SetValue(DataProperty, value)
+        End Set
+    End Property
+    Public Shared ReadOnly DataProperty As DependencyProperty =
+        DependencyProperty.Register("Data", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
+
+    Public Sub New()
+    End Sub
+    Public Sub New(Type As EventType, Data As String)
+        Me.Type = Type
+        Me.Data = Data
+    End Sub
+
+    ''' <summary>
+    ''' 在当前线程中触发该自定义事件。
+    ''' </summary>
+    Public Sub Raise()
+        Raise(Type, Data)
     End Sub
-    Public Sub StartEvent(Type As String, Data As String())
+
+#End Region
+
+    Public Enum EventType
+        None = 0
+        打开网页
+        打开文件
+        打开帮助
+        执行命令
+        启动游戏
+        复制文本
+        刷新主页
+        刷新页面
+        刷新帮助
+        今日人品
+        内存优化
+        清理垃圾
+        弹出窗口
+        弹出提示
+        切换页面
+        导入整合包
+        安装整合包
+        下载文件
+        修改设置
+        写入设置
+        修改变量
+        写入变量
+        加入房间
+        检查更新
+    End Enum
+
+    ''' <summary>
+    ''' 在当前线程中触发一个自定义事件。
+    ''' </summary>
+    Public Shared Sub Raise(Type As EventType, Arg As String)
+        If Type = EventType.None Then Return
+        Log($"[Control] 执行自定义事件:{Type}, {Arg}")
+        If Arg Is Nothing Then Arg = ""
+        Dim Args As String() = Arg.Split("|")
         Try
-            Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", "))
             Select Case Type
-
-                Case "打开网页"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
+                Case EventType.打开网页
+                    Arg = Arg.Replace("\", "/")
+                    If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
                         MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
                         Return
                     End If
-                    Hint("正在开启中,请稍候……")
-                    OpenWebsite(Data(0))
+                    Hint("正在开启中,请稍候:" & Arg)
+                    RunInThread(Sub() OpenWebsite(Arg))
 
-                Case "打开文件", "打开帮助", "执行命令"
+                Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
                     RunInThread(
                     Sub()
                         Try
                             '确认实际路径
-                            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
+                            Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
                             Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
                             Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
                             '执行
-                            If Type = "打开帮助" Then
+                            If Type = EventType.打开帮助 Then
                                 PageOtherHelp.EnterHelpPage(Location)
                             Else
-                                If Not Setup.Get("HintCustomCommand") Then
-                                    Select Case MyMsgBox(
-                                    "即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
-                                    "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
-                                        Case 2
-                                            Setup.Set("HintCustomCommand", True)
-                                        Case 3
-                                            Return
-                                    End Select
-                                End If
+                                If Not EventSafetyConfirm("即将执行:" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
                                 Dim Info As New ProcessStartInfo With {
-                                    .Arguments = If(Data.Length >= 2, Data(1), ""),
+                                    .Arguments = If(Args.Length >= 2, Args(1), ""),
                                     .FileName = Location,
-                                    .WorkingDirectory = ShortenPath(WorkingDir)
+                                    .WorkingDirectory = WorkingDir
                                 }
-                                Process.Start(Info)
+                                StartProcess(Info)
                             End If
                         Catch ex As Exception
                             Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
                         End Try
                     End Sub)
 
-                Case "启动游戏"
-                    If Data(0) = "\current" Then
-                        If McVersionCurrent Is Nothing Then
-                            Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
+                Case EventType.启动游戏
+                    If Args(0) = "\current" Then
+                        If McInstanceSelected Is Nothing Then
+                            Hint("请先选择一个 Minecraft 版本!", HintType.Red)
                             Return
                         Else
-                            Data(0) = McVersionCurrent.Name
+                            Args(0) = McInstanceSelected.Name
                         End If
                     End If
-                    If McLaunchStart(New McLaunchOptions With
-                                     {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
-                        Hint("正在启动 " & Data(0) & "……")
-                    End If
+                    RunInUi(
+                    Sub()
+                        If McLaunchStart(New McLaunchOptions With
+                                {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
+                            Hint($"正在启动 {Args(0)}……")
+                        End If
+                    End Sub)
+
+                Case EventType.复制文本
+                    ClipboardSet(Arg)
 
-                Case "复制文本"
-                    ClipboardSet(Join(Data, "|"))
+                Case EventType.刷新主页
+                    RunInUi(
+                    Sub()
+                        FrmLaunchRight.ForceRefresh()
+                        If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
+                    End Sub)
 
-                Case "刷新主页"
-                    FrmLaunchRight.ForceRefresh()
-                    If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
+                Case EventType.刷新页面
+                    If TypeOf FrmMain.PageRight Is IRefreshable Then
+                        RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
+                        If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
+                    Else
+                        Hint("当前页面不支持刷新操作!", HintType.Red)
+                    End If
 
-                Case "刷新帮助"
-                    PageOtherLeft.RefreshHelp()
+                Case EventType.刷新帮助
+                    RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
+                    If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
 
-                Case "今日人品"
+                Case EventType.今日人品
                     PageOtherTest.Jrrp()
 
-                Case "内存优化"
+                Case EventType.内存优化
                     RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
 
-                Case "清理垃圾"
+                Case EventType.清理垃圾
                     RunInThread(Sub() PageOtherTest.RubbishClear())
 
-                Case "弹出窗口"
-                    MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
+                Case EventType.弹出窗口
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 弹窗标题|弹窗内容")
+                    MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
+
+                Case EventType.弹出提示
+                    Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ParseToEnum(Of HintType)))
 
-                Case "切换页面"
-                    FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
+                Case EventType.切换页面
+                    RunInUi(Sub() FrmMain.PageChange(
+                                Args(0).ParseToEnum(Of FormMain.PageType),
+                                If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ParseToEnum(Of FormMain.PageSubType))))
 
-                Case "导入整合包", "安装整合包"
+                Case EventType.导入整合包, EventType.安装整合包
                     RunInUi(Sub() ModpackInstall())
 
-                Case "下载文件"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
+                Case EventType.下载文件
+                    Args(0) = Args(0).Replace("\", "/")
+                    If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
                         MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
                         Return
                     End If
-                    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
+                    If Not EventSafetyConfirm("即将从该网址下载文件:" & vbCrLf & Args(0)) Then Return
+                    RunInUi(
+                    Sub()
+                        Try
+                            Select Case Args.Length
+                                Case 1
+                                    PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0)))
+                                Case 2
+                                    PageOtherTest.StartCustomDownload(Args(0), Args(1))
+                                Case Else
+                                    PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
+                            End Select
+                        Catch
+                            PageOtherTest.StartCustomDownload(Args(0), "未知")
+                        End Try
+                    End Sub)
+
+                Case EventType.修改设置, EventType.写入设置
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
+                    Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
+                    If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
+
+                Case EventType.修改变量, EventType.写入变量
+                    If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
+                    WriteReg("CustomEvent" & Args(0), Args(1))
+                    If Args.Length = 2 Then Hint($"已写入变量:{Args(0)} → {Args(1)}", HintType.Green)
+
+                Case EventType.加入房间
+                    RunInUi(
+                    Sub()
+                        If String.IsNullOrWhiteSpace(Arg) Then
+                            PageLinkMain.Join()
+                        Else
+                            If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
+                            PageLinkMain.Join(Arg)
+                        End If
+                    End Sub)
+
+                Case EventType.检查更新
+                    UpdateCheckByButton()
 
                 Case Else
                     MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
             End Select
         Catch ex As Exception
-            Log(ex, "事件执行失败", LogLevel.Msgbox)
+            Log(ex, $"事件执行失败({Type}, {Arg})", LogLevel.Msgbox)
         End Try
     End Sub
 
@@ -127,7 +336,7 @@
     ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
     ''' 失败会抛出异常。
     ''' </summary>
-    Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
+    Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
 
         '网页确认
         If RelativeUrl.StartsWithF("http", True) Then
@@ -160,7 +369,7 @@
             End Try
             RelativeUrl = LocalTemp
         End If
-        RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
+        RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
 
         '确认实际路径
         Dim Location As String, WorkingDir As String = Path & "PCL"
@@ -168,25 +377,25 @@
         If RelativeUrl.Contains(":\") Then
             '绝对路径
             Location = RelativeUrl
-            Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location)
+            Log("[Control] 自定义事件中由绝对路径" & Type & ":" & Location)
         ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
             '相对 PCL 文件夹的路径
             Location = Path & "PCL\" & RelativeUrl
-            Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location)
+            Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & ":" & Location)
         ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
             '相对 PCL 本地帮助文件夹的路径
             Location = Path & "PCL\Help\" & RelativeUrl
             WorkingDir = Path & "PCL\Help\"
-            Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location)
-        ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
+            Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & ":" & Location)
+        ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
             '相对 PCL 自带帮助文件夹的路径
             Location = PathTemp & "Help\" & RelativeUrl
             WorkingDir = PathTemp & "Help\"
-            Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
-        ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
+            Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & ":" & Location)
+        ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
             '直接使用原有路径启动程序
             Location = RelativeUrl
-            Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
+            Log("[Control] 自定义事件中直接" & Type & ":" & Location)
         Else
             '打开帮助,但是格式不对劲
             Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
@@ -195,4 +404,20 @@
         Return {Location, WorkingDir}
     End Function
 
-End Module
+    ''' <summary>
+    ''' 弹出安全确认弹窗。返回是否继续执行。
+    ''' </summary>
+    Private Shared Function EventSafetyConfirm(Message As String) As Boolean
+        If Settings.Get("HintCustomCommand") Then Return True
+        Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
+            Case 1
+                Return True
+            Case 2
+                Settings.Set("HintCustomCommand", True)
+                Return True
+            Case Else
+                Return False
+        End Select
+    End Function
+
+End Class

+ 154 - 99
Plain Craft Launcher 2/Modules/ModMain.vb

@@ -7,23 +7,12 @@ Public Module ModMain
 
     ''' <summary>
     ''' 提示信息的种类。
+    ''' 该枚举在自定义事件中使用,是公开 API 的一部分。
     ''' </summary>
     Public Enum HintType
-        ''' <summary>
-        ''' 信息,通常是蓝色的“i”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Info
-        ''' <summary>
-        ''' 已完成,通常是绿色的“√”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Finish
-        ''' <summary>
-        ''' 错误,通常是红色的“×”。
-        ''' </summary>
-        ''' <remarks></remarks>
-        Critical
+        Blue
+        Green
+        Red
     End Enum
     Private Structure HintMessage
         Public Text As String
@@ -38,7 +27,7 @@ Public Module ModMain
     ''' <summary>
     ''' 在窗口左下角弹出提示文本。
     ''' </summary>
-    Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
+    Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
         If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
         HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
     End Sub
@@ -68,13 +57,13 @@ Public Module ModMain
                 Dim TargetColor0, TargetColor1 As MyColor
                 Dim Percent As Double = 0.3
                 Select Case CurrentHint.Type
-                    Case HintType.Info
+                    Case HintType.Blue
                         TargetColor0 = New MyColor(215, 37, 155, 252)
                         TargetColor1 = New MyColor(215, 10, 142, 252)
-                    Case HintType.Finish
+                    Case HintType.Green
                         TargetColor0 = New MyColor(215, 33, 177, 33)
                         TargetColor1 = New MyColor(215, 29, 160, 29)
-                    Case Else 'HintType.Critical
+                    Case Else 'HintType.Red
                         TargetColor0 = New MyColor(215, 255, 53, 11)
                         TargetColor1 = New MyColor(215, 255, 43, 0)
                 End Select
@@ -177,7 +166,7 @@ EndHint:
         Public Text As String
         ''' <summary>
         ''' 输入模式:文本框的文本。
-        ''' 选择模式:需要放进去的 List(Of MyListItem)。
+        ''' 选择模式:需要放进去的 IEnumberable(Of IMyRadio)。
         ''' 登录模式:登录步骤 1 中返回的 JSON。
         ''' </summary>
         Public Content As Object
@@ -248,10 +237,6 @@ EndHint:
         '将弹窗列入队列
         Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
         WaitingMyMsgBox.Add(Converter)
-        If RunInUi() Then
-            '若为 UI 线程,立即执行弹窗刻, 避免快速(连点器)点击时多次弹窗
-            MyMsgBoxTick()
-        End If
         If Button2.Length > 0 OrElse ForceWait Then
             '若有多个按钮则开始等待
             If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
@@ -275,6 +260,7 @@ EndHint:
             Else
                 Try
                     FrmMain.DragStop()
+                    If RunInUi() Then MyMsgBoxTick()
                     ComponentDispatcher.PushModal()
                     Dispatcher.PushFrame(Converter.WaitFrame)
                 Finally
@@ -306,6 +292,7 @@ EndHint:
         '虽然我也不知道这是啥但是能用就成了 :)
         Try
             If FrmMain IsNot Nothing Then FrmMain.DragStop()
+            If RunInUi() Then MyMsgBoxTick()
             ComponentDispatcher.PushModal()
             Dispatcher.PushFrame(Converter.WaitFrame)
         Finally
@@ -321,13 +308,14 @@ EndHint:
     ''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param>
     ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
     ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
-    Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
+    Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
         '将弹窗列入队列
         Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
         WaitingMyMsgBox.Add(Converter)
         '虽然我也不知道这是啥但是能用就成了 :)
         Try
             If FrmMain IsNot Nothing Then FrmMain.DragStop()
+            If RunInUi() Then MyMsgBoxTick()
             ComponentDispatcher.PushModal()
             Dispatcher.PushFrame(Converter.WaitFrame)
         Finally
@@ -350,7 +338,7 @@ EndHint:
             ElseIf WaitingMyMsgBox.Any Then
                 '没有弹窗,显示一个等待的弹窗
                 FrmMain.PanMsg.Visibility = Visibility.Visible
-                Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
+                Select Case WaitingMyMsgBox(0).Type
                     Case MyMsgBoxType.Input
                         FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
                     Case MyMsgBoxType.Select
@@ -363,7 +351,7 @@ EndHint:
                 WaitingMyMsgBox.RemoveAt(0)
             Else
                 '没有弹窗,没有等待的弹窗
-                If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
+                If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
             End If
         Catch ex As Exception
             Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
@@ -388,21 +376,11 @@ EndHint:
     Public FrmSpeedRight As PageSpeedRight
 
     '联机页面声明
-    Public FrmLinkLeft As PageLinkLeft
-    Public FrmLinkIoi As PageLinkIoi
-    Public FrmLinkHiper As PageLinkHiper
-    Public FrmLinkHelp As PageOtherHelpDetail
-    Public FrmLinkFeedback As PageLinkFeedback
+    Public FrmLinkMain As PageLinkMain
 
     '下载页面声明
     Public FrmDownloadLeft As PageDownloadLeft
     Public FrmDownloadInstall As PageDownloadInstall
-    Public FrmDownloadClient As PageDownloadClient
-    Public FrmDownloadOptiFine As PageDownloadOptiFine
-    Public FrmDownloadLiteLoader As PageDownloadLiteLoader
-    Public FrmDownloadForge As PageDownloadForge
-    Public FrmDownloadNeoForge As PageDownloadNeoForge
-    Public FrmDownloadFabric As PageDownloadFabric
     Public FrmDownloadMod As PageDownloadMod
     Public FrmDownloadPack As PageDownloadPack
     Public FrmDownloadDataPack As PageDownloadDataPack
@@ -432,12 +410,12 @@ EndHint:
     Public FrmLoginMsSkin As PageLoginMsSkin
 
     '版本设置页面声明
-    Public FrmVersionLeft As PageVersionLeft
-    Public FrmVersionOverall As PageVersionOverall
-    Public FrmVersionMod As PageVersionMod
-    Public FrmVersionModDisabled As PageVersionModDisabled
-    Public FrmVersionSetup As PageVersionSetup
-    Public FrmVersionExport As PageVersionExport
+    Public FrmInstanceLeft As PageInstanceLeft
+    Public FrmInstanceOverall As PageInstanceOverall
+    Public FrmInstanceMod As PageInstanceMod
+    Public FrmInstanceModDisabled As PageInstanceModDisabled
+    Public FrmInstanceSetup As PageInstanceSetup
+    Public FrmInstanceExport As PageInstanceExport
 
     '资源信息分页声明
     Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -496,7 +474,7 @@ EndHint:
         ''' 是否为 “执行事件”。
         ''' </summary>
         Public IsEvent As Boolean
-        Public EventType As String
+        Public EventType As CustomEvent.EventType
         Public EventData As String
         ''' <summary>
         ''' 若非执行事件,其对应的 .xaml 本地文件内容。
@@ -510,7 +488,7 @@ EndHint:
         ''' </summary>
         Public Sub New(FilePath As String)
             RawPath = FilePath
-            Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
+            Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeXML))
             If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
             '加载常规信息
             If JsonData("Title") IsNot Nothing Then
@@ -530,12 +508,11 @@ EndHint:
             Next
             '加载事件信息
             If If(JsonData("IsEvent"), False) Then
-                EventType = JsonData("EventType")
-                If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
+                EventType = [Enum].Parse(GetType(CustomEvent.EventType), JsonData("EventType").ToString)
                 EventData = If(JsonData("EventData"), "")
                 IsEvent = True
             Else
-                Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml")
+                Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
                 If File.Exists(XamlAddress) Then
                     XamlContent = ReadFile(XamlAddress)
                     IsEvent = False
@@ -556,7 +533,7 @@ EndHint:
         Public Function SetToListItem(Item As MyListItem) As MyListItem
             Dim Logo As String
             If IsEvent Then
-                If EventType = "弹出窗口" Then
+                If EventType = CustomEvent.EventType.弹出窗口 Then
                     Logo = PathImage & "Blocks/GrassPath.png"
                 Else
                     Logo = PathImage & "Blocks/CommandBlock.png"
@@ -573,9 +550,9 @@ EndHint:
                 .Height = 42
                 .Type = MyListItem.CheckType.Clickable
                 .Tag = Me
-                .EventType = Nothing
-                .EventData = Nothing
             End With
+            CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性,它们会被下面的点击事件处理
+            CustomEventService.SetEventData(Item, Nothing)
             '项目的点击事件
             AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
             Return Item
@@ -602,7 +579,7 @@ EndHint:
                     '读取自定义文件
                     If Directory.Exists(Path & "PCL\Help\") Then
                         For Each File In EnumerateFiles(Path & "PCL\Help\")
-                            Select Case File.Extension.ToLower
+                            Select Case File.Extension.Lower
                                 Case ".helpignore"
                                     '加载忽略列表
                                     Log("[Help] 发现 .helpignore 文件:" & File.FullName)
@@ -621,7 +598,7 @@ EndHint:
                     '读取自带文件
                     For Each File In EnumerateFiles(PathTemp & "Help")
                         '跳过非 json 文件与以 . 开头的文件夹
-                        If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
+                        If File.Extension.Lower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
                         '检查忽略列表
                         Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
                         For Each Ignore In IgnoreList
@@ -637,7 +614,7 @@ NextFile:
                 Catch ex As Exception
                     Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
                 End Try
-                If Loader.IsAborted Then Return
+                If Loader.IsInterrupted Then Return
 
                 '将文件实例化
                 Dim Dict As New List(Of HelpEntry)
@@ -653,7 +630,7 @@ NextFile:
 
                 '回设
                 If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
-                If Loader.IsAborted Then Return
+                If Loader.IsInterrupted Then Return
                 Loader.Output = Dict
 
             Catch ex As Exception
@@ -666,34 +643,33 @@ NextFile:
     ''' 尝试解压内置帮助文件。
     ''' </summary>
     Public Sub HelpTryExtract()
-        If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
+        If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
             DeleteDirectory(PathTemp & "Help")
             Directory.CreateDirectory(PathTemp & "Help")
             WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
-            ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8)
-            Setup.Set("SystemHelpVersion", VersionCode)
+            ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
+            Settings.Set("SystemHelpVersion", VersionCode)
             Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
         End If
     End Sub
-    ''' <summary>
-    ''' 对帮助文件约定的替换标记进行处理,如果遇到需要转义的字符会进行转义。
-    ''' </summary>
-    Public Function HelpArgumentReplace(Xaml As String) As String
-        Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
-        Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
-        Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
-        Return Result
-    End Function
 
 #End Region
 
 #Region "愚人节"
 
-    Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1
+    Private _IsAprilEnabled As Boolean? = Nothing
+    Public ReadOnly Property IsAprilEnabled As Boolean
+        Get
+            If _IsAprilEnabled Is Nothing Then
+                _IsAprilEnabled =
+                    Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
+                    Settings.Get("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
+            End If
+            Return _IsAprilEnabled.Value
+        End Get
+    End Property
     Public IsAprilGiveup As Boolean = False
-    Private AprilSpeed As New Vector(0, 0)
-    Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
-    Private AprilDistance As Integer = 0
+    Private AprilDifficultiedDistance As Integer = 0
     Private Sub TimerFool()
         Try
             If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
@@ -701,11 +677,13 @@ NextFile:
 
             '计算是否空闲
             Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
-            If MousePos = AprilMousePosLast Then
-                AprilIdieCount += 1
+            Static IdieCount As Integer = 0
+            Static MousePosLast As New Point(0, 0)
+            If MousePos = MousePosLast Then
+                IdieCount += 1
             Else
-                AprilMousePosLast = MousePos
-                AprilIdieCount = 0
+                MousePosLast = MousePos
+                IdieCount = 0
             End If
             '计算躲避移动
             Dim Direction As Vector
@@ -717,9 +695,11 @@ NextFile:
             Direction = -Dir
             Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
             Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
-            Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度
-            '计算回归移动
-            If AprilIdieCount >= 64 * 5 Then
+            Dim Difficulty As Double = 1 / (1 + (AprilDifficultiedDistance / 6000) ^ 2) + 0.25 '难度,初始为 1.25x,6000 距离为 0.75x,12000 为 0.5x,24000 为 0.256x,最低 0.25x
+            Dim Acc = Math.Max(0, -0.65 - Math.Log((Distance / Difficulty + 0.4) / 200)) * Direction * Difficulty '加速度
+            'FrmMain.Title = CInt(AprilTotalDistance) & " - " & Difficulty
+            '5s 不动时回到起始点
+            If IdieCount >= 64 * 5 Then
                 Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
                 Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
                 If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
@@ -729,10 +709,11 @@ NextFile:
                 End If
             End If
             '回到边界
+            Static Speed As New Vector(0, 0)
             Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
             If Relative.X < -ButtonWidth * 2 Then
                 FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
-                AprilSpeed.X -= 80
+                Speed.X -= 80
                 If Relative.Y < 0 Then
                     FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
                 ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -740,7 +721,7 @@ NextFile:
                 End If
             ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
                 FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
-                AprilSpeed.X += 80
+                Speed.X += 80
                 If Relative.Y < 0 Then
                     FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
                 ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -748,7 +729,7 @@ NextFile:
                 End If
             ElseIf Relative.Y < -ButtonHeight * 2 Then
                 FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
-                AprilSpeed.Y -= 25
+                Speed.Y -= 25
                 If Relative.X < 0 Then
                     FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
                 ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -756,7 +737,7 @@ NextFile:
                 End If
             ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
                 FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
-                AprilSpeed.Y += 25
+                Speed.Y += 25
                 If Relative.X < 0 Then
                     FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
                 ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -764,29 +745,31 @@ NextFile:
                 End If
             End If
             '移动
-            AprilSpeed = AprilSpeed * 0.8 + Acc
-            Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
+            Speed = Speed * 0.8 + Acc
+            Dim SpeedValue = Math.Min(60, Speed.Length)
             If SpeedValue < 0.01 Then Return
-            AprilSpeed.Normalize()
-            AprilSpeed *= SpeedValue
-            AprilDistance += SpeedValue
-            FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X
-            FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y
+            Speed.Normalize()
+            Speed *= SpeedValue
+            AprilDifficultiedDistance += SpeedValue
+            FrmLaunchLeft.AprilPosTrans.X += Speed.X
+            FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
             '大小改变
             FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
             FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
             '放弃提示
-            If AprilDistance > 4000 Then
-                AprilDistance = -4000
+            Static GiveUpDistance As Double = -1500
+            GiveUpDistance += SpeedValue
+            If GiveUpDistance > 2500 Then
+                GiveUpDistance = 0
                 Select Case RandomInteger(0, 3)
                     Case 0
-                        Hint("放弃吧!只需要点一下右下角的小白旗……")
+                        Hint("放弃吧!只需要点一下右下角的小白旗……", HintType.Red)
                     Case 1
-                        Hint("看到右下角的那面小白旗了吗?")
+                        Hint("看到右下角的那面小白旗了吗?", HintType.Red)
                     Case 2
-                        Hint("这里建议点一下右下角的小白旗投降呢.jpg")
+                        Hint("这里建议点一下右下角的小白旗投降呢.jpg", HintType.Red)
                     Case 3
-                        Hint("右下角的小白旗永远等着你……")
+                        Hint("右下角的小白旗永远等着你……", HintType.Red)
                 End Select
             End If
 
@@ -824,8 +807,7 @@ NextFile:
         '查看现有设置
         Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
             If ReadOnlyKey IsNot Nothing Then
-                Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
-                If REG_VALUE = CurrentValue?.ToString() Then
+                If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
                     Log($"[System] 无需调整显卡设置:{Executeable}")
                     Return
                 End If
@@ -842,6 +824,79 @@ NextFile:
         End Using
     End Sub
 
+    ''' <summary>
+    ''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
+    ''' </summary>
+    Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
+        '预处理
+        If Text Is Nothing Then Return Nothing
+        Dim Replacer =
+        Function(s As String) As String
+            If s Is Nothing Then Return ""
+            If EscapeHandler Is Nothing Then Return s
+            If s.Contains(":\") Then s = ShortenPath(s)
+            Return EscapeHandler(s)
+        End Function
+        '基础
+        Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
+        Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
+        Text = Text.Replace("{pcl_version_branch}", Replacer(VersionBranchName))
+        Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
+        Text = Text.Replace("{identify}", Replacer(Identify))
+        Text = Text.Replace("{path}", Replacer(Path))
+        Text = Text.Replace("{path_with_name}", Replacer(PathWithName))
+        Text = Text.Replace("{path_temp}", Replacer(PathTemp))
+        '时间
+        If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
+            Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
+            Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
+        End If
+        'Minecraft
+        Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
+        Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
+        If McInstanceSelected?.IsLoaded Then
+            Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
+            Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
+            Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
+            If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.Lower) Then
+                Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
+            Else
+                Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
+            End If
+        Else
+            Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
+            Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
+            Text = Text.Replace("{name}", Replacer(Nothing))
+            Text = Text.Replace("{version}", Replacer(Nothing))
+        End If
+        '登录信息
+        If McLoginLoader.State = LoadState.Finished Then
+            Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
+            Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.Lower))
+            Select Case McLoginLoader.Input.Type
+                Case McLoginType.Legacy
+                    Text = Text.Replace("{login}", Replacer("离线"))
+                Case McLoginType.Ms
+                    Text = Text.Replace("{login}", Replacer("正版"))
+                Case McLoginType.Nide
+                    Text = Text.Replace("{login}", Replacer("统一通行证"))
+                Case McLoginType.Auth
+                    Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
+            End Select
+        Else
+            Text = Text.Replace("{user}", Replacer(Nothing))
+            Text = Text.Replace("{uuid}", Replacer(Nothing))
+            Text = Text.Replace("{login}", Replacer(Nothing))
+        End If
+        '高级
+        Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
+        Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
+        Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
+        Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
+        Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
+        Return Text
+    End Function
+
 #End Region
 
 #Region "任务缓存"
@@ -931,7 +986,7 @@ NextFile:
             Timer150Count = 0
             Try
 #Region "每 7.5s 执行一次的代码"
-                If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
+                If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDifficultiedDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
                 '以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
                 RunInUi(
                 Sub()

+ 28 - 24
Plain Craft Launcher 2/Modules/ModMusic.vb

@@ -24,13 +24,13 @@
                 Directory.CreateDirectory(Path & "PCL\Musics\")
                 For Each File In EnumerateFiles(Path & "PCL\Musics\")
                     '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
-                    Dim Ext As String = File.Extension.ToLower
+                    Dim Ext As String = File.Extension.Lower
                     If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
                     MusicAllList.Add(File.FullName)
                 Next
             End If
             '打乱顺序播放
-            MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
+            MusicWaitingList = If(Settings.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
             If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
                 '若需要避免成为第一项的为第一项,则将它放在最后
                 MusicWaitingList.RemoveAt(0)
@@ -79,7 +79,7 @@
                     If MusicState = MusicStates.Pause Then
                         FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
                         FrmMain.BtnExtraMusic.LogoScale = 0.8
-                        ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        ToolTipText = "已暂停:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
                         If MusicAllList.Count > 1 Then
                             ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
                         Else
@@ -88,7 +88,7 @@
                     Else
                         FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
                         FrmMain.BtnExtraMusic.LogoScale = 1
-                        ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                        ToolTipText = "正在播放:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
                         If MusicAllList.Count > 1 Then
                             ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
                         Else
@@ -111,7 +111,7 @@
     ''' </summary>
     Public Sub MusicControlPause()
         If MusicNAudio Is Nothing Then
-            Hint("音乐播放尚未开始!", HintType.Critical)
+            Hint("音乐播放尚未开始!", HintType.Red)
         Else
             Select Case MusicState
                 Case MusicStates.Pause
@@ -129,16 +129,16 @@
     ''' 播放下一曲,并显示提示文本。
     ''' </summary>
     Public Sub MusicControlNext()
-        If MusicAllList.Count = 1 Then
+        If MusicAllList.IsSingle Then
             MusicStartPlay(MusicCurrent)
-            Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
+            Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Green)
         Else
             Dim Address As String = DequeueNextMusicAddress()
             If Address Is Nothing Then
-                Hint("没有可以播放的音乐!", HintType.Critical)
+                Hint("没有可以播放的音乐!", HintType.Red)
             Else
                 MusicStartPlay(Address)
-                Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
+                Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Green)
             End If
         End If
         MusicRefreshUI()
@@ -182,19 +182,19 @@
             MusicListInit(True)
             If Not MusicAllList.Any() Then
                 If MusicNAudio Is Nothing Then
-                    If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
+                    If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Red)
                 Else
                     MusicNAudio = Nothing
-                    If ShowHint Then Hint("背景音乐已清除!", HintType.Finish)
+                    If ShowHint Then Hint("背景音乐已清除!", HintType.Green)
                 End If
             Else
                 Dim Address As String = DequeueNextMusicAddress()
                 If Address Is Nothing Then
-                    If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical)
+                    If ShowHint Then Hint("没有可以播放的音乐!", HintType.Red)
                 Else
                     Try
                         MusicStartPlay(Address, IsFirstLoad)
-                        If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
+                        If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
                     Catch
                     End Try
                 End If
@@ -247,7 +247,7 @@
                 Log("[Music] 已恢复播放")
                 Try
                     MusicNAudio?.Play()
-                Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223
+                Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
                     MusicNAudio?.Stop()
                     MusicNAudio?.Play()
                 End Try
@@ -261,6 +261,7 @@
 
     ''' <summary>
     ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
+    ''' 如果为它赋了类别,则会没有必要地加载 NAudio.dll。
     ''' </summary>
     Public MusicNAudio = Nothing
     ''' <summary>
@@ -279,18 +280,23 @@
             CurrentWave = New NAudio.Wave.WaveOutEvent()
             MusicNAudio = CurrentWave
             CurrentWave.DeviceNumber = -1
-            Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
+            Try
+                Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
+            Catch ex As Exception
+                Log(ex, "使用 AudioFileReader 加载音频文件失败,换用 MediaFoundationReader 重试", LogLevel.Developer)
+                Reader = New NAudio.Wave.MediaFoundationReader(MusicCurrent)
+            End Try
             CurrentWave.Init(Reader)
             CurrentWave.Play()
             '第一次打开的暂停
-            If IsFirstLoad AndAlso Not Setup.Get("UiMusicAuto") Then CurrentWave.Pause()
+            If IsFirstLoad AndAlso Not Settings.Get("UiMusicAuto") Then CurrentWave.Pause()
             MusicRefreshUI()
             '停止条件:播放完毕或变化
             Dim PreviousVolume = 0
             While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped
-                If Setup.Get("UiMusicVolume") <> PreviousVolume Then
+                If Settings.Get("UiMusicVolume") <> PreviousVolume Then
                     '更新音量
-                    PreviousVolume = Setup.Get("UiMusicVolume")
+                    PreviousVolume = Settings.Get("UiMusicVolume")
                     CurrentWave.Volume = PreviousVolume / 1000
                 End If
                 '更新进度条
@@ -303,18 +309,16 @@
         Catch ex As Exception
             Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
             If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
-                Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Critical)
+                Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Red)
                 Thread.Sleep(1000000000)
             End If
             If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
-                Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
+                Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Red)
                 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)) OrElse
+            If 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)
+                Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
             Else
                 Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
             End If

+ 38 - 30
Plain Craft Launcher 2/Modules/ModSecret.vb

@@ -1,18 +1,21 @@
 '由于包含加解密等安全信息,本文件中的部分代码已被删除
 
-Imports System.Net.Http
 Imports System.Security.Cryptography
 
 Friend Module ModSecret
 
 #Region "杂项"
 
+    '标注 PCL 的不同分支,仅用于替换标记
+    Public Const VersionBranchMain As String = "OpenSource"
     '在开源版的注册表与常规版的注册表隔离,以防数据冲突
     Public Const RegFolder As String = "PCLDebug"
     '用于微软登录的 ClientId
-    Public Const OAuthClientId As String = ""
+    Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")
     'CurseForge API Key
-    Public Const CurseForgeAPIKey As String = ""
+    Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")
+    '用于匿名数据收集的腾讯云日志服务上报 URL,形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id}
+    Public Const ClsBaseUrl As String = ""
 
     Friend Sub SecretOnApplicationStart()
         '提升 UI 线程优先级
@@ -55,43 +58,35 @@ Friend Module ModSecret
     ''' <summary>
     ''' 获取设备标识码。
     ''' </summary>
-    Friend Function SecretGetUniqueAddress() As String
+    Friend Function SecretGetIdentify() As String
         Return "0000-0000-0000-0000"
     End Function
 
-    Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
-        Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
-        DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
-        McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
-        DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
-        DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
-        If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
-    End Sub
-
 #End Region
 
 #Region "网络鉴权"
 
-    Friend Function SecretCdnSign(UrlWithMark As String)
+    Friend Function SecretCdnSign(UrlWithMark As String) As String
         If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
         Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
     End Function
     ''' <summary>
     ''' 设置 Headers 的 UA、Referer。
     ''' </summary>
-    Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional UseBrowserUserAgent As Boolean = False)
-        If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
-            Req.Headers.Add("User-Agent", "LogStatistic")  '#4951
-        ElseIf UseBrowserUserAgent Then
-            Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
-        Else
-            Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
+    Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
+        If Not Req.Headers.UserAgent.Any Then
+            If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
+                Req.Headers.Add("User-Agent", "LogStatistic")  '#4951
+            ElseIf SimulateBrowserHeaders Then
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
+            Else
+                Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode}")
+            End If
         End If
-        Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
+        If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
         If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
     End Sub
 
-
 #End Region
 
 #Region "字符串加解密"
@@ -213,13 +208,19 @@ Friend Module ModSecret
             If Not FrmMain.IsLoaded Then Return
             '顶部条背景
             Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
-            Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)})
-            Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)})
-            Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)})
-            Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)})
+            If TypeOf ColorHueTopbarDelta Is Integer Then
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
+            Else
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
+                Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
+            End If
             FrmMain.PanTitle.Background = Brush
+            FrmMain.PanTitle.Background.Freeze()
             '主页面背景
-            If Setup.Get("UiBackgroundColorful") Then
+            If Settings.Get("UiBackgroundColorful") Then
                 Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
                 Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
                 Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
@@ -271,9 +272,16 @@ Friend Module ModSecret
 
 #End Region
 
-#Region "联网通知"
+#Region "联网配置"
+
+    ''' <summary>
+    ''' 联网获取的配置信息。
+    ''' 若获取失败或仍在获取中,可能为 Nothing。
+    ''' </summary>
+    Public ServerConfig As JObject
 
-    Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
+    Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
+        {.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
 
 #End Region
 

+ 0 - 59
Plain Craft Launcher 2/Modules/Reference/CookieWebClient.vb

@@ -1,59 +0,0 @@
-Imports System.Net
-
-Public Class CookieWebClient
-    Inherits WebClient
-
-    Public Sub New(container As CookieContainer, Headers As Dictionary(Of String, String))
-        Me.New(container)
-        For Each keyVal In Headers
-            Me.Headers(keyVal.Key) = keyVal.Value
-        Next
-    End Sub
-
-    Public Sub New()
-        Me.New(New CookieContainer())
-    End Sub
-
-    Public Sub New(container As CookieContainer)
-        Me.container = container
-    End Sub
-
-    Private Shadows ReadOnly container As New CookieContainer()
-
-    ''' <summary>
-    ''' 以毫秒为单位的超时。
-    ''' </summary>
-    Public Timeout As Integer = 600000
-
-    Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
-        Dim r As WebRequest = MyBase.GetWebRequest(address)
-        Dim request = TryCast(r, HttpWebRequest)
-
-        If request IsNot Nothing Then
-            request.CookieContainer = container
-            request.Timeout = Timeout
-        End If
-
-        Return r
-    End Function
-
-    Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
-        Dim response As WebResponse = MyBase.GetWebResponse(request, result)
-        ReadCookies(response)
-        Return response
-    End Function
-
-    Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
-        Dim response As WebResponse = MyBase.GetWebResponse(request)
-        ReadCookies(response)
-        Return response
-    End Function
-
-    Private Sub ReadCookies(r As WebResponse)
-        Dim response = TryCast(r, HttpWebResponse)
-        If response IsNot Nothing Then
-            Dim cookies As CookieCollection = response.Cookies
-            container.Add(cookies)
-        End If
-    End Sub
-End Class

+ 151 - 0
Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb

@@ -0,0 +1,151 @@
+'来源:https://blog.csdn.net/simpleman2000/article/details/140952294
+
+Imports System.ComponentModel
+Imports System.Runtime.InteropServices
+Imports System.Windows.Interop
+
+Public Class DragHelper
+
+    Public Event DragDrop As EventHandler
+
+    Public Property DropFilePaths As String()
+        Get
+            Return _DropFilePathsBackingField
+        End Get
+        Private Set(value As String())
+            _DropFilePathsBackingField = value
+        End Set
+    End Property
+    Private _DropFilePathsBackingField As String()
+
+    Public Property DropPoint As POINT
+        Get
+            Return _DropPointBackingField
+        End Get
+        Private Set(value As POINT)
+            _DropPointBackingField = value
+        End Set
+    End Property
+    Private _DropPointBackingField As POINT
+
+    Public Property HwndIntPtrSource As HwndSource
+
+    Public Sub AddHook()
+        RemoveDragHook()
+        HwndIntPtrSource.AddHook(AddressOf WndProc)
+        Dim handle As IntPtr = HwndIntPtrSource.Handle
+        If IsUserAnAdmin() Then RevokeDragDrop(handle)
+        DragAcceptFiles(handle, True)
+        ChangeMessageFilter(handle)
+    End Sub
+
+    Public Sub RemoveDragHook()
+        HwndIntPtrSource.RemoveHook(AddressOf WndProc)
+        DragAcceptFiles(HwndIntPtrSource.Handle, False)
+    End Sub
+
+    Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
+        Dim filePaths As String() = Nothing
+        Dim point As New POINT()
+
+        If TryGetDropInfo(msg, wParam, filePaths, point) Then
+            DropPoint = point
+            DropFilePaths = filePaths
+            RaiseEvent DragDrop(Me, EventArgs.Empty)
+            handled = True
+        End If
+        Return IntPtr.Zero
+    End Function
+
+    <DllImport("user32.dll", SetLastError:=True)>
+    Private Shared Function ChangeWindowMessageFilterEx(hWnd As IntPtr, msg As UInteger, action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
+    End Function
+
+    <DllImport("user32.dll", SetLastError:=True)>
+    Private Shared Function ChangeWindowMessageFilter(msg As UInteger, flags As UInteger) As Boolean
+    End Function
+
+    <DllImport("shell32.dll")>
+    Private Shared Sub DragAcceptFiles(hWnd As IntPtr, fAccept As Boolean)
+    End Sub
+
+    <DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
+    Private Shared Function DragQueryFile(hWnd As IntPtr, iFile As UInteger, lpszFile As StringBuilder, cch As Integer) As UInteger
+    End Function
+
+    <DllImport("shell32.dll")>
+    Private Shared Function DragQueryPoint(hDrop As IntPtr, ByRef lppt As POINT) As Boolean
+    End Function
+
+    <DllImport("shell32.dll")>
+    Private Shared Sub DragFinish(hDrop As IntPtr)
+    End Sub
+
+    <DllImport("ole32.dll")>
+    Private Shared Function RevokeDragDrop(hWnd As IntPtr) As Integer
+    End Function
+
+    <DllImport("shell32.dll")>
+    Private Shared Function IsUserAnAdmin() As Boolean
+    End Function
+
+    <StructLayout(LayoutKind.Sequential)>
+    Public Structure POINT
+        Public X As Integer
+        Public Y As Integer
+    End Structure
+
+    <StructLayout(LayoutKind.Sequential)>
+    Private Structure CHANGEFILTERSTRUCT
+        Public cbSize As UInteger
+        Public ExtStatus As UInteger
+    End Structure
+
+    Private Const WM_COPYGLOBALDATA As UInteger = &H49
+    Private Const WM_COPYDATA As UInteger = &H4A
+    Private Const WM_DROPFILES As UInteger = &H233
+    Private Const MSGFLT_ALLOW As UInteger = 1
+    Private Const MSGFLT_ADD As UInteger = 1
+    Private Const MAX_PATH As Integer = 260
+
+    Private Shared Sub ChangeMessageFilter(handle As IntPtr)
+        Dim ver As Version = Environment.OSVersion.Version
+        Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
+        Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
+
+        If isVistaOrHigher Then
+            Dim status As New CHANGEFILTERSTRUCT With {.cbSize = 8}
+            For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
+                Dim [error] As Boolean = False
+                If isNt61OrHiger Then
+                    [error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
+                Else
+                    [error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
+                End If
+
+                If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
+            Next
+        End If
+    End Sub
+
+    Private Shared Function TryGetDropInfo(msg As Integer, wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
+        dropFilePaths = Nothing
+        dropPoint = New POINT()
+
+        If msg <> WM_DROPFILES Then Return False
+
+        Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
+        ReDim dropFilePaths(CInt(fileCount) - 1)
+
+        For i As UInteger = 0 To CInt(fileCount) - 1
+            Dim sb As New StringBuilder(MAX_PATH)
+            Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
+            If result > 0 Then dropFilePaths(i) = sb.ToString()
+        Next
+
+        DragQueryPoint(wParam, dropPoint)
+        DragFinish(wParam)
+        Return True
+    End Function
+
+End Class

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

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

+ 69 - 9
Plain Craft Launcher 2/My Project/Resources.Designer.vb

@@ -63,9 +63,29 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property Custom() As Byte()
+        Friend ReadOnly Property CacheCow_Client() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("CacheCow.Client", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property CacheCow_Client_FileStore() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("CacheCow.Client.FileStore", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property CacheCow_Common() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("CacheCow.Common", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -73,9 +93,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property Dialogs() As Byte()
+        Friend ReadOnly Property Custom() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("Dialogs", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -105,7 +125,7 @@ Namespace My.Resources
         '''</summary>
         Friend ReadOnly Property Imazen_WebP() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("Imazen.WebP", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -123,9 +143,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property Json() As Byte()
+        Friend ReadOnly Property libwebp64() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -133,9 +153,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property libwebp64() As Byte()
+        Friend ReadOnly Property LUA() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("LUA", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -160,6 +180,46 @@ Namespace My.Resources
             End Get
         End Property
         
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property Newtonsoft_Json() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("Newtonsoft.Json", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property Ookii_Dialogs_Wpf() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("Ookii.Dialogs.Wpf", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property System_Net_Http_Formatting() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("System.Net.Http.Formatting", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
+        '''<summary>
+        '''  查找 System.Byte[] 类型的本地化资源。
+        '''</summary>
+        Friend ReadOnly Property System_ValueTuple() As Byte()
+            Get
+                Dim obj As Object = ResourceManager.GetObject("System.ValueTuple", resourceCulture)
+                Return CType(obj,Byte())
+            End Get
+        End Property
+        
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>

+ 26 - 8
Plain Craft Launcher 2/My Project/Resources.resx

@@ -118,36 +118,54 @@
     <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </resheader>
   <assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
+  <data name="CacheCow.Client" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\CacheCow.Client.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
+  <data name="CacheCow.Client.FileStore" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\CacheCow.Client.FileStore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
+  <data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
   <data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
-  <data name="Dialogs" type="System.Resources.ResXFileRef, System.Windows.Forms">
-    <value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
-  </data>
   <data name="ForgeInstaller" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
   <data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
-  <data name="Imazen_WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
+  <data name="Imazen.WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
   <data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
-  <data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
-    <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
-  </data>
   <data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
+  <data name="LUA" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\lwjgl-unsafe-agent.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
   <data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
-    <value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+    <value>..\Resources\moddata.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
   <data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
+  <data name="Newtonsoft.Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
+  <data name="Ookii.Dialogs.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
+  <data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
+  <data name="System.ValueTuple" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\System.ValueTuple.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
   <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>

+ 27 - 37
Plain Craft Launcher 2/Pages/PageDownload/Comp/MyCompItem.xaml.vb

@@ -3,16 +3,6 @@
 #Region "基础属性"
     Public Uuid As Integer = GetUuid()
 
-    'Logo
-    Public Property Logo As String
-        Get
-            Return PathLogo.Source
-        End Get
-        Set(value As String)
-            PathLogo.Source = value
-        End Set
-    End Property
-
     '标题
     Public Property Title As String
         Get
@@ -64,17 +54,17 @@
 
     'Tag
     Public WriteOnly Property Tags As List(Of String)
-        Set(value As List(Of String))
+        Set(Tags As List(Of String))
             PanTags.Children.Clear()
-            PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
-            For Each TagText In value
-                Dim NewTag = GetObjectFromXML(
-                "<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
-                         Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" 
-                         SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
-                   <TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
-                </Border>")
-                PanTags.Children.Add(NewTag)
+            PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
+            For Each TagText In Tags
+                Dim BorderTag As New Border With {
+                    .Background = New MyColor("#11000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
+                    .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
+                Dim LabTag As New TextBlock With {
+                    .Text = TagText, .Foreground = New MyColor("#868686"), .FontSize = 11}
+                BorderTag.Child = LabTag
+                PanTags.Children.Add(BorderTag)
             Next
         End Set
     End Property
@@ -97,43 +87,43 @@
         Dim Titles As New List(Of String)
         If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
             For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
-                If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
+                If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
             Next
             Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
             FrmMain.PageCurrent.Additional(1) = Titles
         End If
         '打开详情页
         Dim TargetType As CompType
-        Dim TargetVersion As String = Nothing
+        Dim TargetInstance As String = Nothing
         Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any
         If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
             '从下载页进入
             Select Case FrmMain.PageCurrentSub
                 Case FormMain.PageSubType.DownloadMod
                     TargetType = CompType.Mod
-                    TargetVersion = FrmDownloadMod.Content.Loader.Input.GameVersion
+                    TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
                     TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
                 Case FormMain.PageSubType.DownloadPack
                     TargetType = CompType.ModPack
-                    TargetVersion = FrmDownloadPack.Content.Loader.Input.GameVersion
+                    TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
                 Case FormMain.PageSubType.DownloadDataPack
                     TargetType = CompType.DataPack
-                    TargetVersion = FrmDownloadDataPack.Content.Loader.Input.GameVersion
+                    TargetInstance = FrmDownloadDataPack.Content.Loader.Input.GameVersion
                 Case FormMain.PageSubType.DownloadResourcePack
                     TargetType = CompType.ResourcePack
-                    TargetVersion = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
+                    TargetInstance = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
                 Case FormMain.PageSubType.DownloadShader
                     TargetType = CompType.Shader
-                    TargetVersion = FrmDownloadShader.Content.Loader.Input.GameVersion
+                    TargetInstance = FrmDownloadShader.Content.Loader.Input.GameVersion
             End Select
         Else
             '从详情页进入(查看前置)
             TargetType = CompType.Any '允许任意类别
-            TargetVersion = FrmMain.PageCurrent.Additional(2)
+            TargetInstance = FrmMain.PageCurrent.Additional(2)
             TargetLoader = FrmMain.PageCurrent.Additional(3)
         End If
         FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
-                           .Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader, TargetType}})
+                           .Additional = {sender.Tag, New List(Of String), TargetInstance, TargetLoader, TargetType}})
     End Sub
 
     '鼠标点击判定
@@ -208,9 +198,9 @@
             Dim Ani As New List(Of AniData)
             If IsMouseOver Then
                 Ani.AddRange({
-                             AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
-                             AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
-                         })
+                    AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
+                    AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
+                })
                 If IsMouseDown Then
                     Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
                 Else
@@ -218,11 +208,11 @@
                 End If
             Else
                 Ani.AddRange({
-                             AaOpacity(RectBack, -RectBack.Opacity, Time),
-                             AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
-                             AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
-                             AaScaleTransform(RectBack, -0.196, 1,,, True)
-                         })
+                    AaOpacity(RectBack, -RectBack.Opacity, Time),
+                    AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
+                    AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
+                    AaScaleTransform(RectBack, -0.196, 1,,, True)
+                })
             End If
             AniStart(Ani, "CompItem Color " & Uuid)
         Else

+ 9 - 10
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml

@@ -32,22 +32,21 @@
                         <local:MyComboBoxItem Content="Modrinth" Tag="2" />
                     </local:MyComboBox>
                     <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
-                    <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
+                    <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True">
                         <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
-                        <local:MyComboBoxItem Content="1.21.5" />
+                        <local:MyComboBoxItem Content="26.1" />
+                        <local:MyComboBoxItem Content="1.21.11" />
+                        <local:MyComboBoxItem Content="1.21.8" />
+                        <local:MyComboBoxItem Content="1.21.4" />
                         <local:MyComboBoxItem Content="1.21.1" />
-                        <local:MyComboBoxItem Content="1.20.6" />
                         <local:MyComboBoxItem Content="1.20.1" />
-                        <local:MyComboBoxItem Content="1.19.4" />
                         <local:MyComboBoxItem Content="1.19.2" />
                         <local:MyComboBoxItem Content="1.18.2" />
                         <local:MyComboBoxItem Content="1.16.5" />
                         <local:MyComboBoxItem Content="1.12.2" />
-                        <local:MyComboBoxItem Content="1.10.2" />
-                        <local:MyComboBoxItem Content="1.8.9" />
                         <local:MyComboBoxItem Content="1.7.10" />
                     </local:MyComboBox>
-                    <local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0">
+                    <local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
                         <local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
                         <local:MyComboBoxItem Content="Forge" Tag="1" />
                         <local:MyComboBoxItem Content="NeoForge" Tag="6" />
@@ -55,7 +54,7 @@
                         <local:MyComboBoxItem Content="Quilt" Tag="5" />
                     </local:MyComboBox>
                     <TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
-                    <local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320" />
+                    <local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
                 </Grid>
                 <Grid Margin="0,4,0,6" Height="35">
                     <Grid.ColumnDefinitions>
@@ -71,7 +70,7 @@
             </StackPanel>
         </local:MyCard>
         <StackPanel x:Name="PanContent">
-            <local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后重试,或使用 VPN 以改善网络环境。" Theme="Yellow" Margin="0,0,0,15" />
+            <local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后再试,或使用 VPN 改善网络环境。" Theme="Yellow" Margin="0,0,0,15" />
             <local:MyCard x:Name="CardProjects" UseAnimation="False">
                 <StackPanel x:Name="PanProjects" Margin="12" />
             </local:MyCard>
@@ -89,7 +88,7 @@
             </local:MyCard>
         </StackPanel>
         <local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
-            <local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
+            <local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" ShowProgress="True" />
         </local:MyCard>
     </StackPanel>
 </local:MyScrollViewer>

+ 26 - 20
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb

@@ -67,7 +67,7 @@ Public Class PageComp
     ''' <summary>
     ''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。
     ''' </summary>
-    Public Shared TargetVersion As McVersion = Nothing
+    Public Shared TargetInstance As McInstance = Nothing
     ''' <summary>
     ''' 在切换到该页面时自动设置的搜索框内的内容。
     ''' </summary>
@@ -76,13 +76,13 @@ Public Class PageComp
     '在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
     Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
 
-    Private IsLoaderInited As Boolean = False
     Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
+        Static IsFirstLoaded As Boolean = False
         '不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
-        If TargetVersion IsNot Nothing Then
+        If TargetInstance IsNot Nothing Then
             '设置目标
             ResetFilter() '重置筛选器
-            TextSearchVersion.Text = TargetVersion.Version.McName
+            TextSearchVersion.Text = TargetInstance.Version.VanillaName
             Dim GetTargetItemByName =
             Function(Name As String) As MyComboBoxItem
                 For Each Item As MyComboBoxItem In ComboSearchLoader.Items
@@ -90,39 +90,44 @@ Public Class PageComp
                 Next
                 Return ComboSearchLoader.Items(0)
             End Function
-            If TargetVersion.Version.HasForge Then
+            If TargetInstance.Version.HasForge Then
                 ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
-            ElseIf TargetVersion.Version.HasFabric Then
+            ElseIf TargetInstance.Version.HasFabric Then
                 ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
-            ElseIf TargetVersion.Version.HasNeoForge Then
+            ElseIf TargetInstance.Version.HasNeoForge Then
                 ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
             End If
-            TargetVersion = Nothing
+            TargetInstance = Nothing
             If TargetName IsNot Nothing Then
-                '设置搜索框内容
                 TextSearchName.Text = TargetName
                 TargetName = Nothing
             End If
             '如果已经完成请求,则重新开始
-            If IsLoaderInited Then StartNewSearch()
+            If IsFirstLoaded Then StartNewSearch()
             ScrollToHome()
         End If
         '加载器初始化
-        If IsLoaderInited Then Return
-        IsLoaderInited = True
+        If IsFirstLoaded Then Return
+        IsFirstLoaded = True
         CType(Parent, MyPageRight).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)))
+        '将最高 Drop 加入筛选
+        If AllDrops IsNot Nothing AndAlso AllDrops.First > 250 Then
+            Dim HighestVersion As String = McVersion.DropToVersion(AllDrops.First)
+            If CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString <> HighestVersion Then '0 是全部
+                TextSearchVersion.Items.Insert(1, New MyComboBoxItem With {.Content = HighestVersion})
+            End If
+        End If
     End Sub
     Private Function LoaderInput() As CompProjectRequest
-        Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PageSize)
+        Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PAGE_SIZE)
         Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
-                If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
+            If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
         With Request
             .SearchText = TextSearchName.Text
             .GameVersion = GameVersion
             .Tag = ComboSearchTag.SelectedItem.Tag
             .ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any)
-            .Source = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
+            .Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
         End With
         Return Request
     End Function
@@ -133,7 +138,7 @@ Public Class PageComp
     ''' <summary>
     ''' 每页展示的结果数量。
     ''' </summary>
-    Public Const PageSize = 40
+    Public Const PAGE_SIZE = 40
     Public Page As Integer = 0
 
     '结果 UI 化
@@ -142,8 +147,9 @@ Public Class PageComp
             Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
             '列表项
             PanProjects.Children.Clear()
-            For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
-                PanProjects.Children.Add(Storage.Results(i).ToCompItem(
+            Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
+            For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
+                PanProjects.Children.Add(Result.ToCompItem(
                     ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
                     ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
             Next
@@ -157,7 +163,7 @@ Public Class PageComp
             BtnPageLeft.IsEnabled = Page > 0
             BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
             Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
-                Storage.Results.Count > PageSize * (Page + 1) OrElse
+                Storage.Results.Count > PAGE_SIZE * (Page + 1) OrElse
                 Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
             BtnPageRight.IsEnabled = IsRightEnabled
             BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)

+ 2 - 1
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadCompDetail"
-    PanScroll="{Binding ElementName=PanBack}">
+    PanScroll="PanBack">
     <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
         <Grid Margin="25,25,25,10">
             <Grid.RowDefinitions>
@@ -20,6 +20,7 @@
                 </StackPanel>
             </local:MyCard>
             <StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True">
+                <local:MyHint x:Name="HintAlternative" Theme="Blue" Margin="0,0,0,15" />
                 <local:MyCard Margin="0,0,0,15" x:Name="CardFilter">
                     <StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" />
                 </local:MyCard>

+ 159 - 98
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb

@@ -8,7 +8,7 @@
         Sub(Task)
             LoadTargetFromAdditional()
             Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
-            If Task.IsAborted Then Return
+            If Task.IsInterrupted Then Return
             Task.Output = Result
         End Sub)
 
@@ -19,16 +19,17 @@
     End Sub
     Public Sub LoadTargetFromAdditional() Handles Me.Loaded
         Project = FrmMain.PageCurrent.Additional(0)
-        TargetVersion = FrmMain.PageCurrent.Additional(2)
+        TargetInstance = FrmMain.PageCurrent.Additional(2)
         TargetLoader = FrmMain.PageCurrent.Additional(3)
-        PageType = FrmMain.PageCurrent.Additional(4)
+        TargetType = FrmMain.PageCurrent.Additional(4)
     End Sub
     Private Project As CompProject
-    Private TargetVersion As String, TargetLoader As CompModLoaderType
+    Private TargetInstance As String, TargetLoader As CompModLoaderType
     ''' <summary>
-    ''' 当前页面应展示的内容类别。可能为 Any。
+    ''' 当前页面应展示的内容类别。
+    ''' 若当前页面是在查看前置时进入,则也可能为 Any。
     ''' </summary>
-    Private PageType As CompType
+    Private TargetType As CompType
     '自动重试
     Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
         Select Case CompFileLoader.State
@@ -52,16 +53,16 @@
             If x = Topmost Then Return -1
             If y = Topmost Then Return 1
             '特殊版本
-            Dim IsXSpecial As Boolean = x.EndsWithF("版本")
-            Dim IsYSpecial As Boolean = y.EndsWithF("版本")
+            Dim IsXSpecial As Boolean = Not x.Contains(".")
+            Dim IsYSpecial As Boolean = Not y.Contains(".")
             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(" ") & " ", ""))
+            Dim VersionCodeSort = -CompareVersion(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
             If VersionCodeSort <> 0 Then Return VersionCodeSort
             '比较全部
-            Return -VersionSortInteger(x, y)
+            Return -CompareVersion(x, y)
         End Function
         Public Sub New(Optional Topmost As String = "")
             Me.Topmost = If(Topmost, "")
@@ -69,49 +70,59 @@
     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 GroupedDrop As Boolean '是否按 Drop 筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
+    Private GroupedOld As Boolean '是否折叠远古版本为一个选项
     '筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
     Private Function GetResults() As List(Of CompFile)
         Dim Results As List(Of CompFile) = CompFileLoader.Output
-        If PageType = CompType.Any Then
-            Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
-        ElseIf PageType = CompType.Shader OrElse PageType = CompType.ResourcePack Then
-            Results = Results.ToList
-        Else
-            Results = Results.Where(Function(r) r.Type = PageType).ToList
-        End If
+        Select Case TargetType
+            Case CompType.Any
+                Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
+            Case CompType.Shader, CompType.ResourcePack
+                '不筛选光影和资源包,否则原版光影会因为是资源包格式而被过滤(#6473)
+            Case Else
+                Results = Results.Where(Function(r) r.Type = TargetType).ToList
+        End Select
         Return Results
     End Function
     Private Sub Load_OnFinish()
         Dim Results = GetResults()
 
         '初始化筛选器
-        Dim VersionFilters As List(Of String)
-
-        '按小版本号筛选?
-        IsMajorVersionFilter = False
-        VersionFilters = Results.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 = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
+        Dim Filters As List(Of String) = Nothing
+        Dim UpdateFilters =
+        Sub()
+            Filters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld)).
                 Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
-        End If
+        End Sub
+
+        '确定分组方式
+        GroupedDrop = False : GroupedOld = False
+        UpdateFilters()
+        If Filters.Count < 9 Then GoTo GroupDone
+        GroupedDrop = True : GroupedOld = False
+        UpdateFilters()
+        If Filters.Count < 9 Then GoTo GroupDone
+        GroupedDrop = False : GroupedOld = True
+        UpdateFilters()
+        If Filters.Count < 9 Then GoTo GroupDone
+        GroupedDrop = True : GroupedOld = True
+        UpdateFilters()
+GroupDone:
 
         'UI 化筛选器
         PanFilter.Children.Clear()
-        If VersionFilters.Count < 2 Then
+        If Filters.Count < 2 Then
             CardFilter.Visibility = Visibility.Collapsed
             VersionFilter = Nothing
         Else
             CardFilter.Visibility = Visibility.Visible
-            VersionFilters.Insert(0, "全部")
+            Filters.Insert(0, "全部")
             '转化为按钮
-            For Each Version As String In VersionFilters
+            For Each Version As String In Filters
                 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)
+                NewButton.LabText.Margin = New Thickness(-2, 0, 10, 0)
                 AddHandler NewButton.Check,
                 Sub(sender As MyRadioButton, raiseByMouse As Boolean)
                     VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
@@ -121,10 +132,10 @@
             Next
             '自动选择
             Dim ToCheck As MyRadioButton = Nothing
-            If TargetVersion <> "" Then
-                Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
+            If TargetInstance <> "" Then
+                Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
                 If TargetFile IsNot Nothing Then
-                    Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
+                    Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
                     For Each Button As MyRadioButton In PanFilter.Children
                         If Button.Text <> TargetGroup Then Continue For
                         ToCheck = Button
@@ -142,26 +153,26 @@
     Private Sub UpdateFilterResult()
         Dim Results = GetResults()
 
-        Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
-            $"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
+        Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> CompModLoaderType.Any,
+            $"{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
         '归类到卡片下
         Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
-        Dict.Add("其他版本", New List(Of CompFile))
+        Dict.Add("其他", New List(Of CompFile))
         Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
         For Each Version As CompFile In Results
             For Each GameVersion In Version.GameVersions
                 '检查是否符合版本筛选器
                 If VersionFilter IsNot Nothing AndAlso
-                    GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
+                    GetGroupedVersionName(GameVersion, GroupedDrop, GroupedOld) <> VersionFilter Then Continue For
                 '决定添加到哪个卡片
                 Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
                 '遍历加入的加载器列表
                 Dim Loaders As New List(Of String)
                 If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
                     Version.Type = CompType.Mod AndAlso '是 Mod
-                    VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
+                    McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
                     For Each Loader In Version.ModLoaders
-                        If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
+                        If Loader = CompModLoaderType.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
                         If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
                     Next
                 End If
@@ -175,14 +186,14 @@
             Next
         Next
         '添加筛选的版本的卡片
-        If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then
+        If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
             Dict.Add(TargetCardName, New List(Of CompFile))
             For Each Version As CompFile In Results
-                If Version.GameVersions.Contains(TargetVersion) AndAlso
+                If Version.GameVersions.Contains(TargetInstance) 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
+                        Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
                     If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
                 End If
             Next
@@ -192,8 +203,9 @@
             PanResults.Children.Clear()
             For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
                 If Not Pair.Value.Any() Then Continue For
+                If Pair.Key = TargetCardName.Replace("(所选版本)", "") Then Continue For
                 '增加卡片
-                Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
+                Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
                 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
@@ -202,32 +214,43 @@
                 If Pair.Key = TargetCardName OrElse
                    (FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
                    CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
-                    MyCard.StackInstall(NewStack, If(PageType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
+                    MyCard.StackInstall(NewStack, If(TargetType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
                 Else
-                    NewCard.IsSwaped = True
+                    NewCard.IsSwapped = True
                 End If
                 '增加提示
-                If Pair.Key = "其他版本" Then
+                If Pair.Key = "其他" Then
                     NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
                 End If
             Next
             '如果只有一张卡片,展开第一张卡片
             If PanResults.Children.Count = 1 Then
-                CType(PanResults.Children(0), MyCard).IsSwaped = False
+                CType(PanResults.Children(0), MyCard).IsSwapped = False
+            End If
+            '替代提示
+            If Project.Types = CompType.ModOrDataPack AndAlso (TargetType = CompType.Mod OrElse TargetType = CompType.DataPack) Then
+                HintAlternative.Visibility = Visibility.Visible
+                HintAlternative.Text = If(TargetType = CompType.Mod,
+                    "以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
+            Else
+                HintAlternative.Visibility = Visibility.Collapsed
             End If
         Catch ex As Exception
             Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
         End Try
     End Sub
-    Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
+    Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
+        Dim Drop = McVersion.VersionToDrop(Name)
         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 "远古版本"
+            Return "其他"
+        ElseIf Name.Contains("w") OrElse Drop = 209 Then
+            Return "快照版"
+        ElseIf Not McVersion.IsFormatFit(Name) OrElse (FoldOld AndAlso Drop < 120) Then
+            Return "远古版"
+        ElseIf GroupedByDrop Then
+            Return McVersion.DropToVersion(Drop)
         Else
-            Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
+            Return Name
         End If
     End Function
 
@@ -249,7 +272,7 @@
 
         '放置当前工程
         If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
-        CompItem = Project.ToCompItem(True, True)
+        CompItem = Project.ToCompItem(True, True).Init()
         CompItem.CanInteraction = False
         CompItem.Margin = New Thickness(-7, -7, 0, 8)
         PanIntro.Children.Insert(0, CompItem)
@@ -271,33 +294,33 @@
 
             '获取版本名
             Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
-            Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
+            Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
             If Validate.Validate(PackName) <> "" Then PackName = ""
-            Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
-            If String.IsNullOrEmpty(VersionName) Then Return
+            Dim InstanceName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
+            If String.IsNullOrEmpty(InstanceName) Then Return
 
             '构造步骤加载器
             Dim Loaders As New List(Of LoaderBase)
-            Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
-            Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
+            Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
+            Dim LogoFileAddress As String = CompItem.PathLogo.ActualSource
             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() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
+            Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
 
             '启动
             Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
             Sub(MyLoader)
                 Select Case MyLoader.State
                     Case LoadState.Failed
-                        Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
-                    Case LoadState.Aborted
-                        Hint(MyLoader.Name & "已取消!", HintType.Info)
+                        Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
+                    Case LoadState.Interrupted
+                        Hint(MyLoader.Name & "已取消!", HintType.Blue)
                     Case LoadState.Loading
                         Return '不重新加载版本列表
                 End Select
                 McInstallFailedClearFolder(MyLoader)
             End Sub}
-            Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
+            Loader.Start(McFolderSelected & "versions\" & InstanceName & "\")
             LoaderTaskbarAdd(Loader)
             FrmMain.BtnExtraDownload.ShowRefresh()
             FrmMain.BtnExtraDownload.Ribble()
@@ -307,7 +330,7 @@
         End Try
     End Sub
     '资源下载;整合包另存为
-    Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
+    Public Shared CachedFolder As New Dictionary(Of CompType, String) '仅在本次缓存的下载文件夹
     Public Sub Save_Click(sender As Object, e As EventArgs)
         Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
         RunInNewThread(
@@ -325,13 +348,13 @@
                 Dim DefaultFolder As String = Nothing
                 If File.Type <> CompType.ModPack Then
                     Dim SubFolder As String = Nothing
-                    Select Case Project.Type
+                    Select Case File.Type
                         Case CompType.Mod : SubFolder = "mods\"
                         Case CompType.ResourcePack : SubFolder = "resourcepacks\"
                         Case CompType.Shader : SubFolder = "shaderpacks\"
                         Case CompType.DataPack : SubFolder = "" '导航到版本根目录
                     End Select
-                    Dim IsVersionSuitable As Func(Of McVersion, Boolean) = Nothing
+                    Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
                     '获取资源所需的加载器
                     Dim AllowedLoaders As New List(Of CompModLoaderType)
                     If File.ModLoaders.Any Then
@@ -341,51 +364,81 @@
                     End If
                     Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
                     '判断某个版本是否符合资源要求
-                    IsVersionSuitable =
-                    Function(Version)
-                        If Not Version.IsLoaded Then Version.Load()
+                    IsInstanceSuitable =
+                    Function(Instance As McInstance)
+                        If Not Instance.IsLoaded Then Instance.Load()
                         '只对 Mod 和数据包进行版本检测
-                        If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then
-                            If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
-                               Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
+                        If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
+                            If Not File.GameVersions.Any( '判断是否有任何一个版本匹配
+                            Function(FileVersion)
+                                Dim FileIsSnapshot As Boolean = FileVersion.Contains("预览版") OrElse Not FileVersion.Contains(".")
+                                Dim InstanceIsSnapshot As Boolean = Instance.Version.VanillaName.Contains("snapshot") OrElse Not Instance.Version.VanillaName.Contains(".")
+                                If FileIsSnapshot <> InstanceIsSnapshot Then
+                                    '只有一种是预览版
+                                    Return False
+                                ElseIf Not FileIsSnapshot AndAlso Not InstanceIsSnapshot Then
+                                    '都不是预览版
+                                    Return FileVersion = Instance.Version.VanillaName
+                                Else
+                                    '都是预览版
+                                    Dim FileIsNewFormat As Boolean = FileVersion.Contains(".") AndAlso Val(FileVersion.BeforeFirst(".")) > 1
+                                    Dim InstanceIsNewFormat As Boolean = Instance.Version.Drop > 250
+                                    If FileIsNewFormat <> InstanceIsNewFormat Then
+                                        '只有一种是新格式快照
+                                        Return False
+                                    ElseIf FileIsNewFormat AndAlso InstanceIsNewFormat Then
+                                        '都是新格式快照
+                                        Return FileVersion.BeforeFirst(" ") = Instance.Version.VanillaName.BeforeFirst("-")
+                                    Else
+                                        '都是旧格式快照
+                                        If FileVersion.Contains("w") AndAlso Instance.Version.VanillaName.Contains("w") Then
+                                            '都是 w 快照
+                                            Return FileVersion = Instance.Version.VanillaName
+                                        Else
+                                            '不全是 w 快照
+                                            Return True '只能假定相同,无法判断
+                                        End If
+                                    End If
+                                End If
+                            End Function) Then Return False
                         End If
                         '加载器
                         If Not AllowedLoaders.Any() Then Return True '无要求
-                        If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True
-                        If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True
-                        If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True
-                        If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True
+                        If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Instance.Version.HasForge Then Return True
+                        If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Instance.Version.HasFabric Then Return True
+                        If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
+                        If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
                         Return False
                     End Function
                     '获取常规资源默认下载位置
-                    If CachedFolder IsNot Nothing Then
-                        DefaultFolder = CachedFolder
+                    If CachedFolder.ContainsKey(File.Type) Then
+                        DefaultFolder = CachedFolder(File.Type)
                         Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
-                    ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
-                        DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}"
+                    ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
+                        DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
                         Directory.CreateDirectory(DefaultFolder)
                         Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
                     Else
                         '查找所有可能的版本
-                        Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
+                        Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
                         If NeedLoad Then
                             Hint("正在查找适合的游戏版本……")
-                            LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
+                            LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
                         End If
-                        Dim SuitableVersions = McVersionList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)).
+                        Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
                             Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
-                        If SuitableVersions.Any Then
-                            Dim SelectedVersion = SuitableVersions.
+                        If SuitableInstanceList.Any Then
+                            Dim SelectedInstance = SuitableInstanceList.
                                 OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
                                 ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
                                 First()
-                            DefaultFolder = SelectedVersion.FullName
+                            DefaultFolder = SelectedInstance.FullName
                             Directory.CreateDirectory(DefaultFolder)
                             Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
                         Else
-                            DefaultFolder = PathMcFolder
+                            DefaultFolder = McFolderSelected
                             If NeedLoad Then
-                                Hint("当前 MC 文件夹中没有找到适合此资源的版本!")
+                                Hint($"当前 MC 文件夹中没有找到合适的版本!")
                             Else
                                 Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
                             End If
@@ -399,7 +452,7 @@
                 Else
                     Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
                         Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
-                    Select Case Setup.Get("ToolDownloadTranslateV2")
+                    Select Case Settings.Get("ToolDownloadTranslateV2")
                         Case 0
                             FileName = $"【{ChineseName}】{File.FileName}"
                         Case 1
@@ -412,6 +465,7 @@
                             FileName = File.FileName
                     End Select
                 End If
+                If File.Type = CompType.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
                 RunInUi(
                 Sub()
                     '弹窗要求选择保存位置
@@ -419,12 +473,12 @@
                     Target = SelectSaveFile("选择保存位置", FileName,
                         Desc & "文件|" &
                         If(File.Type = CompType.Mod,
-                            If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
-                            If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
+                            If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
+                            If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
                     If Not Target.Contains("\") Then Return
                     '构造步骤加载器
-                    Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
-                    If Target <> DefaultFolder AndAlso File.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
+                    Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
+                    If Target <> DefaultFolder Then CachedFolder(File.Type) = GetPathFromFullPath(Target)
                     Dim Loaders As New List(Of LoaderBase)
                     Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
                     '启动
@@ -450,4 +504,11 @@
         ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
     End Sub
 
+    'Mod / 数据包 互相跳转
+    Private Sub HintAlternative_Click() Handles HintAlternative.Click
+        TargetType = If(TargetType = CompType.Mod, CompType.DataPack, CompType.Mod)
+        FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
+        PageLoaderRestart(IsForceRestart:=True)
+    End Sub
+
 End Class

+ 1 - 1
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadDataPack.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadDataPack"
-    PanScroll="{Binding ElementName=Content}">
+    PanScroll="Content">
     <local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
         <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
         <local:MyComboBoxItem Content="世界元素" Tag="/worldgen" />

+ 3 - 2
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadMod.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadMod"
-    PanScroll="{Binding ElementName=Content}">
+    PanScroll="Content">
     <local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
         <local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
         <local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
@@ -27,7 +27,8 @@
         <local:MyComboBoxItem Content="生物" Tag="411/mobs" />
         <local:MyComboBoxItem Content="实用" Tag="5191/utility" />
         <local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
-        <local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
+        <local:MyComboBoxItem Content="创造模式" Tag="9026/" />
+        <local:MyComboBoxItem Content="性能优化" Tag="6814/optimization" />
         <local:MyComboBoxItem Content="信息显示" Tag="423/" />
         <local:MyComboBoxItem Content="服务器" Tag="435/social" />
         <local:MyComboBoxItem Content="支持库" Tag="421/library" />

+ 2 - 2
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadPack.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadPack"
-    PanScroll="{Binding ElementName=Content}">
+    PanScroll="Content">
     <local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
         <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
         <local:MyComboBoxItem Tag="4484/" Content="多人" />
@@ -17,7 +17,7 @@
         <local:MyComboBoxItem Tag="/kitchen-sink" Content="水槽包" />
         <local:MyComboBoxItem Tag="4476/" Content="探索" />
         <local:MyComboBoxItem Tag="4477/" Content="小游戏" />
-        <local:MyComboBoxItem Tag="4471/" Content="科幻" />
+        <local:MyComboBoxItem Tag="4474/" Content="科幻" />
         <local:MyComboBoxItem Tag="4736/" Content="空岛" />
         <local:MyComboBoxItem Tag="5128/" Content="原版改良" />
         <local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />

+ 1 - 1
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadResourcePack.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadResourcePack"
-    PanScroll="{Binding ElementName=Content}">
+    PanScroll="Content">
     <local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
         <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
 

+ 1 - 1
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadShader.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadShader"
-    PanScroll="{Binding ElementName=Content}">
+    PanScroll="Content">
     <local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
         <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
         

Разница между файлами не показана из-за своего большого размера
+ 198 - 319
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb


+ 0 - 31
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml

@@ -1,31 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadClient"
-    PanScroll="{Binding ElementName=PanBack}">
-    <Grid>
-        <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-            <StackPanel Orientation="Vertical" Margin="5">
-                <!--<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="自动安装提示" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Margin="0,0,0,2" Text="本页只提供需要在下载后手动进行安装的游戏 jar 与 json 下载。" TextWrapping="Wrap" />
-                    <TextBlock Margin="0,0,0,11" Text="如果你想要进行自动安装,在游戏安装页选择游戏版本,然后直接安装即可。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
-                        <local:MyButton x:Name="BtnInstall" Grid.Column="1" MinWidth="140" Text="转到游戏安装页" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>-->
-                <StackPanel Name="PanMain" Margin="20,20,20,5" Grid.IsSharedSizeScope="True" />
-            </StackPanel>
-        </local:MyScrollViewer>
-        <local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40,0" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
-            <local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-        </local:MyCard>
-    </Grid>
-</local:MyPageRight>

+ 0 - 111
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb

@@ -1,111 +0,0 @@
-Public Class PageDownloadClient
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            '归类
-            Dim Dict As New Dictionary(Of String, List(Of JObject)) From {
-                {"正式版", New List(Of JObject)}, {"预览版", New List(Of JObject)}, {"远古版", New List(Of JObject)}, {"愚人节版", New List(Of JObject)}
-            }
-            Dim Versions As JArray = DlClientListLoader.Output.Value("versions")
-            For Each Version As JObject In Versions
-                '确定分类
-                Dim Type As String = Version("type")
-                Select Case Type
-                    Case "release"
-                        Type = "正式版"
-                    Case "snapshot"
-                        Type = "预览版"
-                        'Mojang 误分类
-                        If Version("id").ToString.StartsWith("1.") AndAlso
-                            Not Version("id").ToString.ToLower.Contains("combat") AndAlso
-                            Not Version("id").ToString.ToLower.Contains("rc") AndAlso
-                            Not Version("id").ToString.ToLower.Contains("experimental") AndAlso
-                            Not Version("id").ToString.ToLower.Contains("pre") Then
-                            Type = "正式版"
-                            Version("type") = "release"
-                        End If
-                        '愚人节版本
-                        Select Case Version("id").ToString.ToLower
-                            Case "20w14infinite", "20w14∞"
-                                Type = "愚人节版"
-                                Version("id") = "20w14∞"
-                                Version("type") = "special"
-                                Version.Add("lore", GetMcFoolName(Version("id")))
-                            Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato", "25w14craftmine"
-                                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"
-                        '已被处理的愚人节版
-                        Type = "愚人节版"
-                    Case Else
-                        Type = "远古版"
-                End Select
-                '加入辞典
-                Dict(Type).Add(Version)
-            Next
-            '排序
-            For i = 0 To Dict.Keys.Count - 1
-                Dict(Dict.Keys(i)) = Dict.Values(i).OrderByDescending(Function(v) v("releaseTime").Value(Of Date)).ToList
-            Next
-            '清空当前
-            PanMain.Children.Clear()
-            '添加最新版本
-            Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
-            Dim TopestVersions As New List(Of JObject)
-            Dim Release As JObject = Dict("正式版")(0).DeepClone()
-            Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
-            TopestVersions.Add(Release)
-            If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
-                Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
-                Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
-                TopestVersions.Add(Snapshot)
-            End If
-            Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
-            MyCard.StackInstall(PanInfo, 2)
-            CardInfo.Children.Add(PanInfo)
-            PanMain.Children.Add(CardInfo)
-            '添加其他版本
-            For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
-                If Not Pair.Value.Any() Then Continue For
-                '增加卡片
-                Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
-                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
-                NewCard.IsSwaped = True
-                PanMain.Children.Add(NewCard)
-            Next
-        Catch ex As Exception
-            Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-    Public Sub DownloadStart(sender As MyListItem, e As Object)
-        McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, sender.Title, sender.Tag("url").ToString)
-    End Sub
-
-    ''介绍栏
-    'Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
-    '    OpenWebsite("https://www.minecraft.net/zh-hans")
-    'End Sub
-    'Private Sub BtnInstall_Click(sender As Object, e As EventArgs) Handles BtnInstall.Click
-    '    FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
-    'End Sub
-
-End Class

+ 0 - 28
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml

@@ -1,28 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadFabric"
-    PanScroll="{Binding ElementName=PanBack}">
-    <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-        <StackPanel Orientation="Vertical" Margin="5">
-            <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Fabric 简介" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Margin="0,0,0,11" Text="Fabric Loader 是新版 Minecraft 下的轻量化 Mod 加载器,你需要先安装它才能安装各种 Fabric 模组。&#xa;本页面提供 Fabric 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>
-            <local:MyCard x:Name="CardVersions" Margin="20,15,20,20" Title="版本列表">
-                <StackPanel x:Name="PanVersions" Margin="20,40,18,20" />
-            </local:MyCard>
-            <local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
-                <local:MyLoading Text="正在获取 Fabric 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-            </local:MyCard>
-        </StackPanel>
-    </local:MyScrollViewer>
-</local:MyPageRight>

+ 0 - 32
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml.vb

@@ -1,32 +0,0 @@
-Public Class PageDownloadFabric
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, CardVersions, CardTip, DlFabricListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            Dim Versions As JArray = DlFabricListLoader.Output.Value("installer")
-            PanVersions.Children.Clear()
-            For Each Version In Versions
-                PanVersions.Children.Add(FabricDownloadListItem(Version, AddressOf Fabric_Selected))
-            Next
-            CardVersions.Title = "版本列表 (" & Versions.Count & ")"
-        Catch ex As Exception
-            Log(ex, "可视化 Fabric 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-    Private Sub Fabric_Selected(sender As MyListItem, e As EventArgs)
-        McDownloadFabricLoaderSave(sender.Tag)
-    End Sub
-
-    Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
-        OpenWebsite("https://www.fabricmc.net")
-    End Sub
-
-End Class

+ 0 - 26
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml

@@ -1,26 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadForge"
-    PanScroll="{Binding ElementName=PanBack}">
-    <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-        <StackPanel Orientation="Vertical" Margin="5">
-            <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Forge 简介" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Name="LabConnect" Margin="0,0,0,11" Text="Forge 是一个 Mod 加载器,你需要先安装 Forge 才能安装各种 Forge 模组。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>
-            <StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
-            <local:MyCard HorizontalAlignment="Center" Margin="40,50" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
-                <local:MyLoading Text="正在获取 Forge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-            </local:MyCard>
-        </StackPanel>
-    </local:MyScrollViewer>
-</local:MyPageRight>

+ 0 - 61
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb

@@ -1,61 +0,0 @@
-Public Class PageDownloadForge
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlForgeListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            '清空当前
-            PanMain.Children.Clear()
-            '转化为 UI
-            For Each Version As String In DlForgeListLoader.Output.Value.Sort(AddressOf VersionSortBoolean)
-                '增加卡片
-                Dim NewCard As New MyCard With {.Title = Version.Replace("_p", " P"), .Margin = New Thickness(0, 0, 0, 15), .SwapType = 5}
-                Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Version}
-                NewCard.Children.Add(NewStack)
-                NewCard.SwapControl = NewStack
-                NewCard.IsSwaped = True
-                PanMain.Children.Add(NewCard)
-            Next
-            ''非官方源警示
-            'If Setup.Get("ToolDownloadOutOfDate") AndAlso Not DlForgeListLoader.Output.IsOfficial Then
-            '    Dim CardWarn As New MyCard With {.Title = "过期提示", .Margin = New Thickness(0, 0, 0, 15)}
-            '    CardWarn.Children.Add(New TextBlock With {
-            '                          .Margin = New Thickness(25, MyCard.SwapedHeight, 15, 15), .VerticalAlignment = VerticalAlignment.Top, .HorizontalAlignment = HorizontalAlignment.Left, .TextTrimming = TextTrimming.None, .TextWrapping = TextWrapping.Wrap,
-            '                          .Text = "获取官方源失败,正在使用 " & DlForgeListLoader.Output.SourceName & " 镜像源,版本列表可能并非最新。" & vbCrLf & "官方源错误原因:" & If(DlForgeListLoader.Output.OfficialError, New Exception("连接服务器超时")).Message})
-            '    PanMain.Children.Insert(0, CardWarn)
-            'End If
-        Catch ex As Exception
-            Log(ex, "可视化 Forge 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-    'Forge 版本列表加载
-    Public Sub Forge_Click(sender As MyLoading, e As MouseButtonEventArgs)
-        If sender.State.LoadingState = MyLoading.MyLoadingState.Error Then
-            CType(sender.State, LoaderTask(Of String, List(Of DlForgeVersionEntry))).Start(IsForceRestart:=True)
-        End If
-    End Sub
-    Public Sub Forge_StateChanged(sender As MyLoading, newState As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState)
-        If newState <> MyLoading.MyLoadingState.Stop Then Return
-
-        Dim Card As MyCard = CType(sender.Parent, FrameworkElement).Parent
-        Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = sender.State
-        '载入列表
-        Card.SwapControl.Children.Clear()
-        Card.SwapControl.Tag = Loader.Output
-        Card.SwapType = 6
-        Card.StackInstall()
-    End Sub
-
-    '介绍栏
-    Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
-        OpenWebsite("https://files.minecraftforge.net")
-    End Sub
-
-End Class

+ 8 - 8
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml

@@ -3,7 +3,7 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     mc:Ignorable="d" x:Class="PageDownloadInstall"
-    PanScroll="{Binding ElementName=PanBack}">
+    PanScroll="PanBack">
     <Grid>
         <Grid Name="PanAllBack">
             <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
@@ -27,7 +27,7 @@
                         <local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" Theme="Red" />
                         <local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" Theme="Yellow" />
                         <local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" Theme="Yellow" />
-                        <local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" />
                         <Grid x:Name="PanForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>
@@ -45,7 +45,7 @@
                                 Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="NeoForge" Height="40" Margin="0,12,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="NeoForge" Height="40" Margin="0,12,0,0" x:Name="CardNeoForge" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
                         <Grid x:Name="PanNeoForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>
@@ -63,7 +63,7 @@
                           Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="Fabric" Height="40" Margin="0,12,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="Fabric" Height="40" Margin="0,12,0,0" x:Name="CardFabric" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
                         <Grid x:Name="PanFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>
@@ -81,7 +81,7 @@
                                 Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="Fabric API" Height="40" Margin="0,12,0,0" x:Name="CardFabricApi" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="Fabric API" Height="40" Margin="0,12,0,0" x:Name="CardFabricApi" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabricApi" />
                         <Grid x:Name="PanFabricApiInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>
@@ -99,7 +99,7 @@
                                 Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="OptiFine" Height="40" Margin="0,12,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="OptiFine" Height="40" Margin="0,12,0,0" x:Name="CardOptiFine" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
                             <StackPanel Name="PanOptiFine" />
                         </StackPanel>
@@ -119,7 +119,7 @@
                                 Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="OptiFabric" Height="40" Margin="0,12,0,0" x:Name="CardOptiFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="OptiFabric" Height="40" Margin="0,12,0,0" x:Name="CardOptiFabric" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" />
                         <Grid x:Name="PanOptiFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>
@@ -137,7 +137,7 @@
                                 Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
                         </Grid>
                     </local:MyCard>
-                        <local:MyCard Title="LiteLoader" Height="40" Margin="0,12,0,0" x:Name="CardLiteLoader" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <local:MyCard Title="LiteLoader" Height="40" Margin="0,12,0,0" x:Name="CardLiteLoader" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanLiteLoader" />
                         <Grid x:Name="PanLiteLoaderInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
                             <Grid.RenderTransform>

Разница между файлами не показана из-за своего большого размера
+ 206 - 336
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb


Разница между файлами не показана из-за своего большого размера
+ 4 - 27
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml


+ 1 - 88
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb

@@ -11,7 +11,7 @@
     ''' <summary>
     ''' 勾选事件改变页面。
     ''' </summary>
-    Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check
+    Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemInstall.Check, ItemMod.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check
         '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
         '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
         If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -23,24 +23,6 @@
             Case FormMain.PageSubType.DownloadInstall
                 If FrmDownloadInstall Is Nothing Then FrmDownloadInstall = New PageDownloadInstall
                 Return FrmDownloadInstall
-            Case FormMain.PageSubType.DownloadClient
-                If FrmDownloadClient Is Nothing Then FrmDownloadClient = New PageDownloadClient
-                Return FrmDownloadClient
-            Case FormMain.PageSubType.DownloadOptiFine
-                If FrmDownloadOptiFine Is Nothing Then FrmDownloadOptiFine = New PageDownloadOptiFine
-                Return FrmDownloadOptiFine
-            Case FormMain.PageSubType.DownloadForge
-                If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge
-                Return FrmDownloadForge
-            Case FormMain.PageSubType.DownloadNeoForge
-                If FrmDownloadNeoForge Is Nothing Then FrmDownloadNeoForge = New PageDownloadNeoForge
-                Return FrmDownloadNeoForge
-            Case FormMain.PageSubType.DownloadLiteLoader
-                If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader
-                Return FrmDownloadLiteLoader
-            Case FormMain.PageSubType.DownloadFabric
-                If FrmDownloadFabric Is Nothing Then FrmDownloadFabric = New PageDownloadFabric
-                Return FrmDownloadFabric
             Case FormMain.PageSubType.DownloadMod
                 If FrmDownloadMod Is Nothing Then FrmDownloadMod = New PageDownloadMod
                 Return FrmDownloadMod
@@ -163,24 +145,6 @@
                     FrmDownloadDataPack.PageLoaderRestart()
                 End If
                 ItemDataPack.Checked = True
-            Case FormMain.PageSubType.DownloadClient
-                DlClientListLoader.Start(IsForceRestart:=True)
-                ItemClient.Checked = True
-            Case FormMain.PageSubType.DownloadOptiFine
-                DlOptiFineListLoader.Start(IsForceRestart:=True)
-                ItemOptiFine.Checked = True
-            Case FormMain.PageSubType.DownloadForge
-                DlForgeListLoader.Start(IsForceRestart:=True)
-                ItemForge.Checked = True
-            Case FormMain.PageSubType.DownloadNeoForge
-                DlNeoForgeListLoader.Start(IsForceRestart:=True)
-                ItemNeoForge.Checked = True
-            Case FormMain.PageSubType.DownloadLiteLoader
-                DlLiteLoaderListLoader.Start(IsForceRestart:=True)
-                ItemLiteLoader.Checked = True
-            Case FormMain.PageSubType.DownloadFabric
-                DlFabricListLoader.Start(IsForceRestart:=True)
-                ItemFabric.Checked = True
         End Select
         Hint("正在刷新……", Log:=False)
     End Sub
@@ -191,55 +155,4 @@
         FrmDownloadInstall.ExitSelectPage()
     End Sub
 
-    '展开手动安装
-    Private Sub ItemHand_Click(sender As Object, e As RouteEventArgs) Handles ItemHand.Changed
-        If ItemHand.Checked = False Then Return
-        e.Handled = True
-        AniControlEnabled += 1
-        If Not Setup.Get("HintHandInstall") Then
-            Setup.Set("HintHandInstall", True)
-            If MyMsgBox("手动安装包功能提供了 OptiFine、Forge 等组件的 .jar 安装文件下载,但无法自动安装。" & vbCrLf &
-                        "在自动安装页面先选择 MC 版本,然后就可以选择 OptiFine、Forge 等组件,让 PCL 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then
-                FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.Download}, FormMain.PageSubType.DownloadInstall)
-                AniControlEnabled -= 1
-                Return
-            End If
-        End If
-        ItemHand.Visibility = Visibility.Collapsed
-        LabGame.Visibility = Visibility.Collapsed
-        LabHand.Visibility = Visibility.Visible
-        ItemClient.Visibility = Visibility.Visible
-        ItemOptiFine.Visibility = Visibility.Visible
-        ItemFabric.Visibility = Visibility.Visible
-        ItemForge.Visibility = Visibility.Visible
-        ItemNeoForge.Visibility = Visibility.Visible
-        ItemLiteLoader.Visibility = Visibility.Visible
-        RunInThread(
-        Sub()
-            Thread.Sleep(20)
-            RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
-            AniControlEnabled -= 1
-        End Sub)
-    End Sub
-    '折叠手动安装
-    Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp
-        e.Handled = True
-        AniControlEnabled += 1
-        ItemHand.Visibility = Visibility.Visible
-        LabGame.Visibility = Visibility.Visible
-        LabHand.Visibility = Visibility.Collapsed
-        ItemClient.Visibility = Visibility.Collapsed
-        ItemOptiFine.Visibility = Visibility.Collapsed
-        ItemNeoForge.Visibility = Visibility.Collapsed
-        ItemFabric.Visibility = Visibility.Collapsed
-        ItemForge.Visibility = Visibility.Collapsed
-        ItemLiteLoader.Visibility = Visibility.Collapsed
-        RunInThread(
-        Sub()
-            Thread.Sleep(20)
-            RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
-            AniControlEnabled -= 1
-        End Sub)
-    End Sub
-
 End Class

+ 0 - 26
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml

@@ -1,26 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
-    PanScroll="{Binding ElementName=PanBack}">
-    <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-        <StackPanel Orientation="Vertical" Margin="5">
-            <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="LiteLoader 简介" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Name="LabConnect" Margin="0,0,0,11" Text="与 Forge 类似,LiteLoader 可以用于加载老版本 Minecraft 中的 LiteLoader 模组。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>
-            <StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
-            <local:MyCard HorizontalAlignment="Center" Margin="40,50" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
-                <local:MyLoading Text="正在获取 LiteLoader 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-            </local:MyCard>
-        </StackPanel>
-    </local:MyScrollViewer>
-</local:MyPageRight>

+ 0 - 52
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml.vb

@@ -1,52 +0,0 @@
-Public Class PageDownloadLiteLoader
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlLiteLoaderListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            '归类
-            Dim Dict As New Dictionary(Of String, List(Of DlLiteLoaderListEntry))
-            For VersionCode As Integer = 30 To 0 Step -1
-                Dict.Add("1." & VersionCode, New List(Of DlLiteLoaderListEntry))
-            Next
-            Dict.Add("未知版本", New List(Of DlLiteLoaderListEntry))
-            For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
-                Dim MainVersion As String = "1." & Version.Inherit.Split(".")(1)
-                If Dict.ContainsKey(MainVersion) Then
-                    Dict(MainVersion).Add(Version)
-                Else
-                    Dict("未知版本").Add(Version)
-                End If
-            Next
-            '清空当前
-            PanMain.Children.Clear()
-            '转化为 UI
-            For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
-                If Not Pair.Value.Any() Then Continue For
-                '增加卡片
-                Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10}
-                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
-                NewCard.IsSwaped = True
-                PanMain.Children.Add(NewCard)
-            Next
-        Catch ex As Exception
-            Log(ex, "可视化 LiteLoader 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-    Public Sub DownloadStart(sender As MyListItem, e As Object)
-        McDownloadLiteLoader(sender.Tag)
-    End Sub
-    Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
-        OpenWebsite("https://www.liteloader.com")
-    End Sub
-
-End Class

+ 0 - 27
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml

@@ -1,27 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadNeoForge"
-    PanScroll="{Binding ElementName=PanBack}">
-    <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-        <StackPanel Orientation="Vertical" Margin="5">
-            <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.20.1+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组,它也兼容一些 Forge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
-                                        EventType="打开网页" EventData="https://neoforged.net/" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>
-            <StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
-            <local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
-                <local:MyLoading Text="正在获取 NeoForge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-            </local:MyCard>
-        </StackPanel>
-    </local:MyScrollViewer>
-</local:MyPageRight>

+ 0 - 34
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadNeoForge.xaml.vb

@@ -1,34 +0,0 @@
-Public Class PageDownloadNeoForge
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlNeoForgeListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            '归类
-            Dim Dict = DlNeoForgeListLoader.Output.Value.GroupBy(Function(d) d.Inherit).OrderByDescending(Function(g) g.Key).
-                ToDictionary(Function(g) g.Key, Function(g) g.ToList())
-            '清空当前
-            PanMain.Children.Clear()
-            '转化为 UI
-            For Each Pair As KeyValuePair(Of String, List(Of DlNeoForgeListEntry)) In Dict
-                If Not Pair.Value.Any() Then Continue For
-                '增加卡片
-                Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 13}
-                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
-                NewCard.IsSwaped = True
-                PanMain.Children.Add(NewCard)
-            Next
-        Catch ex As Exception
-            Log(ex, "可视化 NeoForge 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-End Class

+ 0 - 26
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml

@@ -1,26 +0,0 @@
-<local:MyPageRight
-    xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
-    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
-    xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageDownloadOptiFine"
-    PanScroll="{Binding ElementName=PanBack}">
-    <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
-        <StackPanel Orientation="Vertical" Margin="5">
-            <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip">
-                <StackPanel Margin="25,40,15,20">
-                    <TextBlock Name="LabConnect" Margin="0,0,0,11" Text="OptiFine 又称为高清修复,以允许安装光影、使用高清材质、提高游戏性能,但与 Mod 的兼容性不佳。" TextWrapping="Wrap" />
-                    <Grid Height="35">
-                        <Grid.ColumnDefinitions>
-                            <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
-                        </Grid.ColumnDefinitions>
-                        <local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
-                    </Grid>
-                </StackPanel>
-            </local:MyCard>
-            <StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
-            <local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
-                <local:MyLoading Text="正在获取 OptiFine 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
-            </local:MyCard>
-        </StackPanel>
-    </local:MyScrollViewer>
-</local:MyPageRight>

+ 0 - 53
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb

@@ -1,53 +0,0 @@
-Public Class PageDownloadOptiFine
-
-    Private Sub LoaderInit() Handles Me.Initialized
-        PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlOptiFineListLoader, AddressOf Load_OnFinish)
-    End Sub
-    Private Sub Init() Handles Me.Loaded
-        PanBack.ScrollToHome()
-    End Sub
-
-    Private Sub Load_OnFinish()
-        '结果数据化
-        Try
-            '归类
-            Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry))
-            Dict.Add("快照版本", New List(Of DlOptiFineListEntry))
-            For VersionCode As Integer = 50 To 0 Step -1
-                Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry))
-            Next
-            For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
-                If Version.Inherit.StartsWith("1.") Then
-                    Dim MainVersion As String = "1." & Version.NameDisplay.Split(".")(1).Split(" ")(0)
-                    If Dict.ContainsKey(MainVersion) Then
-                        Dict(MainVersion).Add(Version)
-                    Else
-                        Dict("快照版本").Add(Version)
-                    End If
-                Else
-                    Dict("快照版本").Add(Version)
-                End If
-            Next
-            '清空当前
-            PanMain.Children.Clear()
-            '转化为 UI
-            For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
-                If Not Pair.Value.Any() Then Continue For
-                '增加卡片
-                Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3}
-                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
-                NewCard.IsSwaped = True
-                PanMain.Children.Add(NewCard)
-            Next
-        Catch ex As Exception
-            Log(ex, "可视化 OptiFine 版本列表出错", LogLevel.Feedback)
-        End Try
-    End Sub
-
-    Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
-        OpenWebsite("https://www.optifine.net/")
-    End Sub
-
-End Class

+ 0 - 0
Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml → Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml


+ 110 - 115
Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml.vb

@@ -5,16 +5,6 @@ Public Class MyLocalModItem
 #Region "基础属性"
     Public Uuid As Integer = GetUuid()
 
-    'Logo
-    Public Property Logo As String
-        Get
-            Return PathLogo.Source
-        End Get
-        Set(value As String)
-            PathLogo.Source = value
-        End Set
-    End Property
-
     '标题
     Private _Title As String
     Public Property Title As String
@@ -28,9 +18,6 @@ Public Class MyLocalModItem
                     LabTitle.TextDecorations = Nothing
                 Case McMod.McModState.Disabled
                     LabTitle.TextDecorations = TextDecorations.Strikethrough
-                Case McMod.McModState.Unavailable
-                    LabTitle.TextDecorations = TextDecorations.Strikethrough
-                    value &= " [错误]"
             End Select
             If LabTitle.Text = value Then Return
             LabTitle.Text = value
@@ -63,17 +50,17 @@ Public Class MyLocalModItem
 
     'Tag
     Public WriteOnly Property Tags As List(Of String)
-        Set(value As List(Of String))
+        Set(Tags As List(Of String))
             PanTags.Children.Clear()
-            PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
-            For Each TagText In value
-                Dim NewTag = GetObjectFromXML(
-                "<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
-                         Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" 
-                         SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
-                   <TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
-                </Border>")
-                PanTags.Children.Add(NewTag)
+            PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
+            For Each TagText In Tags
+                Dim BorderTag As New Border With {
+                    .Background = New MyColor("#0A000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
+                    .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
+                Dim LabTag As New TextBlock With {
+                    .Text = TagText, .Foreground = New MyColor("#B0B0B0"), .FontSize = 11}
+                BorderTag.Child = LabTag
+                PanTags.Children.Add(BorderTag)
             Next
         End Set
     End Property
@@ -123,7 +110,7 @@ Public Class MyLocalModItem
         End Get
         Set(value As Boolean)
             _Swiping = value
-            FrmVersionMod.CardSelect.IsHitTestVisible = Not value
+            FrmInstanceMod.CardSelect.IsHitTestVisible = Not value
         End Set
     End Property
     Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
@@ -313,11 +300,11 @@ Public Class MyLocalModItem
 #End Region
 
     Private Function GetUpdateCompareDescription() As String
-        Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
-        Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
+        Dim CurrentName = If(Entry.CompFile.Version, Entry.CompFile.DisplayName).Replace(".jar", "")
+        Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.DisplayName).Replace(".jar", "")
         '简化名称对比
-        Dim CurrentSegs = CurrentName.Split("-"c).ToList()
-        Dim NewestSegs = NewestName.Split("-"c).ToList()
+        Dim CurrentSegs = CurrentName.Split("-_+ ".ToCharArray).ToList()
+        Dim NewestSegs = NewestName.Split("-_+ ".ToCharArray).ToList()
         Dim Shortened As Boolean = False
         For Each Seg In CurrentSegs.ToList()
             If Not NewestSegs.Contains(Seg) Then Continue For
@@ -326,101 +313,109 @@ Public Class MyLocalModItem
             Shortened = True
         Next
         If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
-            CurrentName = Join(CurrentSegs, "-")
-            NewestName = Join(NewestSegs, "-")
+            CurrentName = CurrentSegs.Join("-")
+            NewestName = NewestSegs.Join("-")
             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
-                BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
+
+    '懒加载
+    Public Sub New()
+        InitializeComponent()
+        LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf FirstEnterScrollViewerViewport)
+    End Sub
+    Private HasEnteredViewport As Boolean = False
+    Private Sub FirstEnterScrollViewerViewport()
+        HasEnteredViewport = True
+        Refresh()
+    End Sub
+    Public Sub Refresh()
+        If Not HasEnteredViewport Then Return '避免在未显示时因为 Comp 更新而加载内容
+        '更新
+        If Entry.CanUpdate Then
+            BtnUpdate.Visibility = Visibility.Visible
+            BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
+        Else
+            BtnUpdate.Visibility = Visibility.Collapsed
+        End If
+        '标题与描述
+        Dim DescFileName As String
+        If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then
+            DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path)
+        Else
+            DescFileName = GetFileNameFromPath(Entry.Path)
+        End If
+        Dim NewDescription As String
+        If Settings.Get("ToolModLocalNameStyle") = 1 Then
+            '标题显示文件名,详情显示译名
+            '标题
+            Title = DescFileName
+            SubTitle = ""
+            '描述
+            If Entry.Comp Is Nothing Then
+                NewDescription = Entry.DisplayName
             Else
-                BtnUpdate.Visibility = Visibility.Collapsed
+                Dim Titles = Entry.Comp.GetControlTitle(False)
+                NewDescription = Titles.Title & Titles.SubTitle
             End If
-            '标题与描述
-            Dim DescFileName As String
-            Select Case Entry.State
-                Case McMod.McModState.Fine
-                    DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
-                Case McMod.McModState.Disabled
-                    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})"
+            NewDescription = NewDescription.Replace("  |  ", " / ")
+            If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
+        Else
+            '标题显示译名,详情显示文件名
+            '标题
+            If Entry.Comp Is Nothing Then
+                Title = Entry.DisplayName
+                SubTitle = If(Entry.Version Is Nothing, "", "  |  " & 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
-                NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
-            ElseIf Not Entry.IsFileAvailable Then
-                NewDescription += ": " & "存在错误,无法获取信息"
+                Dim Titles = Entry.Comp.GetControlTitle(False)
+                Title = Titles.Title
+                SubTitle = Titles.SubTitle & If(Entry.Version Is Nothing, "", "  |  " & Entry.Version)
             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"))
+            '描述
+            NewDescription = DescFileName
+        End If
+        If Entry.Comp IsNot Nothing Then
+            NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
+        ElseIf Entry.Description IsNot Nothing Then
+            NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
+        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
+        If Entry.Comp IsNot Nothing Then
+            Entry.Comp.ApplyLogoToMyImage(PathLogo)
+        Else
+            PathLogo.Source = PathImage & "Icons/NoIcon.png"
+        End If
+        '图标右下角的 Logo
+        If Entry.State = McMod.McModState.Fine Then
+            If ImgState IsNot Nothing Then
+                Children.Remove(ImgState)
+                ImgState = Nothing
             End If
-            '主 Logo
-            Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
-            '图标右下角的 Logo
-            If Entry.State = McMod.McModState.Fine Then
-                If ImgState IsNot Nothing Then
-                    Children.Remove(ImgState)
-                    ImgState = Nothing
-                End If
-            Else
-                If ImgState Is Nothing Then
-                    ImgState = New Image With {
-                        .Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
-                        .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
-                    }
-                    RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
-                    SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
-                    Children.Add(ImgState)
-                    '<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
-                    '       Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
-                    '       HorizontalAlignment="Right" VerticalAlignment="Bottom"
-                    '       Source="/Images/Icons/Unavailable.png" />
-                End If
-                ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
+        Else
+            If ImgState Is Nothing Then
+                ImgState = New Image With {
+                    .Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
+                    .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
+                }
+                RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
+                SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
+                Children.Add(ImgState)
+                '<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
+                '       Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
+                '       HorizontalAlignment="Right" VerticalAlignment="Bottom"
+                '       Source="/Images/Icons/Unavailable.png" />
             End If
-            '标签
-            If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
-        End Sub)
+            ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
+        End If
+        '标签
+        If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
     End Sub
 
     Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
@@ -491,9 +486,9 @@ Public Class MyLocalModItem
 
     '触发更新
     Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
-        Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
+        Select Case MyMsgBox($"是否要更新 {Entry.DisplayName}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
             Case 1 '更新
-                FrmVersionMod.UpdateMods({Entry})
+                FrmInstanceMod.UpdateMods({Entry})
             Case 2 '查看更新日志
                 ShowUpdateLog()
             Case 3 '取消

+ 24 - 8
Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml

@@ -3,8 +3,8 @@
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
     xmlns:System="clr-namespace:System;assembly=mscorlib" 
-    mc:Ignorable="d" x:Class="PageVersionExport"
-    PanScroll="{Binding ElementName=PanBack}">
+    mc:Ignorable="d" x:Class="PageInstanceExport"
+    PanScroll="PanBack">
     <Grid x:Name="PanAllBack">
         <Grid.Resources>
             <Style TargetType="local:MyCheckBox">
@@ -94,7 +94,7 @@
                                     <local:ExportOption 
                                 Title="整合包重要数据"
                                 Description="脚本文件、内置资源包、数据包等"
-                                Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
+                                Rules="hotai/|bansoukou/|addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|moonlight-global-datapacks/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
                                 DefaultChecked="True" />
                                 </local:MyCheckBox.Tag>
                             </local:MyCheckBox>
@@ -102,7 +102,23 @@
                                 <local:MyCheckBox.Tag>
                                     <local:ExportOption 
                                 Title="Mod 设置"
-                                Rules="config/|!config/jei/world/|!config/worldedit/|config/worldedit/worldedit.properties|!config/spark/|config/spark/config.json|defaultconfigs/|journeymap/config/|journeymap/server/|TrashSlotSaveState.json|customfov.txt|gg.essential.mod/|essential/|!essential/*/|!essential/*.jar*|!essential/screenshot-checksum-caches.json|!essential/microsoft_accounts.json|paragliderSettings.nbt|local/client_config.json|local/ftbl.json|local/client/sidebar_buttons.json|local/client/ftbutilities.cfg|local/client/ftblib.cfg|local/client/xencraft.cfg|liteloader.properties|default_reference.xml|CustomSkinLoader/CustomSkinLoader.json"
+                                Rules="config/|!config/jei/world/|!config/worldedit/|config/worldedit/worldedit.properties|!config/spark/|config/spark/config.json|defaultconfigs/|journeymap/config/|journeymap/server/|TrashSlotSaveState.json|customfov.txt|gg.essential.mod/|essential/|!essential/*/|!essential/*.jar*|!essential/screenshot-checksum-caches.json|!essential/microsoft_accounts.json|paragliderSettings.nbt|local/client_config.json|local/ftbl.json|local/client/sidebar_buttons.json|local/client/ftbutilities.cfg|local/client/ftblib.cfg|local/client/xencraft.cfg|liteloader.properties|default_reference.xml|CustomSkinLoader/CustomSkinLoader.json|!config/tacz/custom"
+                                DefaultChecked="True" />
+                                </local:MyCheckBox.Tag>
+                            </local:MyCheckBox>
+                            <local:MyCheckBox>
+                                <local:MyCheckBox.Tag>
+                                    <local:ExportOption 
+                                Title="TaCZ 枪包"
+                                Rules="tacz/|config/tacz/custom/"
+                                DefaultChecked="True" />
+                                </local:MyCheckBox.Tag>
+                            </local:MyCheckBox>
+                            <local:MyCheckBox>
+                                <local:MyCheckBox.Tag>
+                                    <local:ExportOption 
+                                Title="已上传的沉浸画"
+                                Rules="immersive_paintings/"
                                 DefaultChecked="True" />
                                 </local:MyCheckBox.Tag>
                             </local:MyCheckBox>
@@ -235,14 +251,14 @@
                         </StackPanel>
                     </StackPanel>
                 </local:MyCard>
-                <local:MyCard Title="高级选项" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
+                <local:MyCard Title="高级选项" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
                     <StackPanel Margin="25,37,23,20">
                         <local:MyHint Text="建议仅在无法稳定连接 CurseForge 或 Modrinth 时才打包资源文件。&#xa;请不要公开发布含资源文件的整合包,这会违反部分 Mod 的使用协议!"
                                       Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" />
                         <local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude"
                                           ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" />
-                        <local:MyCheckBox Text="Modrinth 上传模式" x:Name="CheckAdvancedModrinth"
-                                          ToolTip="如果你想要打包上传到 Modrinth,勾选此项会生成完全符合 Modrinth 要求的整合包文件。&#xa;由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。&#xa;此外,勾选后也不能在整合包中包含 PCL 启动器文件。" />
+                        <local:MyCheckBox Text="仅从 Modrinth 下载资源文件" x:Name="CheckAdvancedModrinth"
+                                          ToolTip="若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。&#xa;如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。" />
                         <local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2"
                                       Text="配置文件中含有更多高级选项,例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项,请先点击 “保存配置”,在编辑配置文件后再导入。" />
                         <Grid Height="35" Margin="0,12,0,0">
@@ -254,7 +270,7 @@
                             <local:MyButton Grid.Column="0" x:Name="BtnAdvancedImport" MinWidth="140" Text="读取配置" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
                             <local:MyButton Grid.Column="1" x:Name="BtnAdvancedExport" MinWidth="140" Text="保存配置" Padding="13,0" Margin="0,0,20,0" />
                             <local:MyButton Grid.Column="2" MinWidth="140" Text="整合包制作指南" Padding="13,0" Margin="0,0,20,0" x:Name="BtnAdvancedHelp"
-                                            EventType="打开帮助" />
+                                            local:CustomEventService.EventType="打开帮助" />
                         </Grid>
                     </StackPanel>
                 </local:MyCard>

+ 49 - 53
Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb

@@ -15,27 +15,28 @@ Public Class ExportOption
     Public Property RequireModLoaderOrOptiFine As Boolean = False
 End Class
 
-Public Class PageVersionExport
+Public Class PageInstanceExport
     Implements IRefreshable
 
-    Private CurrentVersion As String = ""
-    Private Sub PageVersionExport_Loaded() Handles Me.Loaded
+    Private CurrentInstance As String = ""
+    Private Sub PageInstanceExport_Loaded() Handles Me.Loaded
         AniControlEnabled += 1
-        If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面
-        BtnAdvancedHelp.EventData = If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json")
+        If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本,重置页面
+        CustomEventService.SetEventData(BtnAdvancedHelp,
+            If(VersionBranchCode = 50, "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
         AniControlEnabled -= 1
     End Sub
     Public Sub RefreshAll() Implements IRefreshable.Refresh
         Log($"[Export] 刷新导出页面")
-        HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
-        CurrentVersion = PageVersionLeft.Version.Path
+        HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
+        CurrentInstance = PageInstanceLeft.Instance.PathVersion
         TextExportName.Text = ""
-        TextExportName.HintText = PageVersionLeft.Version.Name
+        TextExportName.HintText = PageInstanceLeft.Instance.Name
         TextExportVersion.Text = ""
         TextExportVersion.HintText = "1.0.0"
         CheckAdvancedInclude.Checked = False
         CheckAdvancedModrinth.Checked = False
-        GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetDefaultDescription()
+        GetExportOption(CheckOptionsBasic).Description = PageInstanceLeft.Instance.VersionDisplayName()
         ResetConfigOverrides()
         ReloadAllSubOptions()
         RefreshAllOptionsUI()
@@ -57,7 +58,7 @@ Public Class PageVersionExport
     Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
         Panel.Children.Clear()
         For Each Folder In Folders
-            Dim TargetFolder As New DirectoryInfo(PageVersionLeft.Version.PathIndie & Folder)
+            Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder)
             If Not TargetFolder.Exists() Then Continue For
             '查找文件夹下的对应项
             If AcceptCompressedFile Then
@@ -99,7 +100,7 @@ Public Class PageVersionExport
                 Return False
             End Try
         End Function
-        Dim PathInfo As New DirectoryInfo(PageVersionLeft.Version.PathIndie)
+        Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie)
         AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
         For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
             AllEntries.Add($"{SubFolder.Name}\")
@@ -111,9 +112,9 @@ Public Class PageVersionExport
         Dim IsVisible =
         Function(TargetOption As ExportOption) As Boolean
             '检查需要 OptiFine 或 Mod 加载器
-            If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False
-            If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False
-            If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False
+            If TargetOption.RequireOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine Then Return False
+            If TargetOption.RequireModLoader AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
+            If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
             '粗略检查是否可能有符合规则的文件/文件夹
             Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
             Function(Rule As String)
@@ -129,9 +130,9 @@ Public Class PageVersionExport
                 Rule = Rule.Trim("*?".ToCharArray)
                 If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
                     If Rule.EndsWithF("\") Then
-                        Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效
+                        Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
                     Else
-                        Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效
+                        Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
                     End If
                 Else
                     Return False
@@ -304,9 +305,9 @@ Public Class PageVersionExport
     '保存配置文件
     Private Sub ExportConfig() Handles BtnAdvancedExport.Click
         Try
-            Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Setup.Get("CacheExportConfig"))
+            Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
             If String.IsNullOrEmpty(ConfigPath) Then Return
-            Setup.Set("CacheExportConfig", ConfigPath)
+            Settings.Set("CacheExportConfig", ConfigPath)
             Dim ConfigLines As New List(Of String)
             'ini 段
             ConfigLines.Add("Name:" & TextExportName.Text)
@@ -323,9 +324,9 @@ Public Class PageVersionExport
             ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
             ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
             ConfigLines.Add("")
-            ConfigLines.Add("# 如果你想要打包上传到 Modrinth,启用此项会生成完全符合 Modrinth 要求的整合包文件。")
-            ConfigLines.Add("# 由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。")
-            ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。")
+            ConfigLines.Add("# 若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。")
+            ConfigLines.Add("# 如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。")
+            ConfigLines.Add("# 此选项与 DontCheckHostedAssets 冲突。")
             ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
             ConfigLines.Add("")
             ConfigLines.Add("# 导出的文件的存放位置。")
@@ -341,7 +342,7 @@ Public Class PageVersionExport
             ConfigLines.AddRange(GetExtraFileLines())
             '结束
             WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
-            Hint("已保存配置文件:" & ConfigPath, HintType.Finish)
+            Hint("已保存配置文件:" & ConfigPath, HintType.Green)
             OpenExplorer(ConfigPath)
         Catch ex As Exception
             Log(ex, "保存配置失败", LogLevel.Msgbox)
@@ -350,9 +351,9 @@ Public Class PageVersionExport
     '读取配置文件
     Private Sub ImportConfig() Handles BtnAdvancedImport.Click
         Try
-            Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Setup.Get("CacheExportConfig"))
+            Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig"))
             If String.IsNullOrEmpty(ConfigPath) Then Return
-            Setup.Set("CacheExportConfig", ConfigPath)
+            Settings.Set("CacheExportConfig", ConfigPath)
             Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
             'ini 段
             Dim Ini As New Dictionary(Of String, String)
@@ -366,8 +367,8 @@ Public Class PageVersionExport
             TextExportVersion.Text = Ini.GetOrDefault("Version", "")
             CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True)
             CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True)
-            CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False)
             CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False)
+            If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979,加个特判
             ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
             '导出内容段
             RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
@@ -378,7 +379,7 @@ Public Class PageVersionExport
                 ExtraFiles = Nothing
             End If
             '结束
-            Hint("已读取配置文件:" & ConfigPath, HintType.Finish)
+            Hint("已读取配置文件:" & ConfigPath, HintType.Green)
         Catch ex As Exception
             Log(ex, "读取配置失败", LogLevel.Msgbox)
         End Try
@@ -418,12 +419,12 @@ Public Class PageVersionExport
                 Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
             Catch ex As Exception
                 Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
-                If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{GetExceptionDetail(ex)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
+                If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
             End Try
         End If
         If PackPath Is Nothing Then
             Dim Extensions As New List(Of String)
-            If Not CheckAdvancedModrinth.Checked Then Extensions.Add("压缩文件(*.zip)|*.zip")
+            Extensions.Add("压缩文件(*.zip)|*.zip")
             If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
             PackPath = SelectSaveFile("选择导出位置",
                 PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
@@ -434,7 +435,7 @@ Public Class PageVersionExport
         '缓存所需参数
         Dim CacheFolder = RequestTaskTempFolder()
         Dim OverridesFolder = CacheFolder & "modpack\overrides\"
-        Dim McVersion = PageVersionLeft.Version
+        Dim McVersion = PageInstanceLeft.Instance
         Dim PathIndie As String = McVersion.PathIndie
         Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
         Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
@@ -484,7 +485,7 @@ Public Class PageVersionExport
                     '检查规则
                     Dim ShouldKeep As Boolean = False
                     For Each Rule In AllRules
-                        Dim Revert = Rule.StartsWith("!")
+                        Dim Revert = Rule.StartsWithF("!")
                         If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
                     Next
                     If Not ShouldKeep Then Continue For
@@ -492,7 +493,7 @@ Public Class PageVersionExport
                     CopyFile(Entry.FullName, TargetPath)
                     '若为压缩包,考虑联网获取路径
                     If CheckHostedAssets AndAlso
-                       {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.ToLower) AndAlso
+                       {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
                        {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
                         Dim ModFile As New McMod(TargetPath)
                         Dim Unused = ModFile.ModrinthHash '提前计算 Hash
@@ -517,19 +518,20 @@ Public Class PageVersionExport
                     If Directory.Exists(Line) Then
                         CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
                     Else
-                        Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Critical)
+                        Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Red)
                     End If
                 Else
                     If File.Exists(Line) Then
                         CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
                     Else
-                        Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Critical)
+                        Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Red)
                     End If
                 End If
             Next
             Loader.Progress = 0.97
             '复制 PCL 版本设置
-            CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\")
+            CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
+            WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
 #If BETA Then
             '复制 PCL 本体
             If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
@@ -564,8 +566,8 @@ Public Class PageVersionExport
             Sub()
                 Try
                     Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash)
-                    Dim ModrinthRaw = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
-                        $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
+                    Dim ModrinthRaw As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
+                        $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
                     For Each ModFile In Loader.Input
                         '查找对应的文件
                         If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
@@ -587,10 +589,10 @@ Public Class PageVersionExport
             RunInNewThread(
             Sub()
                 Try
-                    If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不能从 CurseForge 获取信息
+                    If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不从 CurseForge 获取信息
                     Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
-                    Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", "POST",
-                        $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
+                    Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post,
+                        $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
                     For Each ResultJson As JObject In CurseForgeRaw
                         If Not ResultJson.ContainsKey("file") Then Continue For
                         Dim File As JObject = ResultJson("file")
@@ -615,7 +617,7 @@ Public Class PageVersionExport
 
             '等待线程结束
             Do Until EndedThreadCount = 2
-                If Loader.IsAborted Then Return
+                If Loader.IsInterrupted Then Return
                 Thread.Sleep(10)
             Loop
 
@@ -646,17 +648,17 @@ Public Class PageVersionExport
                 Files.Add(New JObject From {
                     {"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
                     {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
-                    {"downloads", New JArray(Pair.Value.OrderByDescending(Function(u) u.Contains("modrinth.com")))},
+                    {"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
                     {"fileSize", New FileInfo(ModFile.Path).Length}
                 })
                 File.Delete(ModFile.Path)
             Next
             Loader.Progress = 0.2
             '导出最终 JSON 文件
-            Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}}
-            If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion)
-            If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion)
-            If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion)
+            Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.VanillaName}}
+            If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.Forge)
+            If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.Fabric)
+            If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForge)
             Dim ResultJson As New JObject From {
                 {"game", "minecraft"},
                 {"formatVersion", 1},
@@ -674,7 +676,7 @@ Public Class PageVersionExport
                 '首次压缩整合包
                 ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
                 Loader.Progress = 0.5
-                Directory.Delete(CacheFolder & "modpack\", True)
+                DeleteDirectory(CacheFolder & "modpack\")
                 Loader.Progress = 0.6
                 '二次压缩整合包
                 ZipFile.CreateFromDirectory(CacheFolder, PackPath)
@@ -684,7 +686,7 @@ Public Class PageVersionExport
                 ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
                 Loader.Progress = 0.8
             End If
-            Directory.Delete(CacheFolder, True)
+            DeleteDirectory(CacheFolder, True)
             OpenExplorer(PackPath)
         End Sub) With {.ProgressWeight = 6})
 
@@ -709,12 +711,6 @@ Public Class PageVersionExport
         End If
     End Sub
 
-    '勾选 Modrinth 上传模式时,禁止打包 PCL
-    Private Sub CheckAdvancedModrinth_Change(sender As Object, user As Boolean) Handles CheckAdvancedModrinth.Change
-        If CheckAdvancedModrinth.Checked Then CheckOptionsPcl.Checked = False
-        CheckOptionsPcl.IsEnabled = Not CheckAdvancedModrinth.Checked
-    End Sub
-
     '勾选打包资源文件时,禁止开启 Modrinth 上传模式
     Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
         If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False

+ 2 - 2
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml

@@ -1,7 +1,7 @@
-<local:MyPageLeft x:Class="PageVersionLeft"
+<local:MyPageLeft x:Class="PageInstanceLeft"
              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}">
+             xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem">
     <StackPanel Margin="0,12,0,0" Name="PanItem">
         <local:MyListItem x:Name="ItemOverall" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="概览"
                           Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z" />

+ 25 - 25
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml.vb

@@ -1,13 +1,13 @@
-Public Class PageVersionLeft
+Public Class PageInstanceLeft
     Implements IRefreshable
 
     ''' <summary>
     ''' 当前显示设置的 MC 版本。
     ''' </summary>
-    Public Shared Version As McVersion = Nothing
+    Public Shared Instance As McInstance = Nothing
 
     Public Sub RefreshModDisabled() Handles Me.Loaded
-        If Version IsNot Nothing AndAlso Version.Modable Then
+        If Instance IsNot Nothing AndAlso Instance.Modable Then
             ItemMod.Visibility = Visibility.Visible
             ItemModDisabled.Visibility = Visibility.Collapsed
         Else
@@ -26,7 +26,7 @@
     ''' <summary>
     ''' 勾选事件改变页面。
     ''' </summary>
-    Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check
+    Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check
         '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
         '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
         If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -35,21 +35,21 @@
     Public Function PageGet(Optional ID As FormMain.PageSubType = -1)
         If ID = -1 Then ID = PageID
         Select Case ID
-            Case FormMain.PageSubType.VersionOverall
-                If FrmVersionOverall Is Nothing Then FrmVersionOverall = New PageVersionOverall
-                Return FrmVersionOverall
-            Case FormMain.PageSubType.VersionMod
-                If FrmVersionMod Is Nothing Then FrmVersionMod = New PageVersionMod
-                Return FrmVersionMod
-            Case FormMain.PageSubType.VersionModDisabled
-                If FrmVersionModDisabled Is Nothing Then FrmVersionModDisabled = New PageVersionModDisabled
-                Return FrmVersionModDisabled
-            Case FormMain.PageSubType.VersionSetup
-                If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
-                Return FrmVersionSetup
-            Case FormMain.PageSubType.VersionExport
-                If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport
-                Return FrmVersionExport
+            Case FormMain.PageSubType.InstanceOverall
+                If FrmInstanceOverall Is Nothing Then FrmInstanceOverall = New PageInstanceOverall
+                Return FrmInstanceOverall
+            Case FormMain.PageSubType.InstanceMod
+                If FrmInstanceMod Is Nothing Then FrmInstanceMod = New PageInstanceMod
+                Return FrmInstanceMod
+            Case FormMain.PageSubType.InstanceModDisabled
+                If FrmInstanceModDisabled Is Nothing Then FrmInstanceModDisabled = New PageInstanceModDisabled
+                Return FrmInstanceModDisabled
+            Case FormMain.PageSubType.InstanceSetup
+                If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
+                Return FrmInstanceSetup
+            Case FormMain.PageSubType.InstanceExport
+                If FrmInstanceExport Is Nothing Then FrmInstanceExport = New PageInstanceExport
+                Return FrmInstanceExport
             Case Else
                 Throw New Exception("未知的版本设置子页面种类:" & ID)
         End Select
@@ -99,19 +99,19 @@
     End Sub
     Public Sub Refresh(SubType As FormMain.PageSubType)
         Select Case SubType
-            Case FormMain.PageSubType.VersionMod
-                PageVersionMod.Refresh()
+            Case FormMain.PageSubType.InstanceMod
+                PageInstanceMod.Refresh()
                 ItemMod.Checked = True
-            Case FormMain.PageSubType.VersionExport
-                If FrmVersionExport IsNot Nothing Then FrmVersionExport.RefreshAll()
+            Case FormMain.PageSubType.InstanceExport
+                If FrmInstanceExport IsNot Nothing Then FrmInstanceExport.RefreshAll()
                 ItemExport.Checked = True
         End Select
     End Sub
 
     Public Sub Reset(sender As Object, e As EventArgs)
         If MyMsgBox("是否要初始化该版本的版本独立设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
-            If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
-            FrmVersionSetup.Reset()
+            If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
+            FrmInstanceSetup.Reset()
             ItemSetup.Checked = True
         End If
     End Sub

+ 2 - 4
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml

@@ -2,8 +2,8 @@
     xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 
-    mc:Ignorable="d" x:Class="PageVersionMod"
-    PanScroll="{Binding ElementName=PanBack}">
+    mc:Ignorable="d" x:Class="PageInstanceMod"
+    PanScroll="PanBack">
     <Grid>
         <Grid x:Name="PanAllBack">
             <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
@@ -22,7 +22,6 @@
                             <local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
                             <local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
                             <local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
-                            <local:MyButton x:Name="BtnManageCheck" Grid.Column="4" MinWidth="110" Text="检查 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
                         </Grid>
                     </local:MyCard>
                     <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
@@ -31,7 +30,6 @@
                             <local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
                             <local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
                             <local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
-                            <local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
                         </StackPanel>
                         <StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
                     </local:MyCard>

Некоторые файлы не были показаны из-за большого количества измененных файлов