2
0
Эх сурвалжийг харах

Merge branch 'main' into main

龙腾猫跃 3 сар өмнө
parent
commit
671cf8bdf5
100 өөрчлөгдсөн 5991 нэмэгдсэн , 8752 устгасан
  1. 20 1
      .editorconfig
  2. 1 1
      .github/FUNDING.yml
  3. 3 3
      .github/ISSUE_TEMPLATE/bug1.yml
  4. 1 1
      .github/ISSUE_TEMPLATE/bug2.yml
  5. 1 1
      .github/ISSUE_TEMPLATE/bug9.yml
  6. 2 2
      .github/ISSUE_TEMPLATE/ch.yml
  7. 3 3
      .github/ISSUE_TEMPLATE/config.yml
  8. 2 2
      .github/ISSUE_TEMPLATE/feature.yml
  9. 10 7
      .github/workflows/build.yml
  10. 3 0
      .gitmodules
  11. 30 14
      LICENCE
  12. 1 0
      MeloongCore
  13. 11 0
      PCLCS/Configs.cs
  14. 79 0
      PCLCS/Constants.cs
  15. 218 0
      PCLCS/Java.cs
  16. 68 0
      PCLCS/PCLCS.csproj
  17. 33 0
      PCLCS/Resource/Resource.cs
  18. 132 132
      PCLCS/Resource/WikiEntries.txt
  19. 83 0
      PCLCS/Resource/WikiEntry.cs
  20. 33 6
      Plain Craft Launcher 2.sln
  21. 6 9
      Plain Craft Launcher 2/App.config
  22. 14 20
      Plain Craft Launcher 2/Application.xaml
  23. 178 175
      Plain Craft Launcher 2/Application.xaml.vb
  24. 199 0
      Plain Craft Launcher 2/Controls/Behaviors/ClipboardInterceptor.vb
  25. 23 0
      Plain Craft Launcher 2/Controls/Behaviors/Interfaces.vb
  26. 46 0
      Plain Craft Launcher 2/Controls/Behaviors/LazyLoadBehavior.vb
  27. 0 4
      Plain Craft Launcher 2/Controls/IMyRadio.vb
  28. 1 1
      Plain Craft Launcher 2/Controls/MyButton.xaml
  29. 9 34
      Plain Craft Launcher 2/Controls/MyButton.xaml.vb
  30. 135 106
      Plain Craft Launcher 2/Controls/MyCard.vb
  31. 1 1
      Plain Craft Launcher 2/Controls/MyCheckBox.xaml
  32. 37 22
      Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
  33. 50 14
      Plain Craft Launcher 2/Controls/MyComboBox.vb
  34. 3 3
      Plain Craft Launcher 2/Controls/MyComboBoxItem.vb
  35. 66 41
      Plain Craft Launcher 2/Controls/MyDropShadow.vb
  36. 2 2
      Plain Craft Launcher 2/Controls/MyExtraButton.xaml
  37. 41 38
      Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb
  38. 2 2
      Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml
  39. 10 10
      Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb
  40. 5 13
      Plain Craft Launcher 2/Controls/MyHint.xaml
  41. 80 60
      Plain Craft Launcher 2/Controls/MyHint.xaml.vb
  42. 1 1
      Plain Craft Launcher 2/Controls/MyIconButton.xaml
  43. 37 53
      Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
  44. 1 1
      Plain Craft Launcher 2/Controls/MyIconTextButton.xaml
  45. 5 26
      Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
  46. 37 70
      Plain Craft Launcher 2/Controls/MyImage.vb
  47. 1 1
      Plain Craft Launcher 2/Controls/MyListItem.xaml
  48. 32 49
      Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
  49. 1 1
      Plain Craft Launcher 2/Controls/MyLoading.xaml
  50. 31 38
      Plain Craft Launcher 2/Controls/MyLoading.xaml.vb
  51. 8 3
      Plain Craft Launcher 2/Controls/MyMenuItem.vb
  52. 1 1
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
  53. 6 6
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb
  54. 1 1
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
  55. 9 7
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
  56. 1 1
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
  57. 7 7
      Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb
  58. 18 20
      Plain Craft Launcher 2/Controls/MyPageLeft.vb
  59. 103 52
      Plain Craft Launcher 2/Controls/MyPageRight.vb
  60. 1 1
      Plain Craft Launcher 2/Controls/MyRadioBox.xaml
  61. 63 50
      Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
  62. 1 1
      Plain Craft Launcher 2/Controls/MyRadioButton.xaml
  63. 15 19
      Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb
  64. 1 1
      Plain Craft Launcher 2/Controls/MyResizer.vb
  65. 2 2
      Plain Craft Launcher 2/Controls/MyScrollBar.vb
  66. 6 6
      Plain Craft Launcher 2/Controls/MyScrollViewer.vb
  67. 1 1
      Plain Craft Launcher 2/Controls/MySearchBox.xaml
  68. 4 1
      Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb
  69. 1 1
      Plain Craft Launcher 2/Controls/MySlider.xaml
  70. 32 13
      Plain Craft Launcher 2/Controls/MySlider.xaml.vb
  71. 1 1
      Plain Craft Launcher 2/Controls/MySliderDot.xaml
  72. 2 2
      Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb
  73. 37 9
      Plain Craft Launcher 2/Controls/MyTextBox.vb
  74. 18 41
      Plain Craft Launcher 2/Controls/MyTextButton.vb
  75. 70 0
      Plain Craft Launcher 2/Controls/MyVirtualizingElement.vb
  76. 11 12
      Plain Craft Launcher 2/FormMain.xaml
  77. 499 299
      Plain Craft Launcher 2/FormMain.xaml.vb
  78. 1 1
      Plain Craft Launcher 2/GlobalSuppressions.vb
  79. BIN
      Plain Craft Launcher 2/Images/Heads/ChongQing.png
  80. BIN
      Plain Craft Launcher 2/Images/Heads/EasyTier.png
  81. BIN
      Plain Craft Launcher 2/Images/Icons/Unavailable.png
  82. 0 0
      Plain Craft Launcher 2/Images/ReleaseTypes/Alpha.png
  83. 0 0
      Plain Craft Launcher 2/Images/ReleaseTypes/Beta.png
  84. 0 0
      Plain Craft Launcher 2/Images/ReleaseTypes/Release.png
  85. 138 75
      Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
  86. 229 1416
      Plain Craft Launcher 2/Modules/Base/ModBase.vb
  87. 213 121
      Plain Craft Launcher 2/Modules/Base/ModLoader.vb
  88. 334 405
      Plain Craft Launcher 2/Modules/Base/ModNet.vb
  89. 83 42
      Plain Craft Launcher 2/Modules/Base/ModValidate.vb
  90. 23 22
      Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
  91. 54 0
      Plain Craft Launcher 2/Modules/Base/PclLogger.vb
  92. 0 1660
      Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
  93. 254 243
      Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
  94. 287 257
      Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
  95. 507 703
      Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
  96. 311 280
      Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
  97. 493 397
      Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
  98. 0 1276
      Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
  99. 297 270
      Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
  100. 60 58
      Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb

+ 20 - 1
.editorconfig

@@ -1,4 +1,23 @@
-[*.{cs,vb}]
+# 如果要从更高级别的目录继承 .editorconfig 设置,请删除以下行
+root = true
+
+[*]
+charset = utf-8
+
+[*.cs]
+
+# IDE0320: 使匿名函数成为静态函数
+csharp_prefer_static_anonymous_function = false
+# CS8618: 在退出构造函数时,不可为 null 的字段必须包含非 null 值。请考虑添加 "required" 修饰符或声明为可为 null。
+dotnet_diagnostic.CS8618.severity = suggestion
+# IDE0305: 使用 [.. ] 简化集合初始化
+dotnet_diagnostic.IDE0305.severity = none
+# CS8524: switch 表达式不会处理其输入类型的某些值(它不是穷举),这包括未命名的枚举值。
+dotnet_diagnostic.CS8524.severity = suggestion
+
+[*.{cs,vb}]
 
 # IDE0028: 简化集合初始化
 dotnet_style_collection_initializer = true:silent
+# IDE0130: 命名空间与文件夹结构不匹配
+dotnet_diagnostic.IDE0130.severity = silent

+ 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']

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

@@ -8,11 +8,11 @@ body:
     label: "检查项"
     description: "请逐个检查下列项目,并勾选确认。"
     options:
-    - label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃基本不是 PCL 的原因,请 **不要** 提交反馈。你可以在论坛或社区找人求助,但这里并不是你求助的地方。"
+    - label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的崩溃基本不是 PCL 导致的,请 **不要** 提交反馈。你可以前往 [PCL 汉医堂](https://qm.qq.com/q/JJTzwEAmcw) 等民间 QQ 群求助,但这里不是求助的地方……"
       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"
@@ -36,4 +36,4 @@ body:
     description: "在 HMCL 中进入版本列表,点击版本右侧的三个点,选择 生成启动脚本。"
     placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
   validations:
-    required: false
+    required: false

+ 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

+ 10 - 7
.github/workflows/build.yml

@@ -21,9 +21,10 @@ jobs:
     steps:
 
     - name: Checkout
-      uses: actions/checkout@v4
+      uses: actions/checkout@v6
       with:
-        fetch-depth: 0
+        fetch-depth: 1
+        submodules: true
 
     - name: Set Describe
       shell: bash
@@ -32,13 +33,12 @@ jobs:
           echo "describe=$describe" >> $GITHUB_ENV
 
     - name: Setup MSBuild.exe
-      uses: microsoft/setup-msbuild@v2
+      uses: microsoft/setup-msbuild@v3
       with:
         msbuild-architecture: x64
     
     - name: Update Help
       run:  |
-        $workpath = [System.Environment]::CurrentDirectory
         Set-Location ..
         git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
         Set-Location PCL2Help
@@ -52,15 +52,18 @@ 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: Restore NuGet Packages
+      run: dotnet restore PCLCS\PCLCS.csproj
+
     - name: Build
       run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }}
 
     - name: Upload a Build Artifact
-      uses: actions/upload-artifact@v4
+      uses: actions/upload-artifact@v7
       with:
         name: ${{ matrix.configuration }} ${{ env.describe }}
         path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe

+ 3 - 0
.gitmodules

@@ -0,0 +1,3 @@
+[submodule "MeloongCore"]
+	path = MeloongCore
+	url = https://github.com/Meloong-Git/MeloongCore.git

+ 30 - 14
LICENCE

@@ -1,11 +1,30 @@
-一、声明
+《PCL 分发有限许可》
 
-本文件仅作为指南,不是法律文件或协议。但开发者在此承诺,在您遵守本指南且善意、合理使用的情况下,不会追究您的责任。
-法律上,开发者仍保留所有权利(All Rights Reserved),若情况恶劣,仍可能将诉讼作为最终手段。
+版权所有 © 成都瓜皮龙科技有限公司(以下简称 “许可方”)。
+除本许可明确授予的权利外,许可方保留软件及其相关知识产权中的全部权利。
 
+一、定义
 
+“软件” 是指 Plain Craft Launcher(以下简称 “PCL”)及许可方有权许可的相关源代码、二进制文件、资源文件、文档和随附内容。软件不包括已明确标注为第三方内容的部分,本许可亦不限制第三方内容原有许可证所明确授予的权利。
+“原样副本” 是指未经任何方式改变的软件副本。传输、存储、镜像、压缩或解压原样副本,不视为改变。
+“以软件为收费主体” 是指以获得、下载、复制、分发、安装、预装或使用原样副本本身为主要对价或条件,直接或间接向接收者收取费用,包括但不限于付费下载、会员访问门槛、强制赞助或其他变相收费方式。
+- 若软件仅作为其他相对于软件具有完全独立的价值的内容、产品或服务的附带组成部分,且收费主要针对该内容、产品或服务,则不视为以软件为收费主体。
+- 承载平台通过一般广告、一般赞助、平台服务或其他独立业务取得收入,则不视为以软件为收费主体。
 
-二、轻度使用
+二、权利
+
+本许可适用于对软件进行复制、分发或其他被明确授权的行为。您行使本许可明确授予的任何权利,即表示同意遵守本许可。
+在不以软件为收费主体的前提下,许可方授予您一项全球范围内、非排他、免版税、不得再许可的有限许可:您可以存储、镜像、备份、上传、下载、向公众提供、传播和再分发原样副本。
+每一位从您处获得原样副本的接收者,均可在遵守本许可的前提下,直接从许可方获得本许可明确授予的相应权利。
+
+————————————————————————————————————
+
+《PCL 存储库合理使用指南》
+
+本指南仅作为说明,不是法律文件或协议。
+除《PCL 分发有限许可》明确授予的权利外,开发者保留软件及其相关知识产权中的全部权利。但开发者承诺,在遵守本指南,且善意、合理使用的情况下,不会追究责任。
+
+一、轻度使用
 
 若您仅参考了本存储库中极小部分的内容,或您在制作与 PCL 的实质功能不存在任何重叠的软件,则为轻度使用。
 其常见情形例如:
@@ -15,11 +34,9 @@
 若属于轻度使用,您需要:
 1、以适当的形式给出署名。
 2、不得将您的内容与 PCL 混淆,或暗示您的内容与 PCL 有关。
-  例如:您的内容不得使用 Planting Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
-
-
+  例如:您的内容不得使用 Potato Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
 
-三、重度使用
+二、重度使用
 
 若不符合轻度使用的情形,即为重度使用。
 其常见情形例如:
@@ -31,19 +48,18 @@
 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 的赞助解锁功能类似的功能或表现。
   例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
 
-————————————
+————————————————————————————————————
 
 说人话的备注:
 
-因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
-这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
+这些规则主要是为了阻止恶意的使用、倒卖和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
 
 如果你只是参考了一小段代码,署个名就行啦,不用担心。
-如果对具体细节有疑问,欢迎在 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 发帖!
 
 多谢大家啦!

+ 1 - 0
MeloongCore

@@ -0,0 +1 @@
+Subproject commit e5c8e65e2b4c4c7de5a6a6f56508edf2c0175aff

+ 11 - 0
PCLCS/Configs.cs

@@ -0,0 +1,11 @@
+namespace PCLCS;
+public static class Configs {
+
+    /// <summary>当前 Java 相关配置的版本。0 代表尚未从老的 Settings 系统中迁移。</summary>
+    public static readonly ConfigEntry<int> JavaConfigVersion = new(nameof(JavaConfigVersion), 0);
+    public static readonly ConfigEntry<ConcurrentList<Java>> JavaList = new(nameof(JavaList), []);
+    public static readonly ConfigEntry<List<string>> JavaRemovedList = new(nameof(JavaRemovedList), []);
+    public static readonly ConfigEntry<bool> InstanceMigratedJava = new(nameof(InstanceMigratedJava), false);
+    public static readonly ConfigEntry<Java> InstanceForcedJava = new(nameof(InstanceForcedJava), null);
+
+}

+ 79 - 0
PCLCS/Constants.cs

@@ -0,0 +1,79 @@
+namespace PCLCS;
+
+/// <summary>
+/// 社区资源的类型。
+/// </summary>
+[Flags]
+public enum ResourceTypes {
+    /// <summary>Mod。</summary>
+    Mod = 1,
+    /// <summary>整合包。</summary>
+    ModPack = 2,
+    /// <summary>资源包。</summary>
+    ResourcePack = 4,
+    /// <summary>光影包。</summary>
+    Shader = 8,
+    /// <summary>数据包。</summary>
+    DataPack = 16,
+    /// <summary>服务端插件。</summary>
+    Plugin = 32,
+    /// <summary>同时包含数据包以及 Mod。</summary>
+    ModOrDataPack = Mod | DataPack,
+    /// <summary>允许任意种类,或种类未知。</summary>
+    Any = Mod | ModPack | ResourcePack | Shader | DataPack | Plugin,
+}
+
+/// <summary>
+/// 社区资源的来源平台。
+/// </summary>
+[Flags]
+public enum ResourcePlatforms {
+    CurseForge = 1,
+    Modrinth = 2,
+    Any = CurseForge | Modrinth,
+}
+
+/// <summary>
+/// Mod 加载器的类型。
+/// </summary>
+[Flags]
+public enum ModLoaders {
+    None = 0,
+    Forge = 1,
+    LiteLoader = 2,
+    Fabric = 4,
+    Quilt = 8,
+    NeoForge = 16,
+    All = Forge | LiteLoader | Fabric | Quilt | NeoForge,
+}
+
+/// <summary>
+/// 在爱发电中的赞助等级。
+/// </summary>
+public enum DonationRank {
+    None = 0,
+    Rank6 = 6,
+    Rank12 = 12,
+    Rank23 = 23,
+    Rank54 = 54,
+    Rank98 = 98,
+}
+
+public static class Versions {
+    /// <summary>
+    /// 土豆码版本号。
+    /// </summary>
+    public const char PotatoVersion = '1';
+    /// <summary>
+    /// 版本管理中 Mod 信息缓存的版本号。
+    /// </summary>
+    public const int LocalModCacheVersion = 17;
+    /// <summary>
+    /// Minecraft 本地实例信息缓存的版本号。
+    /// </summary>
+    public const int McInstanceCacheVersion = 38;
+    /// <summary>
+    /// Java 相关配置的版本号。
+    /// </summary>
+    public const int JavaConfigVersion = 1;
+}

+ 218 - 0
PCLCS/Java.cs

@@ -0,0 +1,218 @@
+namespace PCLCS;
+
+/// <summary>
+/// 单个 Java 的实例。
+/// </summary>
+[Serializable] public class Java(string folder, Version? version = null) : IEquatable<Java> {
+
+    /// <summary>
+    /// java.exe 文件所在的文件夹路径,这通常是 bin 文件夹。以 \ 结尾。
+    /// </summary>
+    public readonly string Folder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(folder));
+    /// <summary>
+    /// java.exe 文件的完整路径。
+    /// </summary>
+    [JsonIgnore] public string JavaExePath => Path.Combine(Folder, "java.exe");
+
+    /// <summary>
+    /// Java 的版本号(例如 16.0.1),保证 <see cref="Version.Major"/> 为其主版本。
+    /// <para/> 若为 null,则还需要调用 <see cref="CheckAsync"/> 以获取版本号。
+    /// </summary>
+    public Version? Version = version;
+
+    /// <summary>
+    /// 检查该 Java 是否存在问题,并获取其版本号。
+    /// 返回其是否通过了检查。
+    /// </summary>
+    public async Task<bool> CheckAsync(CancellationToken cancellationToken = default) {
+        if (Interlocked.Exchange(ref isChecked, 1) == 1 && available != null) return available!.Value; // 已检查过
+        string? output = null;
+        try {
+            if (!FileUtils.Exists(JavaExePath)) throw new FileNotFoundException("未找到 java.exe 文件", JavaExePath);
+
+            // 运行 -version
+            output = (await TaskUtils.RunProgramAsync(JavaExePath, "-version", 15000, cancellationToken: cancellationToken).NoCapture()).Output.Lower();
+            if (output == "") throw new InvalidOperationException("尝试运行该 Java 失败");
+            Logger.Trace($"Java 检查输出:{JavaExePath}{Environment.NewLine}{output}");
+            if (output.Contains("/lib/ext exists")) throw new InvalidOperationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试");
+            if (output.Contains("a fatal error") || output.Contains("error: ")) throw new InvalidOperationException("无法运行该 Java,该 Java 或系统存在问题");
+
+            // 获取版本号
+            var versionString = (output.RegexSeek(@"(?<=version "")[^""]+") ?? output.RegexSeek("(?<=openjdk )[0-9]+"))?.Replace("_", ".").Replace("+", ".").BeforeFirst("-");
+            if (string.IsNullOrEmpty(versionString)) throw new InvalidOperationException($"未找到该 Java 的版本号{(output.Length < 500 ? $"\n原始输出为:\n{output}" : "")}");
+            if (versionString.StartsWithF("1.")) versionString = versionString!.AfterFirst("."); // 去除开头的 1.
+            var segments = versionString!.Split(".", true).ToList();
+            while (segments.Count < 4) segments.Add("0");
+            Version = new Version(segments.Take(4).Join("."));
+            if (Version.Major is <= 4 or >= 100) throw new InvalidOperationException($"分析详细信息失败,获取的版本为 {Version}{(output.Length < 500 ? $"\n原始输出为:\n{output}" : "")}");
+
+            if (!output.Contains("64-bit")) throw new InvalidOperationException("该 Java 为 32 位版本,请安装 64 位的 Java");
+            Logger.Info($"检查 Java 成功:{this}");
+            available = true;
+        } catch (Exception ex) {
+            if (ex.IsCanceled()) {
+                isChecked = 0;
+                throw;
+            }
+            Logger.Warn($"检查 Java 失败({JavaExePath}),其输出为:\n{output ?? "无程序输出"}");
+            available = false;
+        }
+        return available!.Value;
+    }
+    [JsonIgnore] private int isChecked = 0;
+    /// <summary>若已进行过检查,表示该检查是否成功。若未检查,则为 null。</summary>
+    [JsonIgnore] internal bool? available = null;
+
+    // 相同检查
+    public bool Equals(Java? other)
+        => other is not null && string.Equals(Folder, other.Folder, StringComparison.OrdinalIgnoreCase);
+    public override bool Equals(object? obj) => obj is Java other && Equals(other);
+    public override int GetHashCode() => StringComparer.OrdinalIgnoreCase.GetHashCode(Folder);
+
+    /// <summary>用户友好的描述文本。</summary>
+    public override string ToString()
+        => $"Java {Version?.Major.ToString() ?? "尚未检查"} ({Version}):{Folder}";
+}
+
+public static class JavaUtils {
+
+    /// <summary>
+    /// 检查所有指定的 Java 是否存在问题,并获取其版本号。
+    /// </summary>
+    /// <returns>所有通过检查的 Java。</returns>
+    public static async Task<List<Java>> CheckAllAsync(IEnumerable<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
+        await TaskUtils.WhenAll(javas.Where(j => j.available == null).Select(
+            async java => await java.CheckAsync(cancellationToken).NoCapture()
+        ), progress).NoCapture();
+        return javas.Where(j => j.available == true).ToList();
+    }
+
+    /// <summary>
+    /// 将 Java 列表进行排序。
+    /// 这同时会检查所有未检查的 Java。
+    /// </summary>
+    public static async Task<List<Java>> SortAsync(List<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
+        javas = await JavaUtils.CheckAllAsync(javas, cancellationToken, progress).NoCapture();
+        javas.Sort((left, right) => {
+            // 优先使用带完整 Java 的文件夹列表中的 Java
+            var isLeftInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, left.Folder));
+            var isRightInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, right.Folder));
+            if (isLeftInCandidateFolder != isRightInCandidateFolder) return isLeftInCandidateFolder ? -1 : 1;
+            // 其次优先使用主版本号接近 21 的 Java
+            var leftDistance = left.Version is null ? int.MaxValue : Math.Abs(left.Version.Major - 21);
+            var rightDistance = right.Version is null ? int.MaxValue : Math.Abs(right.Version.Major - 21);
+            return leftDistance.CompareTo(rightDistance);
+        });
+        return javas;
+    }
+
+    #region 搜索
+
+    /// <summary>
+    /// 存在完整 Java 的文件夹列表。
+    /// </summary>
+    internal static readonly List<string> CandidateFolders = [
+        Paths.AppData + @".minecraft\runtime\", // 这也是 PCL 下载 Java 的路径
+        Paths.AppData + @".hmcl\java\",
+        Paths.AppData + @"ATLauncher\runtimes\minecraft\",
+        Paths.AppData + @"ModrinthApp\meta\java_versions\",
+        Paths.AppData + @"PrismLauncher\java\",
+        Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\curseforge\minecraft\Install\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.jdks\",
+        Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.sdkman\candidates\java\",
+        Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\.ftba\bin\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\Packages\Microsoft.4297127D64EC6_8wekyb3d8bbwe\LocalCache\Local\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft Launcher\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) + @"\Curse\Minecraft\Install\runtime\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Java\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Eclipse Adoptium\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Amazon Corretto\",
+        Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Zulu\",
+        ..DirectoryUtils.EnumerateDirectories(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Microsoft\", searchPattern: "jdk-*"),
+        // 环境变量
+        ..(Environment.GetEnvironmentVariable("JDK_HOME") + ";" + Environment.GetEnvironmentVariable("JAVA_HOME")).
+            Split(";", true).Select(path => path.Trim(' ', '"'))
+    ];
+
+    /// <summary>
+    /// 从常见文件夹和环境变量中搜索 Java,并将搜索结果写入设置。
+    /// </summary>
+    public static async Task RefreshListAsync(CancellationToken c = default, ProgressProvider? p = null) {
+        // 搜索
+        List<Java> javaList = await SearchFoldersAsync(true, CandidateFolders, c, p?.SplitTo(0.5)).NoCapture();
+        // 将新发现的 Java 排在最前,原有列表保留既有顺序排在后面
+        var oldJavaList = Configs.JavaList.Get()!;
+        oldJavaList = await JavaUtils.CheckAllAsync(oldJavaList, c, p?.SplitTo(0.9)).NoCapture(); // 检查原有列表中的 Java
+        javaList.RemoveAll(oldJavaList); // 此时 javaList 中只剩下新发现的 Java
+        javaList = await JavaUtils.SortAsync(javaList, c).NoCapture(); // 将所有新发现的 Java 按优先级排序
+        javaList.AddRange(oldJavaList);
+        javaList = javaList.Distinct().ToList();
+        // 删掉已被移除的 Java
+        javaList.RemoveIf(j => Configs.JavaRemovedList.Get()!.Contains(j.Folder, StringComparer.OrdinalIgnoreCase));
+        // 写入设置
+        Configs.JavaList.Set([..javaList]);
+        Logger.Info($"Java 搜索完成,发现 {javaList.Count} 个 Java");
+    }
+
+    /// <summary>
+    /// 并行搜索所有指定的文件夹及其子文件夹中的 Java,并检查其有效性。
+    /// </summary>
+    public static async Task<List<Java>> SearchFoldersAsync(bool includeSubDirectories, IEnumerable<string> folders, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
+        // 并行搜索
+        ConcurrentBag<(string Folder, bool HasReparsePoint, bool IsSpecialPath)> results = [];
+        await TaskUtils.ForEachAsync(folders.Distinct(StringComparer.OrdinalIgnoreCase), 4, async (folder, cp) => {
+            await Task.Run(() => {
+                try {
+                    foreach (var file in DirectoryUtils.EnumerateFiles(folder, includeSubDirectories, "java.exe")) {
+                        cancellationToken.ThrowIfCancellationRequested();
+                        string targetFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(PathUtils.RemoveLastPart(file)));
+                        // 判断文件夹是否包含重解析点(例如符号链接)
+                        static bool HasReparsePoint(FileSystemInfo info) {
+                            do {
+                                if (info.Attributes.HasFlag(FileAttributes.ReparsePoint)) return true;
+                                info = info is FileInfo fileInfo ? fileInfo.Directory : ((DirectoryInfo) info).Parent;
+                            } while (info is not null);
+                            return false;
+                        }
+                        // 结果
+                        var hasReparsePoint = HasReparsePoint(FileUtils.GetInfo(Path.Combine(targetFolder, "java.exe")));
+                        var isSpecialPath = targetFolder.Contains("java8path_target_") || targetFolder.Contains("javapath_target_") || targetFolder.Contains("javatmp") || targetFolder.Contains("system32");
+                        results.Add((targetFolder, hasReparsePoint, isSpecialPath));
+                    }
+                } catch (UnauthorizedAccessException) {
+                    Logger.Info($"快速查找 Java 时没有权限({folder})");
+                } catch (Exception ex) {
+                    ex.ThrowIfCanceled();
+                    Logger.Warn(ex, $"快速查找 Java 时出错({folder})");
+                }
+            }, cancellationToken).NoCapture();
+        }, cancellationToken, progress?.SplitTo(0.2)).NoCapture();
+        if (!results.Any()) return [];
+
+        // 筛除重解析点
+        if (results.All(r => r.HasReparsePoint)) {
+            Logger.Warn("找到的所有 Java 都包含重解析点,保留全部结果");
+        } else if (results.Any(r => r.HasReparsePoint)) {
+            Logger.Info($"找到以下的 Java 包含重解析点,将它们从列表中排除:{results.Where(r => r.HasReparsePoint).Select(r => r.Folder).Join('、')}");
+            results = [..results.Where(r => !r.HasReparsePoint)];
+        }
+        // 筛除特殊路径
+        if (results.All(r => r.IsSpecialPath)) {
+            Logger.Warn("找到的所有 Java 都包含特殊路径,保留全部结果");
+        } else if (results.Any(r => r.IsSpecialPath)) {
+            Logger.Info($"找到以下的 Java 包含特殊路径,将它们从列表中排除:{results.Where(r => r.IsSpecialPath).Select(r => r.Folder).Join('、')}");
+            results = [..results.Where(r => !r.IsSpecialPath)];
+        }
+
+        // 检查并返回
+        List<Java> javaList = results.Select(r => r.Folder).Distinct(StringComparer.OrdinalIgnoreCase).Select(folder => new Java(folder)).ToList();
+        javaList = (await JavaUtils.CheckAllAsync(javaList, cancellationToken, progress?.SplitTo(1)).NoCapture()).ToList();
+        javaList = await JavaUtils.SortAsync(javaList, cancellationToken).NoCapture();
+        Logger.Info($"快速查找 Java 完成,共有 {javaList.Count} 个候选:{javaList.Join('、')}");
+        return javaList;
+    }
+
+    #endregion
+
+}

+ 68 - 0
PCLCS/PCLCS.csproj

@@ -0,0 +1,68 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+	<PropertyGroup>
+		<TargetFramework>net48</TargetFramework>
+		<OutputType>Library</OutputType>
+		<AllowUnsafeBlocks>True</AllowUnsafeBlocks>
+		<OutDir>bin\</OutDir>
+		<AppendTargetFrameworkToOutputPath>false</AppendTargetFrameworkToOutputPath>
+		<AppendRuntimeIdentifierToOutputPath>false</AppendRuntimeIdentifierToOutputPath>
+		<Configurations>Debug;Release;Snapshot</Configurations>
+		<Deterministic>true</Deterministic>
+		<LangVersion>13.0</LangVersion>
+		<Nullable>enable</Nullable>
+		<ImplicitUsings>enable</ImplicitUsings>
+	</PropertyGroup>
+
+	<ItemGroup>
+		<PackageReference Include="PolySharp" Version="1.15.0">
+			<PrivateAssets>all</PrivateAssets>
+			<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
+		</PackageReference>
+	</ItemGroup>
+
+	<ItemGroup>
+		<Using Include="System.Diagnostics.CodeAnalysis" />
+		<Using Include="System.Collections" />
+		<Using Include="System.Collections.Generic" />
+		<Using Include="System.Collections.Concurrent" />
+		<Using Include="System.Text" />
+		<Using Include="System.Net" />
+		<Using Include="System.Runtime.CompilerServices" />
+		<Using Include="System.Runtime.InteropServices" />
+		<Using Include="Newtonsoft.Json" />
+		<Using Include="Newtonsoft.Json.Linq" />
+		<Using Include="MeloongCore" />
+		<Using Include="MeloongCore.Extensions" />
+		<Using Include="MeloongCore.Wpf" />
+		<Using Include="MeloongCore.Wpf.Extensions" />
+	</ItemGroup>
+
+	<ItemGroup>
+	  <ProjectReference Include="..\MeloongCore\Shared\MeloongCore.csproj" />
+	  <ProjectReference Include="..\MeloongCore\Wpf\MeloongCore.Wpf.csproj" />
+	</ItemGroup>
+
+	<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'">
+		<DefineConstants>$(DefineConstants);SNAPSHOT</DefineConstants>
+	</PropertyGroup>
+
+	<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|AnyCPU'" />
+
+	<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Snapshot|AnyCPU'">
+		<Optimize>True</Optimize>
+	</PropertyGroup>
+
+	<!-- 内嵌的资源 -->
+	<ItemGroup>
+		<None Remove="Resource\WikiEntries.txt" />
+		<EmbeddedResource Include="Resource\WikiEntries.txt" LogicalName="Resource\WikiEntries.txt" />
+	</ItemGroup>
+	<ItemGroup>
+	  <Reference Include="Microsoft.VisualBasic" />
+	  <Reference Include="Newtonsoft.Json">
+	    <HintPath>..\Plain Craft Launcher 2\Resources\Newtonsoft.Json.dll</HintPath>
+	  </Reference>
+	</ItemGroup>
+
+</Project>

+ 33 - 0
PCLCS/Resource/Resource.cs

@@ -0,0 +1,33 @@
+namespace PCLCS;
+public static class Resource {
+
+    /// <summary>
+    /// 将 CurseForge 的 ModLoaderType 映射为 <see cref="ModLoaders"/> 枚举。
+    /// </summary>
+    public static ModLoaders FromCurseForgeModLoaderType(int modLoaderType) => modLoaderType switch {
+        // https://docs.curseforge.com/rest-api/#tocS_ModLoaderType
+        1 => ModLoaders.Forge,
+        3 => ModLoaders.LiteLoader,
+        4 => ModLoaders.Fabric,
+        5 => ModLoaders.Quilt,
+        6 => ModLoaders.NeoForge,
+        _ => ModLoaders.None,
+    };
+
+    /// <summary>
+    /// 将 <see cref="ModLoaders"/> 映射为 CurseForge 的单一 ModLoaderType。
+    /// </summary>
+    public static int ToCurseForgeModLoaderType(ModLoaders loaders) {
+        if (loaders == ModLoaders.None) return 0;
+        if (!loaders.Flags().IsSingle()) throw new ArgumentException($"传入的枚举值 {loaders} 并非单个 Mod Loader", nameof(loaders));
+        return loaders switch {
+            ModLoaders.Forge => 1,
+            ModLoaders.LiteLoader => 3,
+            ModLoaders.Fabric => 4,
+            ModLoaders.Quilt => 5,
+            ModLoaders.NeoForge => 6,
+            _ => 0,
+        };
+    }
+
+}

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 132 - 132
PCLCS/Resource/WikiEntries.txt


+ 83 - 0
PCLCS/Resource/WikiEntry.cs

@@ -0,0 +1,83 @@
+namespace PCLCS;
+
+/// <summary>
+/// MC 百科条目。
+/// <para/>使用 <see cref="WikiEntry.All"/> 获取所有条目。
+/// </summary>
+public class WikiEntry {
+
+    /// <summary>
+    /// 在 MC 百科中的对应 ID。
+    /// </summary>
+    public int Id;
+    /// <summary>
+    /// 中文译名。
+    /// <c>null</c> 代表没有翻译。
+    /// </summary>
+    public string? ChineseName;
+    /// <summary>
+    /// 各个 Mod 平台的 Slug(例如 advanced-solar-panels)。
+    /// 若没有对应键则为不在该平台上。
+    /// </summary>
+    public Dictionary<ResourcePlatforms, string> Slugs = [];
+    /// <summary>
+    /// MC 百科的浏览量逆序排行,1 代表浏览量最低。
+    /// </summary>
+    public int Popularity;
+
+    /// <summary>
+    /// 内置数据库中的所有 MC 百科条目。
+    /// </summary>
+    public static readonly Lazy<List<WikiEntry>> All = new(() => {
+        var dataLines = FileUtils.ReadAsLines(@"Resource\WikiEntries.txt", type: typeof(WikiEntry)).ToList();
+
+        // 读取最后一行的浏览量
+        Queue<int> popularities = [];
+        for (int i = 0; i < dataLines[^1].Length; i += 3) { // 将每 3 个字符切割成一个元素
+            popularities.Enqueue(int.Parse(dataLines[^1].Substring(i, 3).ConvertRadix(86, 10)));
+        }
+        dataLines.RemoveAt(dataLines.Count - 1);
+
+        // 解析每一行
+        List<WikiEntry> results = [];
+        var lineNumber = 0;
+        foreach (var lineData in dataLines) {
+            lineNumber++;
+            if (lineData == "") continue;
+
+            var popularity = popularities.Dequeue();
+            foreach (var entryData in lineData.Split('¨')) {
+                var entry = new WikiEntry();
+                var parts = entryData.Split('|');
+                var slugs = parts[0];
+                if (slugs.StartsWithF("@")) {
+                    entry.Slugs.Add(ResourcePlatforms.Modrinth, slugs.Replace("@", ""));
+                } else if (slugs.EndsWithF("@")) {
+                    entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs.TrimEnd('@'));
+                    entry.Slugs.Add(ResourcePlatforms.Modrinth, entry.Slugs[ResourcePlatforms.CurseForge]);
+                } else if (slugs.Contains("@")) {
+                    var splitSlugs = slugs.Split('@');
+                    entry.Slugs.Add(ResourcePlatforms.CurseForge, splitSlugs[0]);
+                    entry.Slugs.Add(ResourcePlatforms.Modrinth, splitSlugs[1]);
+                } else {
+                    entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs);
+                }
+
+                entry.Id = lineNumber;
+                entry.Popularity = popularity;
+                if (parts.Length >= 2) {
+                    entry.ChineseName = parts[^1]; // 最后一项
+                    if (entry.ChineseName.Contains("*")) { // 处理 *
+                        var englishName = entry.Slugs.Values.First().Replace("-", " ").Capitalize();
+                        entry.ChineseName = entry.ChineseName.Replace("*", $" ({englishName})");
+                    }
+                }
+                results.Add(entry);
+            }
+        }
+        return results;
+    });
+
+    public override string ToString()
+        => $"{Slugs.GetOrDefault(ResourcePlatforms.CurseForge)}&{Slugs.GetOrDefault(ResourcePlatforms.Modrinth)}|{Id}|{ChineseName},浏览量 {Popularity}";
+}

+ 33 - 6
Plain Craft Launcher 2.sln

@@ -5,22 +5,49 @@ VisualStudioVersion = 17.2.32616.157
 MinimumVisualStudioVersion = 10.0.40219.1
 Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
 EndProject
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "PCLCS", "PCLCS\PCLCS.csproj", "{32DE4AAF-F4D6-42C5-9604-19236DE96C69}"
+EndProject
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore", "MeloongCore\Shared\MeloongCore.csproj", "{D22BBF3C-2177-0208-4E29-8466AA41AC6F}"
+EndProject
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore.Wpf", "MeloongCore\Wpf\MeloongCore.Wpf.csproj", "{2DFFE2A0-1101-816B-D240-F644B2D74A68}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
-		Beta|Any CPU = Beta|Any CPU
 		Debug|Any CPU = Debug|Any CPU
 		Release|Any CPU = Release|Any CPU
-		ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
+		Snapshot|Any CPU = Snapshot|Any CPU
 	EndGlobalSection
 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
-		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
-		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
 		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
 		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
-		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
-		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
+		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
+		{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.Build.0 = Release|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
+		{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.ActiveCfg = Debug|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.Build.0 = Debug|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.ActiveCfg = Debug|Any CPU
+		{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.Build.0 = Debug|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.Build.0 = Release|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
+		{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.Build.0 = Release|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
+		{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE

+ 6 - 9
Plain Craft Launcher 2/App.config

@@ -5,13 +5,10 @@
             <httpWebRequest useUnsafeHeaderParsing="true"/>
         </settings>
     </system.net>
-    <startup> 
-        <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
+    <startup>
+		<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
     </startup>
     <runtime>
-		<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
-        <AppContextSwitchOverrides value="Switch.System.Windows.DoNotScaleForDpiChanges=false"/> <!-- #5337 -->
-		<AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" /> <!-- 长路径支持 -->
         <generatePublisherEvidence enabled="false"/>
         <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
             <dependentAssembly>
@@ -26,10 +23,10 @@
                   <assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
                   <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
             </dependentAssembly>
-            <dependentAssembly>
-                  <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>

+ 14 - 20
Plain Craft Launcher 2/Application.xaml

@@ -1,24 +1,21 @@
-<Application x:Class="Application"
+<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:core="clr-namespace:MeloongCore;assembly=MeloongCore"
+    xmlns:corewpf="clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"
     xmlns:sys="clr-namespace:System;assembly=mscorlib"
     StartupUri="FormMain.xaml"
     ShutdownMode="OnExplicitShutdown">
     <Application.Resources>
         <ResourceDictionary>
             
-            <!-- 本地化 -->
-            <ResourceDictionary.MergedDictionaries>
-                <ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
-                <ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
-            </ResourceDictionary.MergedDictionaries>
-            
             <!-- Converter -->
-            <local:AdditionConverter x:Key="AdditionConverter"/>
-            <local:MultiplicationConverter x:Key="MultiplicationConverter"/>
-            <local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
-            <local:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
+            <corewpf:AdditionConverter x:Key="AdditionConverter"/>
+            <corewpf:MultiplicationConverter x:Key="MultiplicationConverter"/>
+            <corewpf:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
+            <corewpf:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
             <BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
 
             <!-- 颜色表 -->
@@ -66,7 +63,7 @@
             <SolidColorBrush x:Key="ColorBrushWhite" Color="#ffffff" />
             <SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
             <SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
-            <SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
+            <SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#F1FFFFFF" />
 
             <!-- Window -->
             <Style TargetType="{x:Type Window}" x:Key="MyWindow">
@@ -229,7 +226,7 @@
                     </Setter.Value>
                 </Setter>
             </Style>
-            <Style TargetType="local:PageComp" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
+            <Style TargetType="local:PageResource" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
             <Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
                 <Setter Property="OverridesDefaultStyle" Value="True" />
                 <Setter Property="CanContentScroll" Value="False" />
@@ -294,7 +291,7 @@
                 <Setter Property="Template">
                     <Setter.Value>
                         <ControlTemplate TargetType="local:MyTextBox">
-                            <Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
+                            <Grid SnapsToDevicePixels="True">
                                 <Grid.RowDefinitions>
                                     <RowDefinition MinHeight="28" />
                                     <RowDefinition Height="Auto" />
@@ -312,6 +309,7 @@
                         </ControlTemplate>
                     </Setter.Value>
                 </Setter>
+                <Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
             </Style>
             <Style TargetType="PasswordBox">
                 <Setter Property="FontSize" Value="13" />
@@ -353,6 +351,7 @@
                         </ControlTemplate>
                     </Setter.Value>
                 </Setter>
+                <Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
             </Style>
 
             <!-- ComboBox -->
@@ -372,7 +371,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">
@@ -478,11 +477,6 @@
             </Style>
             <Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
                 <Setter Property="OverridesDefaultStyle" Value="True" />
-                <Setter Property="ToolTipService.Placement" Value="Relative" />
-                <Setter Property="ToolTipService.VerticalOffset" Value="-2" />
-                <Setter Property="ToolTipService.HorizontalOffset" Value="200" />
-                <Setter Property="ToolTipService.InitialShowDelay" Value="150" />
-                <Setter Property="ToolTipService.BetweenShowDelay" Value="150" />
                 <Setter Property="FocusVisualStyle" Value="{x:Null}" />
                 <Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" />
                 <Setter Property="Template">

+ 178 - 175
Plain Craft Launcher 2/Application.xaml.vb

@@ -1,25 +1,41 @@
-Imports System.Reflection
+Imports System.Reflection
 Imports System.Windows.Threading
+Imports Microsoft.Win32
 
 Public Class Application
 
-#If DEBUG Then
-    ''' <summary>
-    ''' 用于开始程序时的一些测试。
-    ''' </summary>
-    Private Sub Test()
-        Try
-            ModDevelop.Start()
-        Catch ex As Exception
-            Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
-        End Try
-    End Sub
-#End If
-
     '开始
     Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
         Try
-            SecretOnApplicationStart()
+            '核心初始化
+            MeloongCore.Main.Init("PCL")
+            MeloongCore.Wpf.Main.Init()
+            Logger.Instance = New PclLogger With {.logFolder = Paths.BaseThenName, .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)}
+            '提升主线程优先级
+            Thread.CurrentThread.Priority = ThreadPriority.Highest
+            '执行开发版测试
+            If BuildType = BuildTypes.Debug Then
+                Try
+                    ModDevelop.Start()
+                Catch ex As Exception
+                    Logger.Error(ex, "开发者模式测试出错", LogBehavior.Alert)
+                End Try
+            End If
+            '检查 .NET Framework 版本
+            Try
+                Using ndpKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\")
+                    If ndpKey?.GetValue("Release") IsNot Nothing AndAlso CInt(ndpKey.GetValue("Release")) < 528040 Then OldEnvironmentAssert()
+                End Using
+            Catch ex As Exception
+                Logger.Warn(ex, "检查 .NET Framework 版本失败")
+            End Try
+            '修复 WPF 字体加载(#3467)
+            Try
+                Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
+            Catch ex As UriFormatException
+                Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
+                Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
+            End Try
             '检查参数调用
             If e.Args.Length > 0 Then
                 If e.Args(0) = "--update" Then
@@ -48,232 +64,219 @@ 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
             '初始化文件结构
-            Directory.CreateDirectory(Path & "PCL\Pictures")
-            Directory.CreateDirectory(Path & "PCL\Musics")
             Try
-                Directory.CreateDirectory(PathTemp)
-                If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
+                DirectoryUtils.Create(Paths.Base & "PCL\Pictures\")
+                DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
+                CheckPermissionWithException(Paths.Base & "PCL\")
+            Catch ex As Exception
+                MsgBox($"PCL 没有对当前文件夹的权限({Paths.Base}PCL\),请尝试:" & vbCrLf &
+                  "1. 将 PCL 移动到其他文件夹" & If(Paths.Base.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
+                  "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
+                  "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
+                MsgBoxStyle.Critical, "运行环境错误")
+                Environment.[Exit](ProcessReturnValues.Cancel)
+            End Try
+RetryCacheCheck:
+            Try
+                DirectoryUtils.Create(PathTemp)
+                CheckPermissionWithException(PathTemp)
             Catch ex As Exception
-                If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
-                    MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
+                If PathTemp = Path.GetTempPath() & "PCL\" Then
+                    MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDisplay(True), "缓存文件夹不可用")
                 Else
-                    MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
-                    Setup.Set("SystemSystemCache", "")
-                    PathTemp = IO.Path.GetTempPath() & "PCL\"
+                    MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDisplay(True), "缓存文件夹不可用")
+                    Settings.Set("SystemSystemCache", "")
+                    PathTemp = Path.GetTempPath() & "PCL\"
+                    GoTo RetryCacheCheck
                 End If
             End Try
-            Directory.CreateDirectory(PathTemp & "Cache")
-            Directory.CreateDirectory(PathTemp & "Download")
-            Directory.CreateDirectory(PathAppdata)
-            '检测单例
-#If Not DEBUG Then
-            Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
-            Dim WaitRetryCount As Integer = 0
-WaitRetry:
-            Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
-            If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
-            If WindowHwnd <> IntPtr.Zero Then
-                If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
-                    WaitRetryCount += 1
-                    Thread.Sleep(500)
-                    GoTo WaitRetry
-                End If
-                '将已有的 PCL 窗口拖出来
-                ShowWindowToTop(WindowHwnd)
-                '播放提示音并退出
-                Beep()
-                Environment.[Exit](ProcessReturnValues.Cancel)
-            End If
-#End If
+            DirectoryUtils.Create(PathTemp & "Cache\")
+            DirectoryUtils.Create(Paths.AppDataThenName)
+            '要求单例
+            WaitingMutex(e)
             '设置 ToolTipService 默认值
-            ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300))
-            ToolTipService.BetweenShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(400))
-            ToolTipService.ShowDurationProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(9999999))
-            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))
+            ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(100))
+            '设置网络配置默认值
+            ServicePointManager.Expect100Continue = False
+            ServicePointManager.DefaultConnectionLimit = 10000
+            ServicePointManager.UseNagleAlgorithm = False
+            ServicePointManager.EnableDnsRoundRobin = True
+            ServicePointManager.ReusePort = True
+            If Environment.OSVersion.Version < New Version(6, 2) Then 'Windows 7 回退(#8519)
+                ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
+            End If
             '设置初始窗口
-            If Setup.Get("UiLauncherLogo") Then
+            If Settings.Get(Of Boolean)("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), ",正式版", "")}")
-#Else
-            Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
-#End If
-            Log($"[Start] 程序路径:{PathWithName}")
-            Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
-            Log($"[Start] 管理员权限:{IsAdmin()}")
+            '基础信息
+            Logger.Info($"程序版本:{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
+            If BuildType = BuildTypes.Snapshot Then
+                Logger.Info($"识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", ",未解锁反馈主题")}")
+            Else
+                Logger.Info($"识别码:{Identify}")
+            End If
+            Logger.Info($"程序路径:{PathExe}")
+            Logger.Info($"系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
+            Logger.Info($"管理员权限:{WindowsUtils.HasAdminRole()}")
             '检测异常环境
-            If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
-                MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
+            If Paths.Base.Contains(Path.GetTempPath()) OrElse Paths.Base.Contains("AppData\Local\Temp\") Then
+                MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
+                FormMain.EndProgramForce(ProcessReturnValues.Cancel)
             End If
-            If Is32BitSystem Then
-                MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
+            If Not Environment.Is64BitOperatingSystem Then
+                MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,请重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True, ForceWait:=True)
+                FormMain.EndProgramForce(ProcessReturnValues.Cancel)
             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()
-            '执行测试
-#If DEBUG Then
-            Test()
-#End If
+            Logger.Info($"第一阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms")
+            ApplicationStartTick = GetTimeMs()
             AniControlEnabled += 1
         Catch ex As Exception
             Dim FilePath As String = Nothing
             Try
-                FilePath = PathWithName
+                FilePath = PathExe
             Catch
             End Try
-            MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
+            MsgBox(ex.GetDisplay(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
             FormMain.EndProgramForce(ProcessReturnValues.Exception)
         End Try
     End Sub
+    ''' <summary>
+    ''' 要求程序以单例运行。
+    ''' 如果已在运行,则将其窗口拖出来并播放提示音,然后结束当前进程。
+    ''' </summary>
+    Private Shared Sub WaitingMutex(e As StartupEventArgs)
+        If BuildType = BuildTypes.Debug Then Return
+        Try
+            Dim MutexCreatedNew As Boolean
+            PclMutex = New Mutex(True, "PCL_SingletonMutex", MutexCreatedNew)
+            If MutexCreatedNew Then Return
+            Logger.Warn("已有一个 PCL 实例正在运行")
+            '等待已有的 PCL 退出
+            If e.Args.Length > 0 AndAlso e.Args(0) = "--wait" Then
+                Try
+                    If PclMutex.WaitOne(10000) Then Return '等待至多 10 秒
+                Catch Ignored As AbandonedMutexException
+                    Return '已有实例异常退出,继续启动
+                End Try
+            End If
+            '将已有的 PCL 窗口拖出来
+            Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
+            If WindowHwnd = IntPtr.Zero Then WindowHwnd = FindWindow(Nothing, "Plain Craft Launcher 2 ")
+            If WindowHwnd <> IntPtr.Zero Then ShowWindowToTop(WindowHwnd)
+            '播放提示音并退出
+            Beep()
+            Environment.[Exit](ProcessReturnValues.Cancel)
+        Catch ex As Exception
+            Logger.Warn(ex, "单例检查失败")
+        End Try
+    End Sub
+    Private Shared PclMutex As Mutex
 
     '结束
     Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
-        FrmMain.EndProgram(False)
+        FrmMain?.EndProgram(False)
     End Sub
 
     '异常
-    Private IsCritErrored As Boolean = False
     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 Exit Sub
-        If IsCritErrored Then
-            '在汇报错误后继续引发错误,知道这次压不住了
-            FormMain.EndProgramForce(ProcessReturnValues.Exception)
-            Exit Sub
+        If IsProgramEnding Then Return
+        FeedbackInfo()
+        Dim Detail As String = e.Exception.GetDisplay(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 ' “自动错误判断” 的结果分析
+            OldEnvironmentAssert(e.Exception)
+        Else
+            Logger.Error(e.Exception, "程序出现未知错误", LogBehavior.AlertThenCrash)
         End If
-        IsCritErrored = True
-        Dim ExceptionString As String = GetExceptionDetail(e.Exception, True)
-        If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
-           ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
-           ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
-           ExceptionString.Contains("未能加载文件或程序集") Then
-            OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
-            MsgBox("你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!", MsgBoxStyle.Information, "运行环境错误")
-            FormMain.EndProgramForce(ProcessReturnValues.Cancel)
+    End Sub
+    Private Shared Sub OldEnvironmentAssert(Optional ex As Exception = Nothing)
+        OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net48-offline-installer")
+        If ex Is Nothing Then
+            Logger.Error($"你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.8!{vbCrLf}若安装失败,可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
         Else
-            FeedbackInfo()
-            Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
+            Logger.Error(ex, $"你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.8!{vbCrLf}若安装失败,可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
         End If
     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
+    '动态 DLL 加载
+    Private Sub New() '这里必须尽早调用,且不能使用任何库,否则加载 MeloongCore 就会导致崩溃
+        Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "ThrottleDebounce", "System.Net.Http.Formatting", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
+        Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
+        AddHandler AppDomain.CurrentDomain.AssemblyResolve,
+        Function(sender As Object, Args As ResolveEventArgs) As Assembly
+            Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal))
+            If Prefix Is Nothing Then Return Nothing
+            Dim LazyAssembly = LoadedAssemblies.GetOrAdd(Prefix, Function(p) New Lazy(Of Assembly)(
+            Function()
+                Dim LoadedAssembly = Assembly.Load(DirectCast(My.Resources.ResourceManager.GetObject(p), Byte()))
+                If p = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
+                Return LoadedAssembly
+            End Function, LazyThreadSafetyMode.ExecutionAndPublication))
+            Return LazyAssembly.Value
+        End Function
+    End Sub
+    Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase,进而调用 MeloongCore,所以不能放在 New 里
+        SetDllDirectory(PathPure.TrimEnd("\"c))
+        Try
+            ExtractResources(PathPure & "libwebp.dll", "libwebp64")
+        Catch ex As Exception
+            Logger.Warn(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
+        End Try
+    End Sub
     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"))
-                End If
-                Return AssemblyImazenWebp
-            End SyncLock
-        Else
-            Return Nothing
-        End If
-    End Function
 
     '切换窗口
 
     '控件模板事件
     Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
-        Select Case Setup.Get("LoginType")
+        Select Case Settings.Get(Of McLoginType)("LoginType")
             Case McLoginType.Ms
                 '微软
-                Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
+                Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
                 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(Of String)("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 = Settings.Get(Of McLoginType)("LoginType").ToString()
                 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(Of String)("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get(Of String)("Login" & Token & "Email").Split("¨"))
+                If Not Settings.Get(Of String)("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get(Of String)("Login" & Token & "Pass").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

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

@@ -0,0 +1,199 @@
+' 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
+
+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 ex As Exception
+                Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
+            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 ex As Exception
+                Logger.Warn(ex, "剪切失败,请稍后再试", LogBehavior.Toast)
+            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
+
+            Try
+                If Forms.Clipboard.ContainsText() Then
+                    Dim pasteText = Forms.Clipboard.GetText()
+
+                    '将换行符替换为空格(#7825)
+                    If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
+
+                    Dim start = tb.SelectionStart
+
+                    tb.SelectedText = pasteText
+                    tb.CaretIndex = start + pasteText.Length
+                    tb.SelectionLength = 0
+                End If
+            Catch ex As Exception
+                Logger.Warn(ex, "粘贴失败,请稍后再试", LogBehavior.Toast)
+            End Try
+
+            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 ex As Exception
+                Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
+            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 ex As Exception
+                Logger.Warn(ex, "剪切失败,请稍后再试", LogBehavior.Toast)
+            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
+
+            Try
+                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)
+            Catch ex As Exception
+                Logger.Warn(ex, "粘贴失败,请稍后再试", LogBehavior.Toast)
+            End Try
+
+            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 ex As Exception
+                Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
+            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

+ 1 - 1
Plain Craft Launcher 2/Controls/MyButton.xaml

@@ -1,4 +1,4 @@
-<Border x:Class="MyButton"
+<Border x:Class="MyButton"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              FocusVisualStyle="{x:Null}" x:Name="PanBack"

+ 9 - 34
Plain Craft Launcher 2/Controls/MyButton.xaml.vb

@@ -1,4 +1,4 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyButton
@@ -136,43 +136,18 @@ Public Class MyButton
 
             End If
         Catch ex As Exception
-            Log(ex, "刷新按钮颜色出错")
+            Logger.Warn(ex, "刷新按钮颜色出错")
         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 Exit Sub
-        Log("[Control] 按下按钮:" & Text)
+        If Not IsMouseDown Then Return
+        Logger.Info($"按下按钮:{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()
@@ -185,7 +160,7 @@ Public Class MyButton
         AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush7"), AnimationColorIn), "MyButton Background " & Uuid)
     End Sub
     Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
-        If Not IsMouseDown Then Exit Sub
+        If Not IsMouseDown Then Return
         IsMouseDown = False
         AniStart({
                AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle))
@@ -193,7 +168,7 @@ Public Class MyButton
     End Sub
     Private Sub Button_MouseLeave() Handles Me.MouseLeave
         AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid)
-        If Not IsMouseDown Then Exit Sub
+        If Not IsMouseDown Then Return
         IsMouseDown = False
         AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid)
     End Sub

+ 135 - 106
Plain Craft Launcher 2/Controls/MyCard.vb

@@ -1,9 +1,9 @@
-Public Class MyCard
+Public Class MyCard
 
     '控件
     Inherits Grid
     Private ReadOnly MainGrid As Grid
-    Public ReadOnly Property MainChrome As SystemDropShadowChrome
+    Public ReadOnly Property MainChrome As MyDropShadow
     Private ReadOnly MainBorder As Border
     Public Property BorderChild As UIElement
         Get
@@ -63,17 +63,18 @@
 
     'UI 建立
     Public Sub New()
-        MainChrome = New SystemDropShadowChrome With {.Margin = New Thickness(-9.5, -9, 0.5, -0.5), .Opacity = 0.1, .CornerRadius = New CornerRadius(6)}
-        MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1")
+        MainChrome = New MyDropShadow With {
+            .Margin = New Thickness(-3, -3, -3, -3 - GetWPFSize(1)), .ShadowRadius = 3, .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius(5)}
+        MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1")
         Children.Insert(0, MainChrome)
-        MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
+        MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(245, 255, 255, 255)), .CornerRadius = New CornerRadius(5), .IsHitTestVisible = False}
         Children.Insert(1, MainBorder)
         MainGrid = New Grid
         Children.Add(MainGrid)
     End Sub
     Private IsLoad As Boolean = False
     Private Sub Init() Handles Me.Loaded
-        If IsLoad Then Exit Sub
+        If IsLoad Then Return
         IsLoad = True
         '初次加载限定
         If MainTextBlock Is Nothing Then
@@ -89,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
@@ -108,68 +110,51 @@
         '这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
         '但是现在……反正勉强能用……懒得改了就这样吧.jpg
         '别骂了别骂了.jpg
-        If IsNothing(Stack.Tag) Then Exit Sub
+        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 ResourceVersion)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
+                HasDuplicates =
+                    CType(Stack.Tag, List(Of ResourceVersion)).DistinctBy(Function(a) a.Display).Count <>
+                    CType(Stack.Tag, List(Of ResourceVersion)).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
-                CompFilesCardPreload(Stack, Stack.Tag)
+                PageDownloadResourceDetail.ResourceFilesCardPreload(Stack, Stack.Tag)
         End Select
         '实现控件虚拟化
         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, ResourceVersion).ToListItem(
+                        AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=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, ResourceVersion).ToListItem(
+                        AddressOf FrmDownloadResourceDetail.Install_Click, AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
                 Case 10
                     Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
                 Case 11
@@ -179,36 +164,36 @@
                 Case 13
                     Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
                 Case Else
-                    Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
+                    Logger.Error($"未知的虚拟化种类:{Type}")
             End Select
         Next
         Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距,同时适应折叠
         Stack.Tag = Nothing
     End Sub
 
-    '事件
+    '动画
+    Private Const DropShadowIdleOpacity As Double = 0.07
+    Private Const DropShadowHoverOpacity As Double = 0.4
     Public Property HasMouseAnimation As Boolean = True
     Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
-        If Not HasMouseAnimation Then Exit Sub
+        If Not HasMouseAnimation Then Return
         Dim AniList As New List(Of AniData)
-        If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
-        If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
+        If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 90))
+        If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 90))
         AniList.AddRange({
-            AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
-            AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
-            AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
+            AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4", 90),
+            AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90)
         })
         AniStart(AniList, "MyCard Mouse " & Uuid)
     End Sub
     Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
-        If Not HasMouseAnimation Then Exit Sub
+        If Not HasMouseAnimation Then Return
         Dim AniList As New List(Of AniData)
-        If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
-        If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
+        If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 90))
+        If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 90))
         AniList.AddRange({
-            AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
-            AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
-            AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
+            AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1", 90),
+            AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90)
         })
         AniStart(AniList, "MyCard Mouse " & Uuid)
     End Sub
@@ -222,46 +207,64 @@
     Private IsHeightAnimating As Boolean = False
     Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
     Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
-        If Not UseAnimation Then Exit Sub
-        Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
+        If Not UseAnimation Then Return
+        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 Exit Sub
+        If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
         StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
     End Sub
-    Private Sub StartHeightAnimation(DeltaHeight As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
-        If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
+    Private Sub StartHeightAnimation(Delta As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
+        If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
 
         Dim AnimList As New List(Of AniData)
-        If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
-            '高度增加较大,使用弹起动画
-            Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
-            AnimList.AddRange({
-                AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
-                AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
-            })
+        Dim AbsDelta = Math.Abs(Delta)
+
+        If AbsDelta <= 800 Then
+            '短距离,直接使用 150ms 的缓动动画
+            AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
         Else
-            '普通的改变就行啦
-            AnimList.AddRange({
-                AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
-            })
+            Dim EaseLength As Integer, EaseTime As Integer
+            Dim InitSpeed As Integer '到达缓动区前的初速度
+            If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0.1 Then
+                '收回距离过长 (>0.1s),强制以 100ms 完成匀速段,然后让减速段更长
+                EaseLength = 200
+                EaseTime = 150
+                InitSpeed = (AbsDelta - EaseLength) / 0.1
+            ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0.6 Then
+                '展开距离过长 (>0.6s),以 5000 速度展示 300ms 匀速段,剩下的距离全部归入减速段
+                InitSpeed = 5000
+                EaseLength = AbsDelta - InitSpeed * 0.3
+                EaseTime = 400
+            Else
+                '中程,匀速地快速展开(或收回)
+                EaseLength = 150
+                EaseTime = 200
+                InitSpeed = 4000
+            End If
+            '匀速段
+            AnimList.Add(AaHeight(Me, (AbsDelta - EaseLength) * Math.Sign(Delta),
+                (AbsDelta - EaseLength) / InitSpeed * 1000))
+            '减速段
+            AnimList.Add(AaHeight(Me, EaseLength * Math.Sign(Delta),
+                EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000, EaseLength), True))
         End If
+
         AnimList.Add(AaCode(
         Sub()
             IsHeightAnimating = False
             Height = ActualUsedHeight
-            If IsSwaped 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
@@ -272,7 +275,7 @@
 
     '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
     '这是因为不能直接在 XAML 中设置 SwapControl
-    Public SwapControl As Object
+    Public SwapControl As FrameworkElement
     Public Property CanSwap As Boolean = False
     ''' <summary>
     ''' 被折叠的种类,用于控件虚拟化。
@@ -281,59 +284,85 @@
     ''' <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 Exit Property
-            _IsSwaped = value
-            If SwapControl Is Nothing Then Exit Property
+            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 Exit Property
-            '更新高度
+            If Not IsLoaded Then Return
+            '更新样式
             SwapControl.Visibility = Visibility.Visible
             TriggerForceResize()
+            UpdateCursorStyle()
             '改变箭头
-            AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "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 _IsSwaped As Boolean = False
+    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
+    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 Exit Sub '检测点击位置;或已经不在可视树上的误判
-        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 Exit Sub '检测点击位置;或已经不在可视树上的误判
+        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
+        Logger.Info($"{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
+    Private Sub UpdateCursorStyle() Handles Me.MouseMove
+        If _MainSwap Is Nothing Then Cursor = Nothing : Return
+        Dim Pos As Double = Mouse.GetPosition(Me).Y
+        Cursor = If(MainSwap.Visibility = Visibility.Visible AndAlso (IsSwapped OrElse (Pos <= SwapedHeight - 6 AndAlso Not (Pos = 0 AndAlso Not IsMouseDirectlyOver))),
+            Cursors.Hand, Nothing)
     End Sub
 
 #End Region
@@ -350,7 +379,7 @@ Partial Public Module ModAnimation
                 AaCode(
                 Sub()
                     If RemoveFromChildren Then
-                        If Control.Parent Is Nothing Then Exit Sub
+                        If Control.Parent Is Nothing Then Return
                         CType(Control.Parent, Object).Children.Remove(Control)
                     Else
                         Control.Visibility = Visibility.Collapsed
@@ -360,7 +389,7 @@ Partial Public Module ModAnimation
             }, "MyCard Dispose " & Control.Uuid)
         Else
             If RemoveFromChildren Then
-                If Control.Parent Is Nothing Then Exit Sub
+                If Control.Parent Is Nothing Then Return
                 CType(Control.Parent, Object).Children.Remove(Control)
             Else
                 Control.Visibility = Visibility.Collapsed

+ 1 - 1
Plain Craft Launcher 2/Controls/MyCheckBox.xaml

@@ -1,4 +1,4 @@
-<Grid
+<Grid
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"

+ 37 - 22
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb

@@ -1,7 +1,8 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <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
@@ -40,7 +38,7 @@ Public Class MyCheckBox
     ''' <param name="user">是否由用户引发。</param>
     Public Sub SetChecked(value As Boolean, user As Boolean)
         Try
-            If value = Checked Then Exit Sub
+            If value = Checked Then Return
 
             'Preview 事件
             If value AndAlso user Then
@@ -50,7 +48,7 @@ Public Class MyCheckBox
                     MouseDowned = True
                     Checkbox_MouseLeave()
                     MouseDowned = False
-                    Exit Sub
+                    Return
                 End If
             End If
 
@@ -59,8 +57,9 @@ Public Class MyCheckBox
 
             '更改动画
             SyncUI()
+            RaiseCustomEvent()
         Catch ex As Exception
-            Log(ex, "设置 Checked 失败")
+            Logger.Warn(ex, "设置 Checked 失败")
         End Try
     End Sub
     Private Sub SyncUI()
@@ -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
@@ -133,14 +132,14 @@ Public Class MyCheckBox
     Private MouseDowned As Boolean = False
     Private AllowMouseDown As Boolean = True
     Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
-        If Not MouseDowned Then Exit Sub
-        Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
+        If Not MouseDowned Then Return
+        Logger.Info($"按下复选框({(Not Checked)}):{Text}")
         MouseDowned = False
         SetChecked(Not Checked, True)
         AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
     End Sub
     Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
-        If Not AllowMouseDown Then Exit Sub
+        If Not AllowMouseDown Then Return
         MouseDowned = True
         Focus()
         AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
@@ -154,7 +153,7 @@ Public Class MyCheckBox
         End If
     End Sub
     Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
-        If Not MouseDowned Then Exit Sub
+        If Not MouseDowned Then Return
         MouseDowned = False
         AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
         If Checked Then
@@ -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
@@ -203,13 +202,29 @@ Public Class MyCheckBox
          }, "MyCheckBox BorderColor " & Uuid)
     End Sub
     Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
-        If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
+        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

+ 50 - 14
Plain Craft Launcher 2/Controls/MyComboBox.vb

@@ -1,5 +1,6 @@
-Public Class MyComboBox
+Public Class MyComboBox
     Inherits ComboBox
+    Implements ISettingControl
     Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
 
     '基础
@@ -8,7 +9,7 @@
     Public Property HintText As String = ""
     Public Overrides Sub OnApplyTemplate()
         MyBase.OnApplyTemplate()
-        If Not IsEditable Then Exit Sub
+        If Not IsEditable Then Return
         Try
             TextBox = Template.FindName("PART_EditableTextBox", Me)
             TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor))
@@ -21,7 +22,7 @@
             End If
             If HintText.Length > 0 Then TextBox.HintText = HintText
         Catch ex As Exception
-            Log(ex, "初始化可编辑文本框失败(" & If(Name, "") & ")", LogLevel.Feedback)
+            Logger.Error(ex, $"初始化可编辑文本框失败({If(Name, "")})")
         End Try
     End Sub
     Private _Text As String = SelectedItem
@@ -103,10 +104,11 @@
     Private Sub MyComboBox_DropDownOpened(sender As Object, e As EventArgs) Handles Me.DropDownOpened
         RealWidth = Width
         Width = ActualWidth
+        '将下拉菜单透明度与主窗口同步
         Try
             CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity
         Catch ex As Exception
-            Log(ex, "设置下拉框透明度失败", LogLevel.Feedback)
+            Logger.Error(ex, "设置下拉框透明度失败")
         End Try
     End Sub
     Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
@@ -116,16 +118,15 @@
     '修复 WPF Bug:下拉框文本修改后,依然误认为还选择着此前的选项,导致再次点击该选项时内容不变
     Private IsTextChanging As Boolean = False
     Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
-        If IsTextChanging OrElse Not IsEditable Then Exit Sub
-        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 IsTextChanging OrElse Not IsEditable Then Return
+        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 +135,39 @@
         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
+            Logger.Warn($"尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项")
+            SelectedIndex = -1
+            SelectedItem = Nothing
+        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 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

+ 3 - 3
Plain Craft Launcher 2/Controls/MyComboBoxItem.vb

@@ -1,4 +1,4 @@
-Public Class MyComboBoxItem
+Public Class MyComboBoxItem
     Inherits ComboBoxItem
 
     '基础
@@ -35,7 +35,7 @@
             NewFontOpacity = 0.4
             Time = AnimationTimeOut
         End If
-        If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub
+        If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Return
         BackColorName = NewBackColorName
         FontOpacity = NewFontOpacity
         '触发颜色动画
@@ -61,7 +61,7 @@
     End Operator
 
     Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
-        Log("[Control] 选择下拉列表项:" & Tostring())
+        Logger.Info($"选择下拉列表项:{Tostring()}")
     End Sub
 
 End Class

+ 66 - 41
Plain Craft Launcher 2/Modules/Reference/SystemDropShadowChrome.vb → Plain Craft Launcher 2/Controls/MyDropShadow.vb

@@ -1,65 +1,89 @@
-Public NotInheritable Class SystemDropShadowChrome
+Public Class MyDropShadow
     Inherits Decorator
 
-    '源码来源于:https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
-
-    Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
+    ''' <summary>
+    ''' 阴影颜色。
+    ''' </summary>
     Public Property Color As Color
         Get
-            Return CType(GetValue(ColorProperty), Color)
+            Return GetValue(ColorProperty)
         End Get
         Set(value As Color)
             SetValue(ColorProperty, value)
         End Set
     End Property
+    Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(MyDropShadow),
+        New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
+
+    ''' <summary>
+    ''' 阴影模糊半径。
+    ''' </summary>
+    Public Property ShadowRadius As Double
+        Get
+            Return GetValue(ShadowRadiusProperty)
+        End Get
+        Set(value As Double)
+            SetValue(ShadowRadiusProperty, value)
+        End Set
+    End Property
+    Public Shared ReadOnly ShadowRadiusProperty As DependencyProperty = DependencyProperty.Register("ShadowRadius", GetType(Double), GetType(MyDropShadow),
+        New FrameworkPropertyMetadata(CDbl(5), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
 
-    Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
+    ''' <summary>
+    ''' 圆角大小。
+    ''' </summary>
     Public Property CornerRadius As CornerRadius
         Get
-            Return CType(GetValue(CornerRadiusProperty), CornerRadius)
+            Return GetValue(CornerRadiusProperty)
         End Get
         Set(value As CornerRadius)
             SetValue(CornerRadiusProperty, value)
         End Set
     End Property
     Private Shared Function IsCornerRadiusValid(value As Object) As Boolean
-        Dim cr As CornerRadius = CType(value, CornerRadius)
+        Dim cr As CornerRadius = value
         Return Not (cr.TopLeft < 0.0 OrElse cr.TopRight < 0.0 OrElse cr.BottomLeft < 0.0 OrElse cr.BottomRight < 0.0 OrElse Double.IsNaN(cr.TopLeft) OrElse Double.IsNaN(cr.TopRight) OrElse Double.IsNaN(cr.BottomLeft) OrElse Double.IsNaN(cr.BottomRight) OrElse Double.IsInfinity(cr.TopLeft) OrElse Double.IsInfinity(cr.TopRight) OrElse Double.IsInfinity(cr.BottomLeft) OrElse Double.IsInfinity(cr.BottomRight))
     End Function
+    Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyDropShadow),
+        New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
+
+
+    ' =======================================
+    '  渲染
+    ' =======================================
 
-    Private Const ShadowDepth As Double = 5
 
     Protected Overrides Sub OnRender(drawingContext As DrawingContext)
         Dim cornerRadius As CornerRadius = Me.CornerRadius
-        Dim shadowBounds As New Rect(New Point(ShadowDepth, ShadowDepth), New Size(RenderSize.Width, RenderSize.Height))
+        Dim shadowBounds As New Rect(0, 0, RenderSize.Width, RenderSize.Height)
         Dim color As Color = Me.Color
 
         If shadowBounds.Width > 0 AndAlso shadowBounds.Height > 0 AndAlso color.A > 0 Then
-            Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowDepth
-            Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowDepth
+            Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowRadius
+            Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowRadius
             Dim maxRadius As Double = Math.Min(centerWidth * 0.5, centerHeight * 0.5)
             cornerRadius.TopLeft = Math.Min(cornerRadius.TopLeft, maxRadius)
             cornerRadius.TopRight = Math.Min(cornerRadius.TopRight, maxRadius)
             cornerRadius.BottomLeft = Math.Min(cornerRadius.BottomLeft, maxRadius)
             cornerRadius.BottomRight = Math.Min(cornerRadius.BottomRight, maxRadius)
             Dim brushes As Brush() = GetBrushes(color, cornerRadius)
-            Dim centerTop As Double = shadowBounds.Top + ShadowDepth
-            Dim centerLeft As Double = shadowBounds.Left + ShadowDepth
-            Dim centerRight As Double = shadowBounds.Right - ShadowDepth
-            Dim centerBottom As Double = shadowBounds.Bottom - ShadowDepth
+            Dim centerTop As Double = shadowBounds.Top + ShadowRadius
+            Dim centerLeft As Double = shadowBounds.Left + ShadowRadius
+            Dim centerRight As Double = shadowBounds.Right - ShadowRadius
+            Dim centerBottom As Double = shadowBounds.Bottom - ShadowRadius
             Dim guidelineSetX As Double() = New Double() {centerLeft, centerLeft + cornerRadius.TopLeft, centerRight - cornerRadius.TopRight, centerLeft + cornerRadius.BottomLeft, centerRight - cornerRadius.BottomRight, centerRight}
             Dim guidelineSetY As Double() = New Double() {centerTop, centerTop + cornerRadius.TopLeft, centerTop + cornerRadius.TopRight, centerBottom - cornerRadius.BottomLeft, centerBottom - cornerRadius.BottomRight, centerBottom}
             drawingContext.PushGuidelineSet(New GuidelineSet(guidelineSetX, guidelineSetY))
-            cornerRadius.TopLeft += ShadowDepth
-            cornerRadius.TopRight += ShadowDepth
-            cornerRadius.BottomLeft += ShadowDepth
-            cornerRadius.BottomRight += ShadowDepth
+            cornerRadius.TopLeft += ShadowRadius
+            cornerRadius.TopRight += ShadowRadius
+            cornerRadius.BottomLeft += ShadowRadius
+            cornerRadius.BottomRight += ShadowRadius
             Dim topLeft As New Rect(shadowBounds.Left, shadowBounds.Top, cornerRadius.TopLeft, cornerRadius.TopLeft)
             drawingContext.DrawRectangle(brushes(Placement.TopLeft), Nothing, topLeft)
             Dim topWidth As Double = guidelineSetX(2) - guidelineSetX(1)
 
             If topWidth > 0 Then
-                Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowDepth)
+                Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowRadius)
                 drawingContext.DrawRectangle(brushes(Placement.Top), Nothing, top)
             End If
 
@@ -68,14 +92,14 @@
             Dim leftHeight As Double = guidelineSetY(3) - guidelineSetY(1)
 
             If leftHeight > 0 Then
-                Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowDepth, leftHeight)
+                Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowRadius, leftHeight)
                 drawingContext.DrawRectangle(brushes(Placement.Left), Nothing, left)
             End If
 
             Dim rightHeight As Double = guidelineSetY(4) - guidelineSetY(2)
 
             If rightHeight > 0 Then
-                Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowDepth, rightHeight)
+                Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowRadius, rightHeight)
                 drawingContext.DrawRectangle(brushes(Placement.Right), Nothing, right)
             End If
 
@@ -84,20 +108,20 @@
             Dim bottomWidth As Double = guidelineSetX(4) - guidelineSetX(3)
 
             If bottomWidth > 0 Then
-                Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowDepth)
+                Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowRadius)
                 drawingContext.DrawRectangle(brushes(Placement.Bottom), Nothing, bottom)
             End If
 
             Dim bottomRight As New Rect(guidelineSetX(4), guidelineSetY(4), cornerRadius.BottomRight, cornerRadius.BottomRight)
             drawingContext.DrawRectangle(brushes(Placement.BottomRight), Nothing, bottomRight)
 
-            If cornerRadius.TopLeft = ShadowDepth AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
+            If cornerRadius.TopLeft = ShadowRadius AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
                 Dim center As New Rect(guidelineSetX(0), guidelineSetY(0), centerWidth, centerHeight)
                 drawingContext.DrawRectangle(brushes(Placement.Center), Nothing, center)
             Else
                 Dim figure As New PathFigure()
 
-                If cornerRadius.TopLeft > ShadowDepth Then
+                If cornerRadius.TopLeft > ShadowRadius Then
                     figure.StartPoint = New Point(guidelineSetX(1), guidelineSetY(0))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(1), guidelineSetY(1)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(1)), True))
@@ -105,7 +129,7 @@
                     figure.StartPoint = New Point(guidelineSetX(0), guidelineSetY(0))
                 End If
 
-                If cornerRadius.BottomLeft > ShadowDepth Then
+                If cornerRadius.BottomLeft > ShadowRadius Then
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(3)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(3)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(5)), True))
@@ -113,7 +137,7 @@
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(5)), True))
                 End If
 
-                If cornerRadius.BottomRight > ShadowDepth Then
+                If cornerRadius.BottomRight > ShadowRadius Then
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(5)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(4)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(4)), True))
@@ -121,7 +145,7 @@
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(5)), True))
                 End If
 
-                If cornerRadius.TopRight > ShadowDepth Then
+                If cornerRadius.TopRight > ShadowRadius Then
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(2)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(2)), True))
                     figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(0)), True))
@@ -158,28 +182,27 @@
     Private _brushes As Brush()
 
     Private Shared Sub ClearBrushes(o As DependencyObject, e As DependencyPropertyChangedEventArgs)
-        CType(o, SystemDropShadowChrome)._brushes = Nothing
+        CType(o, MyDropShadow)._brushes = Nothing
     End Sub
-    Private Shared Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
-        Dim gradientScale As Double = 1 / (cornerRadius + ShadowDepth)
-        Dim gsc As New GradientStopCollection From {
-            New GradientStop(c, (0.5 + cornerRadius) * gradientScale)
-        }
+    Private Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
+        Dim gradientScale As Double = 1 / (ShadowRadius + cornerRadius)
+        Dim gsc As New GradientStopCollection
         Dim stopColor As Color = c
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.1 + cornerRadius) * gradientScale))
         stopColor.A = CByte(0.74336 * c.A)
-        gsc.Add(New GradientStop(stopColor, (1.5 + cornerRadius) * gradientScale))
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.3 + cornerRadius) * gradientScale))
         stopColor.A = CByte(0.38053 * c.A)
-        gsc.Add(New GradientStop(stopColor, (2.5 + cornerRadius) * gradientScale))
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.5 + cornerRadius) * gradientScale))
         stopColor.A = CByte(0.12389 * c.A)
-        gsc.Add(New GradientStop(stopColor, (3.5 + cornerRadius) * gradientScale))
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.7 + cornerRadius) * gradientScale))
         stopColor.A = CByte(0.02654 * c.A)
-        gsc.Add(New GradientStop(stopColor, (4.5 + cornerRadius) * gradientScale))
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.9 + cornerRadius) * gradientScale))
         stopColor.A = 0
-        gsc.Add(New GradientStop(stopColor, (5 + cornerRadius) * gradientScale))
+        gsc.Add(New GradientStop(stopColor, (ShadowRadius + cornerRadius) * gradientScale))
         gsc.Freeze()
         Return gsc
     End Function
-    Private Shared Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
+    Private Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
         Dim brushes As Brush() = New Brush(8) {}
         brushes(Placement.Center) = New SolidColorBrush(c)
         brushes(Placement.Center).Freeze()
@@ -297,3 +320,5 @@
     End Function
 
 End Class
+
+'参考自:https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1

+ 2 - 2
Plain Craft Launcher 2/Controls/MyExtraButton.xaml

@@ -1,8 +1,8 @@
-<Grid
+<Grid
             xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
             xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
             xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraButton"
-            Width="40" RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="0">
+            Width="40" RenderTransformOrigin="0.5,0.5" Height="0">
     <Grid.RenderTransform>
         <ScaleTransform ScaleX="0" ScaleY="0" />
     </Grid.RenderTransform>

+ 41 - 38
Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb

@@ -1,4 +1,4 @@
-Public Class MyExtraButton
+Public Class MyExtraButton
 
     '声明
     Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
@@ -11,7 +11,7 @@
             Return _Progress
         End Get
         Set(value As Double)
-            If _Progress = value Then Exit Property
+            If _Progress = value Then Return
             _Progress = value
             If value < 0.0001 Then
                 PanProgress.Visibility = Visibility.Collapsed
@@ -30,7 +30,7 @@
             Return _Logo
         End Get
         Set(value As String)
-            If value = _Logo Then Exit Property
+            If value = _Logo Then Return
             _Logo = value
             Path.Data = (New GeometryConverter).ConvertFromString(value)
         End Set
@@ -51,27 +51,28 @@
             Return _Show
         End Get
         Set(value As Boolean)
-            If _Show = value Then Exit Property
+            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
@@ -83,7 +84,7 @@
     '触发点击事件
     Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
         If IsLeftMouseHeld Then
-            Log("[Control] 按下附加按钮" & If(ToolTip = "", "", ":" & ToolTip.ToString))
+            Logger.Info($"按下附加按钮{If(ToolTip = "", "", ":" & ToolTip)}")
             RaiseEvent Click(sender, e)
             e.Handled = True
             Button_LeftMouseUp()
@@ -91,7 +92,7 @@
     End Sub
     Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp
         If IsRightMouseHeld Then
-            Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", ":" & ToolTip.ToString))
+            Logger.Info($"右键按下附加按钮{If(ToolTip = "", "", ":" & ToolTip)}")
             RaiseEvent RightClick(sender, e)
             e.Handled = True
             Button_RightMouseUp()
@@ -121,7 +122,7 @@
         Focus()
     End Sub
     Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
-        If Not CanRightClick Then Exit Sub
+        If Not CanRightClick Then Return
         If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
             AniStart({
                 AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
@@ -137,11 +138,12 @@
                 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
     Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
-        If Not CanRightClick Then Exit Sub
+        If Not CanRightClick Then Return
         If Not IsLeftMouseHeld Then
             AniStart({
                 AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
@@ -191,7 +193,7 @@
 
             End If
         Catch ex As Exception
-            Log(ex, "刷新图标按钮颜色出错")
+            Logger.Warn(ex, "刷新图标按钮颜色出错")
         End Try
     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

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

@@ -1,10 +1,10 @@
-<Grid
+<Grid
     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" 
     x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton"
-    RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" Height="52" Margin="20">
+    RenderTransformOrigin="0.5,0.5" Height="52" Margin="20" Cursor="Hand">
     <Grid.RenderTransform>
         <ScaleTransform ScaleX="0" ScaleY="0" />
     </Grid.RenderTransform>

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

@@ -1,4 +1,4 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyExtraTextButton
@@ -14,7 +14,7 @@ Public Class MyExtraTextButton
             Return _Logo
         End Get
         Set(value As String)
-            If value = _Logo Then Exit Property
+            If value = _Logo Then Return
             _Logo = value
             Path.Data = (New GeometryConverter).ConvertFromString(value)
         End Set
@@ -55,7 +55,7 @@ Public Class MyExtraTextButton
             Return _Show
         End Get
         Set(value As Boolean)
-            If _Show = value Then Exit Property
+            If _Show = value Then Return
             _Show = value
             RunInUi(
             Sub()
@@ -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
+        Logger.Info($"按下附加图标按钮:{Text}")
+        RaiseEvent Click(sender, e)
+        e.Handled = True
+        RaiseCustomEvent()
+        Button_LeftMouseUp()
     End Sub
 
     '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
@@ -156,7 +156,7 @@ Public Class MyExtraTextButton
 
             End If
         Catch ex As Exception
-            Log(ex, "刷新附加图标按钮颜色出错")
+            Logger.Warn(ex, "刷新附加图标按钮颜色出错")
         End Try
     End Sub
 

+ 5 - 13
Plain Craft Launcher 2/Controls/MyHint.xaml

@@ -1,24 +1,16 @@
-<Border x:Class="MyHint" x:Name="PanBack"
+<Border x:Class="MyHint" x:Name="PanBack"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:local="clr-namespace:PCL"
              FocusVisualStyle="{x:Null}"
-             UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="1" BorderBrush="#99FF4444" CornerRadius="3">
-    <Border.Background>
-        <LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
-            <GradientStop x:Name="Gradient1" Color="#88FFBBBB" Offset="0.3"/>
-            <GradientStop x:Name="Gradient2" Color="#88FF8888" Offset="0.9"/>
-        </LinearGradientBrush>
-    </Border.Background>
+             UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="3,0,0,0" BorderBrush="#99FF4444" CornerRadius="2">
     <Grid UseLayoutRounding="False" SnapsToDevicePixels="False">
         <Grid.ColumnDefinitions>
-            <ColumnDefinition Width="Auto" />
             <ColumnDefinition Width="1*" />
             <ColumnDefinition Width="Auto" />
         </Grid.ColumnDefinitions>
-        <Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
-        <TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
-        <local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
-                           ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
+        <TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" />
+        <local:MyIconButton x:Name="BtnClose" Visibility="Collapsed" Theme="Custom" Margin="0,0,8,0" Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Logo="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"
+                           ToolTip="不再提示" />
     </Grid>
 </Border>

+ 80 - 60
Plain Craft Launcher 2/Controls/MyHint.xaml.vb

@@ -1,38 +1,74 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyHint
-
     Public Uuid As Integer = GetUuid()
 
-    Private _IsWarn As Boolean = True
-    Public Property IsWarn As Boolean
+    '边框
+    Public Property HasBorder As Boolean
         Get
-            Return _IsWarn
+            Return BorderThickness.Top > 0
         End Get
         Set(value As Boolean)
-            If _IsWarn = value Then Exit Property
-            _IsWarn = value
-            If _IsWarn Then
-                BorderBrush = New MyColor("#CCFF4444")
-                Gradient1.Color = New MyColor("#BBFFBBBB")
-                Gradient2.Color = New MyColor("#BBFF8888")
-                Path.Fill = New MyColor("#BF0000")
-                LabText.Foreground = New MyColor("#BF0000")
-                BtnClose.Foreground = New MyColor("#BF0000")
-                Path.Data = (New GeometryConverter).ConvertFromString("F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z ")
+            If value Then
+                BorderThickness = New Thickness(3, GetWPFSize(1), GetWPFSize(1), GetWPFSize(1))
             Else
-                BorderBrush = New MyColor("#CC4D76FF")
-                Gradient1.Color = New MyColor("#BBB0D0FF")
-                Gradient2.Color = New MyColor("#BB9EBAFF")
-                Path.Fill = New MyColor("#0062BF")
-                LabText.Foreground = New MyColor("#0062BF")
-                BtnClose.Foreground = New MyColor("#0062BF")
-                Path.Data = (New GeometryConverter).ConvertFromString("F1M38,19C48.4934,19 57,27.5066 57,38 57,48.4934 48.4934,57 38,57 27.5066,57 19,48.4934 19,38 19,27.5066 27.5066,19 38,19z M33.25,33.25L33.25,36.4167 36.4166,36.4167 36.4166,47.5 33.25,47.5 33.25,50.6667 44.3333,50.6667 44.3333,47.5 41.1666,47.5 41.1666,36.4167 41.1666,33.25 33.25,33.25z M38.7917,25.3333C37.48,25.3333 36.4167,26.3967 36.4167,27.7083 36.4167,29.02 37.48,30.0833 38.7917,30.0833 40.1033,30.0833 41.1667,29.02 41.1667,27.7083 41.1667,26.3967 40.1033,25.3333 38.7917,25.3333z")
+                BorderThickness = New Thickness(3, 0, 0, 0)
             End If
         End Set
     End Property
 
+    '配色
+    Public Enum Themes
+        Blue = 0
+        Red = 1
+        Yellow = 2
+    End Enum
+    Public Property Theme As Themes
+        Get
+            Return _ColorType
+        End Get
+        Set(value As Themes)
+            _ColorType = value
+            UpdateUI()
+        End Set
+    End Property
+    Private _ColorType As Themes = Themes.Red
+    Private Sub UpdateUI() Handles Me.Loaded
+        Select Case Theme
+            Case Themes.Blue
+                Background = New MyColor("#d9ecff")
+                BorderBrush = New MyColor("#1172D4")
+                LabText.Foreground = New MyColor("#0F64B8")
+                BtnClose.Foreground = New MyColor("#0F64B8")
+            Case Themes.Red
+                Background = New MyColor("#ffdddf")
+                BorderBrush = New MyColor("#d82929")
+                LabText.Foreground = New MyColor("#bf0b0b")
+                BtnClose.Foreground = New MyColor("#bf0b0b")
+            Case Themes.Yellow
+                Background = New MyColor("#ffebd7")
+                BorderBrush = New MyColor("#f57a00")
+                LabText.Foreground = New MyColor("#d86c00")
+                BtnClose.Foreground = New MyColor("#d86c00")
+        End Select
+    End Sub
+    <Obsolete("IsWarn 已过时。请换用 Theme 属性。")>
+    Public Property IsWarn As Boolean
+        Get
+            Return Theme = Themes.Red
+        End Get
+        Set(value As Boolean)
+            Theme = If(value, Themes.Red, Themes.Blue)
+        End Set
+    End Property
+    Public Shared ReadOnly IsWarnProperty As DependencyProperty =
+        DependencyProperty.Register("IsWarn", GetType(Boolean), GetType(MyHint), New PropertyMetadata(True,
+        Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
+            d.Theme = If(e.NewValue, Themes.Red, Themes.Blue)
+        End Sub))
+
+    '文本
     Public ReadOnly Property Inlines As InlineCollection
         Get
             Return LabText.Inlines
@@ -52,6 +88,7 @@ Public Class MyHint
             d.LabText.Text = e.NewValue
         End Sub))
 
+    '关闭按钮
     Public Property CanClose As Boolean
         Get
             Return BtnClose.Visibility = Visibility.Visible
@@ -60,26 +97,26 @@ Public Class MyHint
             BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
         End Set
     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
-        End If
+        If CanClose AndAlso Settings.Get(Of Boolean)(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))
+        Logger.Info($"按下提示条{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
@@ -87,42 +124,25 @@ 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
     Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
-        If Not Control.IsHitTestVisible Then Exit Sub
+        If Not Control.IsHitTestVisible Then Return
         Control.IsHitTestVisible = False
         AniStart({
-                     AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
-                     AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
-                     AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
-                     AaCode(Sub()
-                                If RemoveFromChildren Then
-                                    CType(Control.Parent, Object).Children.Remove(Control)
-                                Else
-                                    Control.Visibility = Visibility.Collapsed
-                                End If
-                                If CallBack IsNot Nothing Then CallBack(Control)
-                            End Sub,, True)
-            }, "MyCard Dispose " & Control.Uuid)
+            AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
+            AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
+            AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
+            AaCode(
+            Sub()
+                If RemoveFromChildren Then
+                    CType(Control.Parent, Object).Children.Remove(Control)
+                Else
+                    Control.Visibility = Visibility.Collapsed
+                End If
+                If CallBack IsNot Nothing Then CallBack(Control)
+            End Sub,, True)
+        }, "MyCard Dispose " & Control.Uuid)
     End Sub
 End Module

+ 1 - 1
Plain Craft Launcher 2/Controls/MyIconButton.xaml

@@ -1,4 +1,4 @@
-<Border x:Class="MyIconButton"
+<Border x:Class="MyIconButton"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
             CornerRadius="1000" Background="{StaticResource ColorBrushSemiTransparent}" BorderThickness="0.001">

+ 37 - 53
Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb

@@ -1,4 +1,6 @@
-Public Class MyIconButton
+Imports System.Windows.Shapes
+
+Public Class MyIconButton
 
     '自定义事件
     Public Event Click(sender As Object, e As EventArgs)
@@ -48,43 +50,27 @@
         End Set
     End Property
 
-    '触发点击事件
+    '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
+    Private IsMouseDown As Boolean = False
+    Public Property CanClick As Boolean = True
     Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
+        If Not CanClick Then Return
         If Not IsMouseDown Then Return
-        Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
+        Logger.Info($"按下图标按钮{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
+        If Not CanClick Then Return
         IsMouseDown = True
         Focus()
         '指向
         AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid)
     End Sub
     Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
+        If Not CanClick Then Return
         If IsMouseDown Then
             IsMouseDown = False
             AniStart({
@@ -95,6 +81,7 @@
         RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
     End Sub
     Private Sub Button_MouseLeave() Handles Me.MouseLeave
+        If Not CanClick Then Return
         IsMouseDown = False
         AniStart({
                      AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent)
@@ -102,14 +89,12 @@
         RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
     End Sub
 
-    '自定义事件
     '务必放在 IsMouseDown 更新之后
     Private Const AnimationColorIn As Integer = 120
     Private Const AnimationColorOut As Integer = 150
-    Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
+    Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded, Me.IsEnabledChanged
         Try
             If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
-
                 If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
                 If Path.Fill Is Nothing Then
                     Select Case Theme
@@ -121,9 +106,10 @@
                             Path.Fill = New MyColor(160, Foreground)
                     End Select
                 End If
-                If IsMouseOver Then
-                    '指向
-                    Dim AnimList As New List(Of AniData)
+                Dim AnimList As New List(Of AniData)
+                If Not IsEnabled Then
+                    AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrushGray5", AnimationColorIn))
+                ElseIf IsMouseOver Then '指向
                     Select Case Theme
                         Case Themes.Color
                             AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn))
@@ -136,10 +122,7 @@
                         Case Themes.Custom
                             AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn))
                     End Select
-                    AniStart(AnimList, "MyIconButton Color " & Uuid)
-                Else
-                    '普通
-                    Dim AnimList As New List(Of AniData)
+                Else '普通
                     Select Case Theme
                         Case Themes.Color
                             AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
@@ -157,36 +140,37 @@
                             AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut))
                             PanBack.Background = New MyColor(0, 255, 255, 255)
                     End Select
-                    AniStart(AnimList, "MyIconButton Color " & Uuid)
                 End If
-
+                AniStart(AnimList, "MyIconButton Color " & Uuid)
             Else
-
                 AniStop("MyIconButton Color " & Uuid)
-                Select Case Theme
-                    Case Themes.Color
-                        Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
-                    Case Themes.White
-                        Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
-                    Case Themes.Red
-                        Path.Fill = New MyColor(160, 255, 76, 76)
-                    Case Themes.Black
-                        Path.Fill = New MyColor(160, 0, 0, 0)
-                    Case Themes.Custom
-                        Path.Fill = New MyColor(160, Foreground)
-                End Select
+                If IsEnabled Then
+                    Select Case Theme
+                        Case Themes.Color
+                            Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
+                        Case Themes.White
+                            Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
+                        Case Themes.Red
+                            Path.Fill = New MyColor(160, 255, 76, 76)
+                        Case Themes.Black
+                            Path.Fill = New MyColor(160, 0, 0, 0)
+                        Case Themes.Custom
+                            Path.Fill = New MyColor(160, Foreground)
+                    End Select
+                Else
+                    Path.SetResourceReference(Shape.FillProperty, "ColorBrushGray5")
+                End If
                 PanBack.Background = New MyColor(0, 255, 255, 255)
-
             End If
         Catch ex As Exception
-            Log(ex, "刷新图标按钮动画状态出错")
+            Logger.Warn(ex, "刷新图标按钮动画状态出错")
         End Try
     End Sub
 
 End Class
 Partial Public Module ModAnimation
     Public Sub AniDispose(Control As MyIconButton, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
-        If Not Control.IsHitTestVisible Then Exit Sub
+        If Not Control.IsHitTestVisible Then Return
         Control.IsHitTestVisible = False
         AniStart({
                  AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent),

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

@@ -1,4 +1,4 @@
-<Border x:Name="PanBack" x:Class="MyIconTextButton"
+<Border x:Name="PanBack" x:Class="MyIconTextButton"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">

+ 5 - 26
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb

@@ -1,4 +1,4 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyIconTextButton
@@ -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 事件
 
     '自定义属性
 
@@ -72,11 +69,11 @@ Public Class MyIconTextButton
     Public Event Click(sender As Object, e As RouteEventArgs)
     Private IsMouseDown As Boolean = False
     Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
-        If Not IsMouseDown Then Exit Sub
-        Log("[Control] 按下带图标按钮:" & Text)
+        If Not IsMouseDown Then Return
+        Logger.Info($"按下带图标按钮:{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))
 
     '动画
 
@@ -187,7 +166,7 @@ Public Class MyIconTextButton
 
             End If
         Catch ex As Exception
-            Log(ex, "刷新带图标按钮颜色出错")
+            Logger.Warn(ex, "刷新带图标按钮颜色出错")
         End Try
     End Sub
 

+ 37 - 70
Plain Craft Launcher 2/Controls/MyImage.vb

@@ -1,4 +1,4 @@
-Public Class MyImage
+Public Class MyImage
     Inherits Image
 
 #Region "公开属性"
@@ -25,7 +25,7 @@
 
     ''' <summary>
     ''' 与 Image 的 Source 类似。
-    ''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。
+    ''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存。
     ''' 支持 WebP 格式的图片。
     ''' </summary>
     Public Shadows Property Source As String '覆写 Image 的 Source 属性
@@ -34,9 +34,9 @@
         End Get
         Set(value As String)
             If value = "" Then value = Nothing
-            If _Source = value Then Exit Property
+            If _Source = value Then Return
             _Source = value
-            If Not IsInitialized Then Exit Property '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
+            If Not IsInitialized Then Return '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
             Load()
         End Set
     End Property
@@ -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
@@ -82,15 +82,15 @@
         End Get
         Set(value As String)
             If value = "" Then value = Nothing
-            If _ActualSource = value Then Exit Property
+            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})")
+                Logger.Warn(ex, $"加载图片失败({value})")
                 Try
-                    If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
+                    If value.StartsWithF(PathTemp) Then FileUtils.Delete(value)
                 Catch
                 End Try
             End Try
@@ -103,87 +103,54 @@
         '空
         If Source Is Nothing Then
             ActualSource = Nothing
-            Exit Sub
+            Return
         End If
         '本地图片
         If Not Source.StartsWithF("http") Then
             ActualSource = Source
-            Exit Sub
+            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\{Source.GetStableHashCode()}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串,避免冲突
+        Dim TempFile = FileUtils.GetInfo(TempPath)
         If EnableCache AndAlso TempFile.Exists Then
-            ActualSource = TempPath
-            If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
+            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 FileUtils.Delete(TempPath)
             Catch ex As Exception
                 Try
-                    If TempPath IsNot Nothing Then File.Delete(TempPath)
-                    If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
+                    If TempPath IsNot Nothing Then FileUtils.Delete(TempPath)
                 Catch
                 End Try
-                If Not Retried Then
-                    '更换备用地址
-                    Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer)
-                    Retried = True
-                    Url = If(FallbackSource, Source)
-                    '空
-                    If Url Is Nothing Then
-                        ActualSource = Nothing
-                        Exit Sub
-                    End If
-                    '本地图片
-                    If Not Url.StartsWithF("http") Then
-                        ActualSource = Url
-                        Exit Sub
-                    End If
-                    '从缓存加载网络图片
-                    TempPath = GetTempPath(Url)
-                    TempFile = New FileInfo(TempPath)
-                    If EnableCache AndAlso TempFile.Exists() Then
-                        ActualSource = TempPath
-                        If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
-                    End If
-                    '下载
-                    If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
-                    GoTo RetryStart
+                '加载本地备用图片
+                If IsLocalFallback Then
+                    Try
+                        ActualSource = FallbackSource
+                        Logger.Warn(ex, $"下载图片失败,使用本地备用图片({Source})")
+                        Return
+                    Catch exx As Exception
+                        Logger.Error(ex, $"下载图片失败({Source})", LogBehavior.Toast)
+                        Logger.Error(exx, $"加载备用图片失败({FallbackSource})", LogBehavior.Toast)
+                    End Try
                 Else
-                    Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
+                    Logger.Error(ex, $"下载图片失败({Source},备用:{FallbackSource})", LogBehavior.Toast)
                 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

+ 1 - 1
Plain Craft Launcher 2/Controls/MyListItem.xaml

@@ -1,4 +1,4 @@
-<Grid x:Class="MyListItem"
+<Grid x:Class="MyListItem"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              x:Name="PanBack"

+ 32 - 49
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb

@@ -1,4 +1,4 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyListItem
@@ -174,7 +174,7 @@ Public Class MyListItem
             Return GetValue(TitleProperty)
         End Get
         Set(value As String)
-            SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, ""))
+            SetValue(TitleProperty, value.ReplaceLineEndings(""))
         End Set
     End Property
     Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
@@ -197,8 +197,8 @@ Public Class MyListItem
             Return _Info
         End Get
         Set(value As String)
-            If _Info = value Then Exit Property
-            value = value.Replace(vbCr, "").Replace(vbLf, "")
+            If _Info = value Then Return
+            value = value.ReplaceLineEndings("")
             _Info = value
             LabInfo.Text = value
             LabInfo.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
@@ -212,7 +212,7 @@ Public Class MyListItem
             Return _Logo
         End Get
         Set(value As String)
-            If _Logo = value Then Exit Property
+            If _Logo = value Then Return
             _Logo = value
             '删除旧 Logo
             If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
@@ -297,7 +297,7 @@ Public Class MyListItem
             Return _Type
         End Get
         Set(value As CheckType)
-            If _Type = value Then Exit Property
+            If _Type = value Then Return
             _Type = value
             '切换左栏大小
             ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
@@ -312,7 +312,8 @@ Public Class MyListItem
             Else
                 '添加竖条控件
                 If IsNothing(RectCheck) Then
-                    RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
+                    RectCheck = New Border With {
+                        .Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
                         .VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
                         .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
                         .Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))}
@@ -367,35 +368,36 @@ Public Class MyListItem
                     RaiseEvent Changed(Me, ChangedEventArgs)
                     If ChangedEventArgs.Handled Then
                         _Checked = RawValue
-                        Exit Sub
+                        Return
                     End If
                 End If
                 _Checked = value
             Else
-                If value = _Checked Then Exit Sub
+                If value = _Checked Then Return
                 _Checked = value
                 If IsInitialized Then
                     RaiseEvent Changed(Me, ChangedEventArgs)
                     If ChangedEventArgs.Handled Then
                         _Checked = RawValue
-                        Exit Sub
+                        Return
                     End If
                 End If
             End If
             If value Then
                 Dim CheckEventArgs As New RouteEventArgs(user)
                 RaiseEvent Check(Me, CheckEventArgs)
-                If CheckEventArgs.Handled Then Exit Sub
+                If CheckEventArgs.Handled Then Return
             End If
 
             '保证只有一个单选 ListItem 选中
 
             If Type = CheckType.RadioBox Then
-                If IsNothing(Parent) Then Exit Sub
+                If IsNothing(Parent) Then Return
                 Dim RadioboxList As New List(Of 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
@@ -478,7 +480,7 @@ Public Class MyListItem
             End If
 
         Catch ex As Exception
-            Log(ex, "设置 Checked 失败")
+            Logger.Warn(ex, "设置 Checked 失败")
         End Try
     End Sub
 
@@ -502,24 +504,24 @@ Public Class MyListItem
 
     '触发点击事件
     Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
-        If Not IsMouseDown Then Exit Sub
+        If Not IsMouseDown Then Return
         RaiseEvent Click(sender, e)
-        If e.Handled Then Exit Sub
+        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 Exit Sub
+        If e.Handled Then Return
         '实际的单击处理
         Select Case Type
             Case CheckType.Clickable
-                Log("[Control] 按下单击列表项:" & Title)
+                Logger.Info($"按下单击列表项:{Title}")
             Case CheckType.RadioBox
-                Log("[Control] 按下单选列表项:" & Title)
+                Logger.Info($"按下单选列表项:{Title}")
                 If Not Checked Then SetChecked(True, True, True)
             Case CheckType.CheckBox
-                Log("[Control] 按下复选列表项(" & (Not Checked).ToString & "):" & Title)
+                Logger.Info($"按下复选列表项({Not Checked}):{Title}")
                 SetChecked(Not Checked, True, True)
         End Select
     End Sub
@@ -537,34 +539,14 @@ 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
     Public IsMouseOverAnimationEnabled As Boolean = True
-    Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
+    Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp
         '菜单虚拟化检测
         If ContentHandler IsNot Nothing Then
-            ContentHandler(sender, e)
+            ContentHandler(Me, e)
             ContentHandler = Nothing
         End If
         '判断当前颜色
@@ -581,7 +563,7 @@ Public Class MyListItem
                 Time = 180
             End If
         End If
-        If StateLast = StateNew Then Exit Sub
+        If StateLast = StateNew Then Return
         StateLast = StateNew
         '触发颜色动画
         If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -657,13 +639,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
+                Logger.Error(ex, "设置帮助 MyListItem 失败", LogBehavior.Alert)
+                CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
+                CustomEventService.SetEventData(Me, "")
             End Try
         End If
     End Sub

+ 1 - 1
Plain Craft Launcher 2/Controls/MyLoading.xaml

@@ -1,4 +1,4 @@
-<Grid
+<Grid
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyLoading"
              MinWidth="50" MinHeight="50" Background="{StaticResource ColorBrushSemiTransparent}">

+ 31 - 38
Plain Craft Launcher 2/Controls/MyLoading.xaml.vb

@@ -1,4 +1,4 @@
-Imports PCL.MyLoading
+Imports PCL.MyLoading
 
 Public Class MyLoading
 
@@ -35,7 +35,7 @@ Public Class MyLoading
             Return _ShowProgress
         End Get
         Set(value As Boolean)
-            If _ShowProgress = value Then Exit Property
+            If _ShowProgress = value Then Return
             _ShowProgress = value
             RefreshText()
         End Set
@@ -76,14 +76,8 @@ Public Class MyLoading
                     If Ex Is Nothing Then
                         LabText.Text = "未知错误"
                     Else
-                        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
+                        Ex = Ex.RootException()
+                        LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", Ex.Message)
                     End If
                 Else
                     LabText.Text = TextError
@@ -142,7 +136,7 @@ Public Class MyLoading
             Return _OuterState
         End Get
         Set(value As MyLoadingState)
-            If _OuterState = value Then Exit Property
+            If _OuterState = value Then Return
             Dim OldValue = _OuterState
             _OuterState = value
             '引发事件
@@ -159,7 +153,7 @@ Public Class MyLoading
             Return _InnerState
         End Get
         Set(value As MyLoadingState)
-            If _InnerState = value Then Exit Property
+            If _InnerState = value Then Return
             Dim OldValue = _InnerState
             _InnerState = value
             '引发事件
@@ -183,34 +177,33 @@ Public Class MyLoading
     Private IsLooping As Boolean = False
     Private Sub AniLoop()
         '这坨循环代码也是老屎坑了,救救.jpg
-        If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
+        If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Return
         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>
@@ -271,7 +264,7 @@ Public Class MyLoadingStateSimulator
             Return _LoadingState
         End Get
         Set(value As MyLoadingState)
-            If _LoadingState = value Then Exit Property
+            If _LoadingState = value Then Return
             Dim OldState = _LoadingState
             _LoadingState = value
             RaiseEvent LoadingStateChanged(value, OldState)

+ 8 - 3
Plain Craft Launcher 2/Controls/MyMenuItem.vb

@@ -1,4 +1,4 @@
-Public Class MyMenuItem
+Public Class MyMenuItem
     Inherits MenuItem
 
     Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
@@ -7,7 +7,9 @@
             If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
         End If
         '对父级设置透明度
-        CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
+        If TypeOf Parent Is ContextMenu Then
+            CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
+        End If
     End Sub
 
     '基础
@@ -37,7 +39,7 @@
             Time = AnimationTimeOut
         End If
         '重复性验证
-        If ColorName = BackName Then Exit Sub
+        If ColorName = BackName Then Return
         ColorName = BackName
         '触发颜色动画
         If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -54,4 +56,7 @@
         End If
     End Sub
 
+    Private Sub MyMenuItem_Click(sender As Object, e As RoutedEventArgs) Handles Me.Click
+        RaiseCustomEvent()
+    End Sub
 End Class

+ 1 - 1
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml

@@ -1,4 +1,4 @@
-<Grid x:Class="MyMsgInput"
+<Grid x:Class="MyMsgInput"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:my="clr-namespace:PCL"

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

@@ -1,4 +1,4 @@
-Public Class MyMsgInput
+Public Class MyMsgInput
 
     Private ReadOnly MyConverter As MyMsgBoxConverter
     Private ReadOnly Uuid As Integer = GetUuid()
@@ -26,7 +26,7 @@
             ShapeLine.StrokeThickness = GetWPFSize(1)
 
         Catch ex As Exception
-            Log(ex, "输入弹窗初始化失败", LogLevel.Hint)
+            Logger.Error(ex, "输入弹窗初始化失败", LogBehavior.Toast)
         End Try
     End Sub
 
@@ -46,10 +46,10 @@
                 AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
             }, "MyMsgBox " & Uuid)
             '记录日志
-            Log("[Control] 输入弹窗:" & LabTitle.Text)
+            Logger.Info($"输入弹窗:{LabTitle.Text}")
 
         Catch ex As Exception
-            Log(ex, "输入弹窗加载失败", LogLevel.Hint)
+            Logger.Error(ex, "输入弹窗加载失败", LogBehavior.Toast)
         End Try
     End Sub
     Private Sub Close()
@@ -73,13 +73,13 @@
 
     Public Sub Btn1_Click() Handles Btn1.Click
         TextArea.Validate() '#5773
-        If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub
+        If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Return
         MyConverter.IsExited = True
         MyConverter.Result = TextArea.Text
         Close()
     End Sub
     Public Sub Btn2_Click() Handles Btn2.Click
-        If MyConverter.IsExited Then Exit Sub
+        If MyConverter.IsExited Then Return
         MyConverter.IsExited = True
         MyConverter.Result = Nothing
         Close()

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

@@ -1,4 +1,4 @@
-<Grid x:Class="MyMsgSelect"
+<Grid x:Class="MyMsgSelect"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:my="clr-namespace:PCL"

+ 9 - 7
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb

@@ -1,4 +1,4 @@
-Public Class MyMsgSelect
+Public Class MyMsgSelect
 
     Private ReadOnly MyConverter As MyMsgBoxConverter
     Private ReadOnly Uuid As Integer = GetUuid()
@@ -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
@@ -33,7 +35,7 @@
             Next
 
         Catch ex As Exception
-            Log(ex, "选择弹窗初始化失败", LogLevel.Hint)
+            Logger.Error(ex, "选择弹窗初始化失败", LogBehavior.Toast)
         End Try
     End Sub
 
@@ -51,10 +53,10 @@
                 AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
             }, "MyMsgBox " & Uuid)
             '记录日志
-            Log("[Control] 选择弹窗:" & LabTitle.Text)
+            Logger.Info($"选择弹窗:{LabTitle.Text}")
 
         Catch ex As Exception
-            Log(ex, "选择弹窗加载失败", LogLevel.Hint)
+            Logger.Error(ex, "选择弹窗加载失败", LogBehavior.Toast)
         End Try
     End Sub
     Private Sub Close()
@@ -77,13 +79,13 @@
     End Sub
 
     Public Sub Btn1_Click() Handles Btn1.Click
-        If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub
+        If MyConverter.IsExited OrElse SelectedIndex = -1 Then Return
         MyConverter.IsExited = True
         MyConverter.Result = SelectedIndex
         Close()
     End Sub
     Public Sub Btn2_Click() Handles Btn2.Click
-        If MyConverter.IsExited Then Exit Sub
+        If MyConverter.IsExited Then Return
         MyConverter.IsExited = True
         MyConverter.Result = Nothing
         Close()

+ 1 - 1
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml

@@ -1,4 +1,4 @@
-<Grid x:Class="MyMsgText"
+<Grid x:Class="MyMsgText"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:my="clr-namespace:PCL"

+ 7 - 7
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb

@@ -1,4 +1,4 @@
-Public Class MyMsgText
+Public Class MyMsgText
 
     Private ReadOnly MyConverter As MyMsgBoxConverter
     Private ReadOnly Uuid As Integer = GetUuid()
@@ -25,7 +25,7 @@
             ShapeLine.StrokeThickness = GetWPFSize(1)
 
         Catch ex As Exception
-            Log(ex, "普通弹窗初始化失败", LogLevel.Hint)
+            Logger.Error(ex, "普通弹窗初始化失败", LogBehavior.Toast)
         End Try
     End Sub
 
@@ -44,10 +44,10 @@
                 AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
             }, "MyMsgBox " & Uuid)
             '记录日志
-            Log("[Control] 普通弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
+            Logger.Info($"普通弹窗:{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
 
         Catch ex As Exception
-            Log(ex, "普通弹窗加载失败", LogLevel.Hint)
+            Logger.Error(ex, "普通弹窗加载失败", LogBehavior.Toast)
         End Try
     End Sub
     Private Sub Close()
@@ -70,7 +70,7 @@
     End Sub
 
     Public Sub Btn1_Click() Handles Btn1.Click
-        If MyConverter.IsExited Then Exit Sub
+        If MyConverter.IsExited Then Return
         If MyConverter.Button1Action IsNot Nothing Then
             MyConverter.Button1Action()
         Else
@@ -80,7 +80,7 @@
         End If
     End Sub
     Public Sub Btn2_Click() Handles Btn2.Click
-        If MyConverter.IsExited Then Exit Sub
+        If MyConverter.IsExited Then Return
         If MyConverter.Button2Action IsNot Nothing Then
             MyConverter.Button2Action()
         Else
@@ -90,7 +90,7 @@
         End If
     End Sub
     Public Sub Btn3_Click() Handles Btn3.Click
-        If MyConverter.IsExited Then Exit Sub
+        If MyConverter.IsExited Then Return
         If MyConverter.Button3Action IsNot Nothing Then
             MyConverter.Button3Action()
         Else

+ 18 - 20
Plain Craft Launcher 2/Controls/MyPageLeft.vb

@@ -1,17 +1,17 @@
-Public Class MyPageLeft
+Public Class MyPageLeft
     Inherits Grid
     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
@@ -39,16 +40,17 @@
                     Element.Opacity = 0
                     Element.RenderTransform = New TranslateTransform(-25, 0)
                     If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
-                    AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
+                    AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
                     AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
                     AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
                     If TypeOf Element Is MyListItem Then
-                        AniList.Add(AaCode(Sub()
-                                               CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
-                                               CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
-                                           End Sub, Delay + 280))
+                        AniList.Add(AaCode(
+                        Sub()
+                            CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
+                            CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
+                        End Sub, Delay + 280))
                     End If
-                    Delay += Math.Max(8, 20 - Id) * 2.5
+                    Delay += Math.Max(15 - Id, 7) * 2
                     Id += 1
                 End If
             Next
@@ -63,8 +65,8 @@
                 RenderTransformOrigin = New Point(0.5, 0.5)
             End If
             AniStart({
-                AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 130,, New AniEaseInFluent(AniEasePower.Weak)),
-                AaOpacity(Me, -Opacity, 100, 30)
+                AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 110,, New AniEaseInFluent(AniEasePower.Weak)),
+                AaOpacity(Me, -Opacity, 80, 30)
             }, "PageLeft PageChange " & Uuid)
         Else
             '逐个退出动画
@@ -72,8 +74,8 @@
             Dim Id As Integer = 0
             Dim Controls = GetAllAnimControls()
             For Each Element As FrameworkElement In Controls
-                AniList.Add(AaOpacity(Element, -Element.Opacity, 60, 80 / Controls.Count * Id))
-                AniList.Add(AaTranslateX(Element, -6, 60, 80 / Controls.Count * Id))
+                AniList.Add(AaOpacity(Element, -Element.Opacity, 50, 70 / Controls.Count * Id))
+                AniList.Add(AaTranslateX(Element, -6, 50, 70 / Controls.Count * Id))
                 Id += 1
             Next
             AniStart(AniList, "PageLeft PageChange " & Uuid)
@@ -83,11 +85,11 @@
     '遍历获取所有需要生成动画的控件
     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)
-        If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
+        If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
         If TypeOf Element Is MyTextButton Then
             AllControls.Add(Element)
         ElseIf TypeOf Element Is MyListItem Then
@@ -104,7 +106,3 @@
     End Sub
 
 End Class
-
-Public Interface IRefreshable
-    Sub Refresh()
-End Interface

+ 103 - 52
Plain Craft Launcher 2/Controls/MyPageRight.vb

@@ -1,18 +1,18 @@
-Public Class MyPageRight
+Public Class MyPageRight
     Inherits AdornerDecorator
     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
@@ -33,9 +33,9 @@
             Return _PageState
         End Get
         Set(value As PageStates)
-            If _PageState = value Then Exit Property
+            If _PageState = value Then Return
             _PageState = value
-            If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
+            Logger.Trace($"页面状态切换为 {value}")
         End Set
     End Property
 
@@ -59,9 +59,9 @@
     ''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
     ''' <param name="RealLoader">在工作线程执行的加载器。</param>
     ''' <param name="FinishedInvoke">当加载器执行完成,在 UI 线程触发的 UI 初始化事件。</param>
-    Public Sub PageLoaderInit(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
-                              RealLoader As LoaderBase,
-                              Optional FinishedInvoke As Action(Of LoaderBase) = Nothing, Optional InputInvoke As Func(Of Object) = Nothing,
+    Public Sub PageLoaderInit(Of TIn, TOut)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
+                              RealLoader As LoaderTask(Of TIn, TOut),
+                              Optional FinishedInvoke As Action(Of LoaderTask(Of TIn, TOut)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
                               Optional AutoRun As Boolean = True)
         '初始化参数
         Me.PanLoader = PanLoader
@@ -89,13 +89,59 @@
         If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
         '初次运行加载器
         If PageLoaderAutoRun Then
-            If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
-                PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
-            Else
-                Dim Input = Nothing
-                If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
-                PageLoader.Start(Input)
-            End If
+            '上下两个重载只有这里不一样
+            PageLoader.Start(RealLoader.StartGetInput(Nothing, PageLoaderInputInvoke))
+        End If
+        If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
+            RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成,直接触发事件
+        End If
+        '设置加载环
+        PageLoaderUi.State = RealLoader
+        AddHandler PageLoaderUi.Click, Sub() If RealLoader.State = LoadState.Failed Then PageLoaderRestart() '点击重试事件
+    End Sub
+    ''' <summary>
+    ''' 表明页面存在需要在后台执行的加载器。
+    ''' </summary>
+    ''' <param name="LoaderUi">MyLoading 控件。</param>
+    ''' <param name="PanLoader">MyLoading 控件对应的卡片。</param>
+    ''' <param name="PanContent">加载结束后出现的内容容器。</param>
+    ''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
+    ''' <param name="RealLoader">在工作线程执行的加载器。</param>
+    ''' <param name="FinishedInvoke">当加载器执行完成,在 UI 线程触发的 UI 初始化事件。</param>
+    Public Sub PageLoaderInit(Of TIn)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
+                              RealLoader As LoaderCombo(Of TIn),
+                              Optional FinishedInvoke As Action(Of LoaderCombo(Of TIn)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
+                              Optional AutoRun As Boolean = True)
+        '初始化参数
+        Me.PanLoader = PanLoader
+        Me.PanContent = PanContent
+        Me.PanAlways = PanAlways
+        Me.PageLoader = RealLoader
+        Me.PageLoaderUi = LoaderUi
+        Me.PageLoaderInputInvoke = InputInvoke
+        Me.PageLoaderAutoRun = AutoRun
+        '添加结束 Invoke
+        If FinishedInvoke IsNot Nothing Then
+            AddHandler RealLoader.PreviewFinish,
+            Sub()
+                Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
+                    Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
+                Loop
+                RunInUiWait(Sub() FinishedInvoke(RealLoader))
+                Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
+            End Sub
+        End If
+        AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
+        '隐藏 UI
+        PanLoader.Visibility = Visibility.Collapsed
+        PanContent.Visibility = Visibility.Collapsed
+        If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
+        '初次运行加载器
+        If PageLoaderAutoRun Then
+            '上下两个重载只有这里不一样
+            Dim Input = Nothing
+            If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
+            PageLoader.Start(Input)
         End If
         If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
             RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成,直接触发事件
@@ -106,8 +152,8 @@
     End Sub
     '重试
     Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
-        If Not PageLoaderAutoRun Then Exit Sub
-        If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
+        If Not PageLoaderAutoRun Then Return
+        If GeneralUtils.IsGenericInstanceOf(PageLoader, GetType(LoaderTask(Of ,))) OrElse TypeOf PageLoader Is LoaderWorker Then
             PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
         Else
             If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
@@ -125,36 +171,37 @@
     ''' 需要根据加载器状态,从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。
     ''' </summary>
     Public Sub PageOnEnter()
-        If ModeDebug Then Log("[UI] 已触发 PageOnEnter")
+        Logger.Trace("已触发 PageOnEnter")
         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.Canceled 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.Canceled 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 事件。")
+                Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnter 事件。")
         End Select
     End Sub
     Public Event PageEnter()
@@ -163,7 +210,7 @@
     ''' 需要立即切换至 PageExit 或 Empty。
     ''' </summary>
     Public Sub PageOnExit()
-        If ModeDebug Then Log("[UI] 已触发 PageOnExit")
+        Logger.Trace("已触发 PageOnExit")
         RaiseEvent PageExit()
         Select Case PageState
             Case PageStates.ContentEnter, PageStates.ContentStay
@@ -187,8 +234,8 @@
     ''' 需要立即切换至 Empty。
     ''' </summary>
     Public Sub PageOnForceExit()
-        If PageState = PageStates.Empty Then Exit Sub
-        If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
+        If PageState = PageStates.Empty Then Return
+        Logger.Trace("已触发 PageOnForceExit")
         PageState = PageStates.Empty
         AniStop("PageRight PageChange " & PageUuid)
         '由于动画会被强制中止,所以需要手动进行隐藏
@@ -205,10 +252,10 @@
     ''' 需要在 PageEnter 事件确认要显示的子页面有哪些。
     ''' </summary>
     Public Sub PageOnContentExit()
-        If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
+        Logger.Trace("已触发 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 +266,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
 
@@ -230,7 +281,7 @@
     ''' 需要根据目前状态,从 ContentEnter 切换到 ContentStay,或从 LoaderEnter 切换到 LoaderStayForce。
     ''' </summary>
     Private Sub PageOnEnterAnimationFinished()
-        If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished")
+        Logger.Trace("已触发 PageOnEnterAnimationFinished")
         Select Case PageState
             Case PageStates.ContentEnter
                 PageState = PageStates.ContentStay
@@ -238,7 +289,7 @@
                 PageState = PageStates.LoaderStayForce
                 AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid)
             Case Else
-                Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。")
+                Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnterAnimationFinished 事件。")
         End Select
     End Sub
     ''' <summary>
@@ -246,7 +297,7 @@
     ''' 需要根据目前状态,从 AllExit 切换到 Empty,或从 LoaderExit 切换到 ContentEnter,或从 ContentExit 重新触发 PageOnEnter。
     ''' </summary>
     Private Sub PageOnExitAnimationFinished()
-        If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished")
+        Logger.Trace("已触发 PageOnExitAnimationFinished")
         Select Case PageState
             Case PageStates.PageExit
                 PageState = PageStates.Empty
@@ -256,7 +307,7 @@
                 PageState = PageStates.ContentEnter
                 TriggerEnterAnimation(PanContent)
             Case Else
-                Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。")
+                Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnExitAnimationFinished 事件。")
         End Select
     End Sub
     ''' <summary>
@@ -264,7 +315,7 @@
     ''' 需要从 LoaderWait 切换到 LoaderEnter。
     ''' </summary>
     Private Sub PageOnLoaderWaitFinished()
-        If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished")
+        Logger.Trace("已触发 PageOnLoaderWaitFinished")
         Select Case PageState
             Case PageStates.LoaderWait
                 PageState = PageStates.LoaderEnter
@@ -274,7 +325,7 @@
                     TriggerEnterAnimation(PanLoader)
                 End If
             Case Else
-                Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
+                Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
         End Select
     End Sub
     ''' <summary>
@@ -282,7 +333,7 @@
     ''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。
     ''' </summary>
     Private Sub PageOnLoaderStayFinished()
-        If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished")
+        Logger.Trace("已触发 PageOnLoaderStayFinished")
         Select Case PageState
             Case PageStates.LoaderStayForce
                 If PageLoader.State = LoadState.Finished Then
@@ -292,7 +343,7 @@
                     PageState = PageStates.LoaderStay
                 End If
             Case Else
-                Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
+                Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
         End Select
     End Sub
 
@@ -302,8 +353,8 @@
     Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState)
         Select Case NewState
             Case LoadState.Failed, LoadState.Loading
-                If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Exit Sub
-                If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
+                If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
+                Logger.Trace("已触发 PageLoaderState (Start/Refresh)")
                 '(重新)开始运行
                 '需要从部分状态切换到 ReloadExit
                 Select Case PageState
@@ -313,9 +364,9 @@
                     Case PageStates.LoaderExit
                         PageState = PageStates.ContentExit
                 End Select
-            Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting
-                If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Exit Sub
-                If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
+            Case LoadState.Finished, LoadState.Canceled, LoadState.Waiting
+                If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
+                Logger.Trace("已触发 PageLoaderState (Stop/Canceled)")
                 '运行结束
                 '需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
                 Select Case PageState
@@ -358,10 +409,10 @@
                 Else
                     Control.Opacity = 0
                     Control.RenderTransform = New TranslateTransform(0, -16)
-                    AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
+                    AniList.Add(AaOpacity(Control, 1, 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
                     AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
                     AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
-                    Delay += 40
+                    Delay += 25
                 End If
             Next
         Next
@@ -373,7 +424,7 @@
         End If
         '结束
         AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
-        AniStart(AniList, "PageRight PageChange " & PageUuid)
+        AniStart(AniList, "PageRight PageChange " & PageUuid, True)
     End Sub
 
     '逐个退出动画
@@ -387,9 +438,9 @@
                     CType(Control, MyExtraTextButton).Show = False
                 Else
                     Control.IsHitTestVisible = False
-                    AniList.Add(AaOpacity(Control, -1, 90, Delay))
-                    AniList.Add(AaTranslateY(Control, -6, 90, Delay))
-                    Delay += 20
+                    AniList.Add(AaOpacity(Control, -1, 70, Delay))
+                    AniList.Add(AaTranslateY(Control, -6, 70, Delay))
+                    Delay += 15
                 End If
             Next
         Next
@@ -423,7 +474,7 @@
         Return AllControls.Except(DisabledPageAnimControls)
     End Function
     Private Sub _GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
-        If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
+        If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
         If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
             AllControls.Add(Element)
         ElseIf TypeOf Element Is ContentControl Then

+ 1 - 1
Plain Craft Launcher 2/Controls/MyRadioBox.xaml

@@ -1,4 +1,4 @@
-<Grid x:Class="MyRadioBox"
+<Grid x:Class="MyRadioBox"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              FocusVisualStyle="{x:Null}"

+ 63 - 50
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb

@@ -1,8 +1,9 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
+Imports System.Windows.Shapes
 
 <ContentProperty("Inlines")>
 Public Class MyRadioBox
-    Implements IMyRadio
+    Implements IMyRadio, ISettingControl
 
     '基础
 
@@ -41,20 +42,20 @@ Public Class MyRadioBox
                 RaiseEvent PreviewCheck(Me, e)
                 If e.Handled Then
                     Radiobox_MouseLeave()
-                    Exit Sub
+                    Return
                 End If
             End If
 
             '自定义属性基础
             Dim IsChanged As Boolean = False
             If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
-            If Not value = Checked Then
+            If value <> Checked Then
                 SetValue(CheckedProperty, value)
                 IsChanged = True
             End If
 
-            '保证只有一个单选框选中
-            If Parent Is Nothing Then Exit Sub
+            '保证最多只有一个单选框选中
+            If Parent Is Nothing Then Return
             Dim RadioboxList As New List(Of MyRadioBox)
             Dim CheckedCount As Integer = 0
             For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
@@ -63,42 +64,38 @@ Public Class MyRadioBox
                     If Control.Checked Then CheckedCount += 1
                 End If
             Next
-            Select Case CheckedCount '判断选中情况
-                Case 0
-                    '没有任何单选框被选中,选择第一个
-                    RadioboxList(0).Checked = True
-                Case Is > 1
-                    '选中项目多于 1 个
-                    If Checked Then
-                        '如果本控件选中,则取消其他所有控件的选中
-                        For Each Control As MyRadioBox In RadioboxList
-                            If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
-                        Next
-                    Else
-                        '如果本控件未选中,则只保留第一个选中的控件
-                        Dim FirstChecked = False
-                        For Each Control As MyRadioBox In RadioboxList
-                            If Control.Checked Then
-                                If FirstChecked Then
-                                    Control.Checked = False '修改 Checked 会自动触发 Change 事件,所以不用额外触发
-                                Else
-                                    FirstChecked = True
-                                End If
+            If CheckedCount > 1 Then
+                If Checked Then
+                    '如果本控件选中,则取消其他所有控件的选中
+                    For Each Control As MyRadioBox In RadioboxList
+                        If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
+                    Next
+                Else
+                    '如果本控件未选中,则只保留第一个选中的控件
+                    Dim FirstChecked = False
+                    For Each Control As MyRadioBox In RadioboxList
+                        If Control.Checked Then
+                            If FirstChecked Then
+                                Control.Checked = False '修改 Checked 会自动触发 Change 事件,所以不用额外触发
+                            Else
+                                FirstChecked = True
                             End If
-                        Next
-                    End If
-            End Select
+                        End If
+                    Next
+                End If
+            End If
 
-            '触发事件
             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)
+            Logger.Error(ex, "单选框勾选改变错误", LogBehavior.Toast)
         End Try
     End Sub
     Private Sub SyncUI()
@@ -115,7 +112,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 +124,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 +137,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
@@ -172,8 +169,8 @@ Public Class MyRadioBox
     Private MouseDowned As Boolean = False
     Private AllowMouseDown As Boolean = True
     Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
-        If Not MouseDowned Then Exit Sub
-        Log("[Control] 按下单选框:" & Text)
+        If Not MouseDowned Then Return
+        Logger.Info($"按下单选框:{Text}")
         SetChecked(True, True)
         MouseDowned = False
         AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
@@ -187,7 +184,7 @@ Public Class MyRadioBox
         End If
     End Sub
     Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
-        If Not MouseDowned Then Exit Sub
+        If Not MouseDowned Then Return
         MouseDowned = False
         AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
         If Not Checked Then
@@ -208,15 +205,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
@@ -224,16 +221,32 @@ Public Class MyRadioBox
         AniStart(AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox TextColor " & Uuid)
     End Sub
     Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
-        If Not Me.IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
+        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

+ 1 - 1
Plain Craft Launcher 2/Controls/MyRadioButton.xaml

@@ -1,4 +1,4 @@
-<Border x:Name="PanBack" x:Class="MyRadioButton"
+<Border x:Name="PanBack" x:Class="MyRadioButton"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">

+ 15 - 19
Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb

@@ -1,4 +1,4 @@
-Imports System.Windows.Markup
+Imports System.Windows.Markup
 
 <ContentProperty("Inlines")>
 Public Class MyRadioButton
@@ -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 Exit Sub
+            If Parent Is Nothing Then Return
             Dim RadioboxList As New List(Of MyRadioButton)
             Dim CheckedCount As Integer = 0
             '收集控件列表与选中个数
@@ -101,14 +96,15 @@ Public Class MyRadioButton
 
             '更改动画
 
-            If Not IsChanged Then Exit Sub
+            If Not IsChanged Then Return
             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)
+            Logger.Error(ex, "单选按钮勾选改变错误", LogBehavior.Toast)
         End Try
     End Sub
 
@@ -147,17 +143,17 @@ Public Class MyRadioButton
     Public Event PreviewClick(sender As Object, e As RouteEventArgs)
     Private IsMouseDown As Boolean = False
     Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
-        If Checked Then Exit Sub
-        If Not IsMouseDown Then Exit Sub
-        Log("[Control] 按下单选按钮:" & Text)
+        If Checked Then Return
+        If Not IsMouseDown Then Return
+        Logger.Info($"按下单选按钮:{Text}")
         IsMouseDown = False
         Dim e As New RouteEventArgs(True)
         RaiseEvent PreviewClick(Me, e)
-        If e.Handled Then Exit Sub
+        If e.Handled Then Return
         SetChecked(True, True, True)
     End Sub
     Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
-        If Checked Then Exit Sub
+        If Checked Then Return
         IsMouseDown = True
         RefreshColor()
     End Sub
@@ -259,7 +255,7 @@ Public Class MyRadioButton
 
             End If
         Catch ex As Exception
-            Log(ex, "刷新单选按钮颜色出错")
+            Logger.Warn(ex, "刷新单选按钮颜色出错")
         End Try
     End Sub
 

+ 1 - 1
Plain Craft Launcher 2/Controls/MyResizer.vb

@@ -1,4 +1,4 @@
-Imports System.Runtime.InteropServices
+Imports System.Runtime.InteropServices
 Imports System.Windows.Interop
 Imports System.Windows.Threading
 

+ 2 - 2
Plain Craft Launcher 2/Controls/MyScrollBar.vb

@@ -1,4 +1,4 @@
-Public Class MyScrollBar
+Public Class MyScrollBar
     Inherits Primitives.ScrollBar
 
     '基础
@@ -44,7 +44,7 @@
             End If
 
         Catch ex As Exception
-            Log(ex, "滚动条颜色改变出错")
+            Logger.Warn(ex, "滚动条颜色改变出错")
         End Try
     End Sub
 

+ 6 - 6
Plain Craft Launcher 2/Controls/MyScrollViewer.vb

@@ -1,20 +1,20 @@
-Public Class MyScrollViewer
+Public Class MyScrollViewer
     Inherits ScrollViewer
 
     Public Property DeltaMult As Double = 1
 
-
     Private RealOffset As Double
     Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
-        If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
+        If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
         Dim SourceType = e.Source.GetType
         If Content.TemplatedParent Is Nothing AndAlso (
                 (GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
                 (GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
                 GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
-                TypeOf e.Source Is CheckBox) Then
+                (TypeOf e.Source Is Visual AndAlso
+                    PresentationSource.FromVisual(e.Source)?.RootVisual?.GetType().FullName = "System.Windows.Controls.Primitives.PopupRoot")) Then
             '如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
-            Exit Sub
+            Return
         End If
         e.Handled = True
         PerformVerticalOffsetDelta(-e.Delta)
@@ -26,7 +26,7 @@
         AniStart(
             AaDouble(
             Sub(AnimDelta As Double)
-                RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
+                RealOffset = (RealOffset + AnimDelta).Clamp(0, ExtentHeight - ActualHeight)
                 ScrollToVerticalOffset(RealOffset)
             End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
     End Sub

+ 1 - 1
Plain Craft Launcher 2/Controls/MySearchBox.xaml

@@ -1,4 +1,4 @@
-<local:MyCard x:Class="MySearchBox"
+<local:MyCard x:Class="MySearchBox"
       xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
       xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
       xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 

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

@@ -1,4 +1,4 @@
-Class MySearchBox
+Class MySearchBox
     Inherits MyCard
 
     Public Event TextChanged(sender As Object, e As EventArgs)
@@ -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

+ 1 - 1
Plain Craft Launcher 2/Controls/MySlider.xaml

@@ -1,4 +1,4 @@
-<Border x:Class="MySlider"
+<Border x:Class="MySlider"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 

+ 32 - 13
Plain Craft Launcher 2/Controls/MySlider.xaml.vb

@@ -1,4 +1,7 @@
-Public Class MySlider
+Imports System.Windows.Shapes
+
+Public Class MySlider
+    Implements ISettingControl
 
     '基础
 
@@ -14,7 +17,7 @@
             Return _MaxValue
         End Get
         Set(value As Integer)
-            If value = _MaxValue Then Exit Property
+            If value = _MaxValue Then Return
             _MaxValue = value
             RefreshWidth(Nothing, Nothing)
         End Set
@@ -28,8 +31,8 @@
         Set(newValue As Integer)
             Try
 
-                newValue = MathClamp(newValue, 0, MaxValue)
-                If _Value = newValue Then Exit Property
+                newValue = newValue.Clamp(0, MaxValue)
+                If _Value = newValue Then Return
 
                 '触发 Preview 事件,修改新值
                 Dim OldValue = _Value
@@ -40,12 +43,12 @@
                     If e.Handled Then
                         _Value = OldValue
                         DragStop()
-                        Exit Property
+                        Return
                     End If
                 End If
 
                 If IsLoaded AndAlso AniControlEnabled = 0 Then
-                    If ActualWidth < ShapeDot.Width Then Exit Property
+                    If ActualWidth < ShapeDot.Width Then Return
                     Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
                     Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
                     Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
@@ -60,7 +63,7 @@
                 If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
 
             Catch ex As Exception
-                Log(ex, "滑动条进度改变出错", LogLevel.Hint)
+                Logger.Error(ex, "滑动条进度改变出错", LogBehavior.Toast)
             End Try
         End Set
     End Property
@@ -70,7 +73,7 @@
         Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
         LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
         LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
-        SetLeft(ShapeDot, NewWidth)
+        ShapeDot.Margin = New Thickness(NewWidth, ShapeDot.Margin.Top, ShapeDot.Margin.Right, ShapeDot.Margin.Bottom)
     End Sub
 
     '拖动
@@ -88,7 +91,7 @@
         AniStop("MySlider KeyPopup " & Uuid)
     End Sub
     Public Sub DragDoing()
-        Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
+        Dim Percent As Double = ((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width)).Clamp(0, 1)
         Dim NewValue As Integer = Percent * MaxValue
         If Not NewValue = Value Then
             Value = NewValue
@@ -103,7 +106,7 @@
         Popup.IsOpen = False
     End Sub
     Public Sub RefreshPopup()
-        If GetHintText Is Nothing Then Exit Sub
+        If GetHintText Is Nothing Then Return
         Popup.IsOpen = True
         TextHint.Text = GetHintText.DynamicInvoke(Value)
         Dim typeface As New Typeface(TextHint.FontFamily, TextHint.FontStyle, TextHint.FontWeight, TextHint.FontStretch)
@@ -153,7 +156,7 @@
             End If
 
         Catch ex As Exception
-            Log(ex, "滑动条颜色改变出错")
+            Logger.Warn(ex, "滑动条颜色改变出错")
         End Try
     End Sub
 
@@ -165,7 +168,7 @@
     End Sub
     Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
         '拒绝一边拖动一边用按键改变
-        If ReferenceEquals(Me, DragControl) Then Exit Sub
+        If ReferenceEquals(Me, DragControl) Then Return
         '改变值
         If e.Key = Key.Left Then
             ChangeByKey = True
@@ -178,7 +181,7 @@
             ChangeByKey = False
             e.Handled = True
         Else
-            Exit Sub
+            Return
         End If
         '更新 Popup
         If GetHintText IsNot Nothing Then
@@ -188,4 +191,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

+ 1 - 1
Plain Craft Launcher 2/Controls/MySliderDot.xaml

@@ -1,4 +1,4 @@
-<Border x:Class="MySliderDot"
+<Border x:Class="MySliderDot"
              xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
              xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
              xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 

+ 2 - 2
Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb

@@ -1,4 +1,4 @@
-Public Class MySliderDot
+Public Class MySliderDot
 
     '基础
 
@@ -59,7 +59,7 @@
                 If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
 
             Catch ex As Exception
-                Log(ex, "滑动条进度改变出错", LogLevel.Hint)
+                Logger.Warning(ex, "滑动条进度改变出错", LogLevel.Hint)
             End Try
         End Set
     End Property

+ 37 - 9
Plain Craft Launcher 2/Controls/MyTextBox.vb

@@ -1,5 +1,6 @@
-Public Class MyTextBox
+Public Class MyTextBox
     Inherits TextBox
+    Implements ISettingControl
 
     '自定义属性
 
@@ -36,7 +37,7 @@
     End Property
     Public Overrides Sub OnApplyTemplate()
         MyBase.OnApplyTemplate()
-        If HintText = "" OrElse labHint.Text <> "" Then Exit Sub
+        If HintText = "" OrElse labHint.Text <> "" Then Return
         labHint.Text = If(Text = "", HintText, "")
     End Sub
 
@@ -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)
@@ -217,11 +224,11 @@
             IsTextChanged = IsLoaded
             '进行输入验证
             Validate()
-            If Not IsValidated Then Exit Sub
+            If Not IsValidated Then Return
             '改变文本
             RaiseEvent ValidatedTextChanged(sender, e)
         Catch ex As Exception
-            Log(ex, "进行输入验证时出错", LogLevel.Assert)
+            Logger.Error(ex, "进行输入验证时出错")
         End Try
     End Sub
 
@@ -230,7 +237,7 @@
     Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
         Try
             '不对 ComboBox 从属进行动画
-            If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
+            If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Return
             '判断当前颜色
             Dim ForeColorName As String, BackColorName As String
             Dim AnimationTime As Integer
@@ -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
@@ -275,12 +282,12 @@
             End If
 
         Catch ex As Exception
-            Log(ex, "文本框颜色改变出错")
+            Logger.Warn(ex, "文本框颜色改变出错")
         End Try
     End Sub
     Private Sub RefreshTextColor() Handles Me.IsEnabledChanged
         Dim NewColor As MyColor = If(IsEnabled, ColorGray1, ColorGray4)
-        If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Exit Sub
+        If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Return
         If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then
             '有动画
             AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid)
@@ -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

+ 18 - 41
Plain Craft Launcher 2/Controls/MyTextButton.vb

@@ -1,4 +1,4 @@
-Public Class MyTextButton
+Public Class MyTextButton
     Inherits Label
 
     Public Event Click(sender As Object, e As EventArgs)
@@ -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
+        Logger.Info($"按下文本按钮:{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
@@ -72,7 +71,7 @@
             Time = AnimationTimeOut
         End If
         '重复性验证
-        If ColorName = ForeName Then Exit Sub
+        If ColorName = ForeName Then Return
         ColorName = ForeName
         '触发颜色动画
         If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -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 GeneralUtils.IsGenericInstanceOf(Element, GetType(MyVirtualizingElement(Of ))) 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

+ 11 - 12
Plain Craft Launcher 2/FormMain.xaml

@@ -1,4 +1,4 @@
-<Window
+<Window
     xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
     xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
     xmlns:local="clr-namespace:PCL"
@@ -95,13 +95,12 @@
                     <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">
-                            <GradientStop Color="{StaticResource ColorObject3}" Offset="0"/>
-                            <GradientStop Color="{StaticResource ColorObject2}" Offset="0.5"/>
-                            <GradientStop Color="{StaticResource ColorObject3}" Offset="1"/>
+                            <GradientStop Color="{StaticResource ColorObject4}" Offset="0"/>
                         </LinearGradientBrush>
                     </Grid.Background>
                     <local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
@@ -115,19 +114,19 @@
                             <ColumnDefinition Width="Auto" />
                             <ColumnDefinition Width="1*" />
                         </Grid.ColumnDefinitions>
-                        <Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" />
+                        <Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h6 a7,7 180 0 1 0,14 h-6 M62.5,6.5 a10,11.5 180 1 0 0,18 M71,2.5 v24.5 h13.5" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="2.2" Width="39" />
                         <TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" />
                         <local:MyImage x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
                         <StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0">
-                            <local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
-                                             LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" />
-                            <local:MyRadioButton x:Name="BtnTitleSelect1" Text="{DynamicResource LangTitleDownload}" Tag="1" Margin="5,0" Padding="2,0"
+                            <local:MyRadioButton x:Name="BtnTitleSelect0" Text="启动" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
+                                             LogoScale="0.9" Logo="M52.1,164.5c-1.4,0-3.1-0.5-4.2-1.3c-2.6-1.7-4-4.2-4-7V43.8c0-2.9,1.6-5.8,4.1-7c1.2-0.8,2.7-1.2,4.1-1.2c1.5,0,2.9,0.4,4.2,1.2L153.1,93c0,0,0.1,0,0.1,0.1c2.6,1.7,4,4.2,4,7c0,3-1.7,5.8-4.2,7.1l-96.8,56.2C55.1,164,53.5,164.5,52.1,164.5z M60.4,142.1l72.1-42.1L60.4,58.2V142.1z" />
+                            <local:MyRadioButton x:Name="BtnTitleSelect1" Text="下载" Tag="1" Margin="5,0" Padding="2,0"
                                              LogoScale="0.9" Logo="M955 610h-59c-15 0-29 13-29 29v196c0 15-13 29-29 29h-649c-15 0-29-13-29-29v-196c0-15-13-29-29-29h-59c-15 0-29 13-29 29V905c0 43 35 78 78 78h787c43 0 78-35 78-78V640c0-15-13-29-29-29zM492 740c11 11 29 11 41 0l265-265c11-11 11-29 0-41l-41-41c-11-11-29-11-41 0l-110 110c-11 11-33 3-33-13V68C571 53 555 39 541 39h-59c-15 0-29 13-29 29v417c0 17-21 25-33 13l-110-110c-11-11-29-11-41 0L226 433c-11 11-11 29 0 41L492 740z" />
                             <local:MyRadioButton x:Name="BtnTitleSelect2" Text="联机" Tag="2" Margin="5,0" Padding="2,0"
                                              LogoScale="1.05" Logo="M512 817c-48.601 0-88-39.399-88-88s39.399-88 88-88 88 39.399 88 88-39.399 88-88 88zM237.671 565.74C308.335 474.58 397.369 429 504.774 429c118.433 0 214.225 55.421 287.377 166.264l-53.407 30.369c-13.84 7.87-31.362 4.367-41.114-8.219-50.291-64.911-114.577-97.367-192.856-97.367-86.851 0-156.835 40.318-209.95 120.953l-47.995-28.02c-15.263-8.91-20.412-28.507-11.502-43.77a32 32 0 0 1 2.344-3.47zM107.691 419.47C205.24 278.491 337.805 208 505.379 208c178.77 0 317.694 80.224 416.772 240.672l-56.54 31.73c-13.686 7.68-30.922 4.303-40.697-7.975C735.581 360.213 629.07 303.009 505.38 300.815 373.997 298.485 261.637 362.88 168.3 494l-50.116-28.505c-15.362-8.738-20.732-28.275-11.994-43.637a32 32 0 0 1 1.5-2.387z"/>
-                            <local:MyRadioButton x:Name="BtnTitleSelect3" Text="{DynamicResource LangTitleSetup}" Tag="3" Margin="5,0" Padding="2,0"
+                            <local:MyRadioButton x:Name="BtnTitleSelect3" Text="设置" Tag="3" Margin="5,0" Padding="2,0"
                                              LogoScale="1.1" Logo="M940.4 463.7L773.3 174.2c-17.3-30-49.2-48.4-83.8-48.4H340.2c-34.6 0-66.5 18.5-83.8 48.4L89.2 463.7c-17.3 30-17.3 66.9 0 96.8L256.4 850c17.3 30 49.2 48.4 83.8 48.4h349.2c34.6 0 66.5-18.5 83.8-48.4l167.2-289.5c17.3-29.9 17.3-66.8 0-96.8z m-94.6 96.8L725.9 768.1c-17.3 30-49.2 48.4-83.8 48.4H387.5c-34.6 0-66.5-18.5-83.8-48.4L183.9 560.5c-17.3-30-17.3-66.9 0-96.8l119.8-207.5c17.3-30 49.2-48.4 83.8-48.4h254.6c34.6 0 66.5 18.5 83.8 48.4l119.8 207.5c17.3 30 17.3 66.9 0.1 96.8z M522.3 321.2c-2.5-0.1-5-0.2-7.5-0.2-119.9 0-214 110.3-186.3 235 15.8 70.9 71.5 126.6 142.4 142.4 17.5 3.9 34.7 5.4 51.4 4.7 102.1-3.9 183.6-87.9 183.6-191 0.1-103-81.5-187-183.6-190.9z m68.6 269.1c-18.5 18-43 28.9-68.6 30.7l-6 0.3c-30.2 0.4-58.6-11.4-79.7-33-19.5-20.1-30.7-47-30.9-75-0.3-29.6 11.1-57.4 32-78.3 20.6-20.6 48-32 77.2-32 2.5 0 5 0.1 7.5 0.3 26.7 1.8 51.5 13.2 70.5 32.5 19.6 20 30.8 46.9 31.2 74.9 0.2 30.2-11.5 58.6-33.2 79.6z"/>
-                            <local:MyRadioButton x:Name="BtnTitleSelect4" Text="{DynamicResource LangTitleOther}" Tag="4" Margin="5,0" Padding="2,0"
+                            <local:MyRadioButton x:Name="BtnTitleSelect4" Text="更多" Tag="4" Margin="5,0" Padding="2,0"
                                              LogoScale="0.93" Logo="M364 0h-273C40 0 0 40 0 91v273C0 414 40 455 91 455h273C414 455 455 414 455 364V91C455 40 414 0 364 0zM341 341H113V113h227v227zM933 0h-273C609 0 568 40 568 91v273c0 50 40 91 91 91h273C983 455 1024 414 1024 364V91c0-50-40-91-90-91zM910 341h-227V113h227v227zM364 568h-273C40 568 0 609 0 659v273c0 50 40 91 91 91h273C414 1024 455 983 455 932v-273C455 609 414 568 364 568zM341 910H113v-227h227v227zM933 568h-273c-50 0-91 40-91 91v273c0 50 40 91 91 91h273c50 0 90-40 90-91v-273c0-50-40-90-90-90zM910 910h-227v-227h227v227z"/>
                         </StackPanel>
                     </Grid>
@@ -145,7 +144,7 @@
                     <Rectangle x:Name="RectLeftBackground" Width="0" Fill="{DynamicResource ColorBrushBackgroundTransparentSidebar}" IsHitTestVisible="False" />
                     <Rectangle x:Name="RectLeftShadow" Width="4" HorizontalAlignment="Left" IsHitTestVisible="False" Grid.Column="1" >
                         <Rectangle.Fill>
-                            <LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.085">
+                            <LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.04">
                                 <GradientStop Color="#000000" Offset="0"/>
                                 <GradientStop Color="#00000000" Offset="1"/>
                             </LinearGradientBrush>

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 499 - 299
Plain Craft Launcher 2/FormMain.xaml.vb


+ 1 - 1
Plain Craft Launcher 2/GlobalSuppressions.vb

@@ -1,4 +1,4 @@
-' This file is used by Code Analysis to maintain SuppressMessage
+' This file is used by Code Analysis to maintain SuppressMessage
 ' attributes that are applied to this project.
 ' Project-level suppressions either have no target or are given
 ' a specific target and scoped to a namespace, type, member, etc.

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


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


BIN
Plain Craft Launcher 2/Images/Icons/Unavailable.png


+ 0 - 0
Plain Craft Launcher 2/Images/Icons/A.png → Plain Craft Launcher 2/Images/ReleaseTypes/Alpha.png


+ 0 - 0
Plain Craft Launcher 2/Images/Icons/B.png → Plain Craft Launcher 2/Images/ReleaseTypes/Beta.png


+ 0 - 0
Plain Craft Launcher 2/Images/Icons/R.png → Plain Craft Launcher 2/Images/ReleaseTypes/Release.png


+ 138 - 75
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb

@@ -1,6 +1,8 @@
-'动画引擎模块
+'动画引擎模块
 '使用 Ani 作为方法或属性的开头,使用 Aa 作为单个动画对象的开头(便于自动补全)
 
+Imports System.Windows.Media.Effects
+
 Public Module ModAnimation
 
 #Region "声明"
@@ -8,7 +10,12 @@ Public Module ModAnimation
     ''' <summary>
     ''' 动画速度。最大为 200。
     ''' </summary>
-    Public AniSpeed As Double = 1
+    Public ReadOnly Property AniSpeed As Double
+        Get
+            Dim Setting As Integer = Settings.Get(Of Integer)("SystemDebugAnim")
+            Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3))
+        End Get
+    End Property
     ''' <summary>
     ''' 动画组列表。
     ''' </summary>
@@ -107,7 +114,7 @@ Public Module ModAnimation
         Public ValueLast As Object
 
         Public Overrides Function ToString() As String
-            Return GetStringFromEnum(TypeMain) & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
+            Return TypeMain.ToString() & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
         End Function
 
     End Structure
@@ -467,7 +474,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>
@@ -514,13 +521,14 @@ Public Module ModAnimation
     ''' </summary>
     ''' <remarks></remarks>
     Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData)
-        AaStack = New List(Of AniData)
+        Dim Result = New List(Of AniData)
         Dim AniDelay As Integer = 0
         For Each Item In Stack.Children
             Item.Opacity = 0
-            AaStack.Add(AaOpacity(Item, 1, Time, AniDelay))
+            Result.Add(AaOpacity(Item, 1, Time, AniDelay))
             AniDelay += Delay
         Next
+        Return Result
     End Function
 
 #End Region
@@ -577,10 +585,10 @@ Public Module ModAnimation
     Public Class AniEaseLinear
         Inherits AniEase
         Public Overrides Function GetValue(t As Double) As Double
-            Return MathClamp(t, 0, 1)
+            Return t.Clamp(0, 1)
         End Function
         Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
-            Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
+            Return t1.Clamp(0, 1) - t0.Clamp(0, 1)
         End Function
     End Class
 
@@ -595,7 +603,7 @@ Public Module ModAnimation
             p = Power
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            Return MathClamp(t, 0, 1) ^ p
+            Return t.Clamp(0, 1) ^ p
         End Function
     End Class
     ''' <summary>
@@ -608,7 +616,7 @@ Public Module ModAnimation
             p = Power
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            Return 1 - MathClamp(1 - t, 0, 1) ^ p
+            Return 1 - (1 - t).Clamp(0, 1) ^ p
         End Function
     End Class
     ''' <summary>
@@ -624,6 +632,26 @@ Public Module ModAnimation
             Return Ease.GetValue(t)
         End Function
     End Class
+    ''' <summary>
+    ''' 以特定速度开始的平滑结束。
+    ''' </summary>
+    Public Class AniEaseOutFluentWithInitial
+        Inherits AniEase
+        Private ReadOnly alpha As Double '(初速度 / 平均速度) – 1
+        ''' <param name="InitialPixelPerSecond">初速度,px/s</param>
+        ''' <param name="TotalSecond">总时长,s</param>
+        ''' <param name="TotalDistance">总路程,px</param>
+        Public Sub New(InitialPixelPerSecond As Double, TotalSecond As Double, TotalDistance As Double)
+            Dim v0_norm As Double = InitialPixelPerSecond * TotalSecond / TotalDistance '归一化初速度
+            alpha = v0_norm - 1.0
+            If alpha < 0 Then alpha = 0 '初速度小于平均速度时,退化为线性
+        End Sub
+        Public Overrides Function GetValue(percent As Double) As Double
+            Dim p As Double = percent.Clamp(0, 1)
+            If alpha = 0 Then Return p '退化到线性
+            Return (alpha + 1) * p / (1 + alpha * p)
+        End Function
+    End Class
 
     'Back / 回弹
     ''' <summary>
@@ -636,7 +664,7 @@ Public Module ModAnimation
             p = 3 - Power * 0.5
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            t = MathClamp(t, 0, 1)
+            t = t.Clamp(0, 1)
             Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
         End Function
     End Class
@@ -650,7 +678,7 @@ Public Module ModAnimation
             p = 3 - Power * 0.5
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            t = MathClamp(t, 0, 1)
+            t = t.Clamp(0, 1)
             Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
         End Function
     End Class
@@ -694,7 +722,7 @@ Public Module ModAnimation
             p = Power + 4
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            t = MathClamp(t, 0, 1)
+            t = t.Clamp(0, 1)
             Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
         End Function
     End Class
@@ -708,7 +736,7 @@ Public Module ModAnimation
             p = Power + 4
         End Sub
         Public Overrides Function GetValue(t As Double) As Double
-            t = 1 - MathClamp(t, 0, 1)
+            t = 1 - t.Clamp(0, 1)
             Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
         End Function
     End Class
@@ -723,9 +751,17 @@ 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 AllAnis = New List(Of AniData)
+        For Each Element In AniGroup
+            If TypeOf Element Is ICollection Then
+                AllAnis.AddRange(Element)
+            Else
+                AllAnis.Add(Element)
+            End If
+        Next
+        Dim NewEntry As New AniGroupEntry With {.Data = AllAnis, .StartTick = GetTimeMs()}
         If Name = "" Then
             Name = NewEntry.Uuid
         Else
@@ -768,48 +804,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
+                Logger.Info("动画线程开始")
+                Do While True
+                    '两帧之间的间隔时间
+                    Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
+                    If DeltaTime < 3 Then GoTo Sleeper
+                    AniLastTick = GetTimeMs()
+                    '记录 FPS
+                    If ModeDebug Then
+                        If (AniLastTick - AniFPSTimer).Clamp(0, 100000) >= 500 Then
+                            AniFPS = AniFPSCounter
+                            AniFPSCounter = 0
+                            AniFPSTimer = AniLastTick
+                        End If
+                        AniFPSCounter += 2
+                    End If
+                    '执行动画
+                    RunInUiWait(
+                    Sub()
+                        AniCount = 0
+                        AniTimer(DeltaTime * AniSpeed)
+                        If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
+                            Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}({StringUtils.FormatByteSize(NetManager.Speed)}/s)")
+                            If NetManager.FileRemain < 5 Then
+                                For Each File In NetManager.AllFiles.Values
+                                    If File.State < NetState.Finished Then Logger.Trace($"- {File.State} {StringUtils.FormatByteSize(File.Speed)}/s {File.LocalPath}")
+                                Next
+                            End If
+                        End If
+                    End Sub)
 Sleeper:
-                                   '控制 FPS
-                                   Thread.Sleep(1)
-                               Loop
-                           Catch ex As Exception
-                               Log(ex, "动画帧执行失败", LogLevel.Assert)
-                           End Try
-                       End Sub, "Animation", ThreadPriority.AboveNormal)
+                    '控制 FPS
+                    Thread.Sleep(1)
+                Loop
+            Catch ex As Exception
+                Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
+            End Try
+        End Sub, "Animation", ThreadPriority.AboveNormal)
     End Sub
 
     ''' <summary>
@@ -818,7 +856,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 Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
             Dim i As Integer = -1
             '循环每个动画组
             Do While i + 1 < AniGroups.Count
@@ -883,7 +921,7 @@ NextAni:
             Loop
 
         Catch ex As Exception
-            Log(ex, "动画刻执行失败", LogLevel.Hint)
+            Logger.Error(ex, "动画刻执行失败", LogBehavior.Toast)
         End Try
     End Sub
 
@@ -896,15 +934,39 @@ NextAni:
             Select Case Ani.TypeMain
 
                 Case AniType.Number
-                    Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
+                    Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
                     If Delta <> 0 Then
                         Select Case Ani.TypeSub
                             Case AniTypeSub.X
-                                DeltaLeft(Ani.Obj, Delta)
+                                If TypeOf Ani.Obj Is Window Then
+                                    CType(Ani.Obj, Window).Left += Delta
+                                Else
+                                    Select Case Ani.Obj.HorizontalAlignment
+                                        Case HorizontalAlignment.Left, HorizontalAlignment.Stretch
+                                            Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left + Delta, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
+                                        Case HorizontalAlignment.Right
+                                            Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right - Delta, Ani.Obj.Margin.Bottom)
+                                    End Select
+                                End If
                             Case AniTypeSub.Y
-                                DeltaTop(Ani.Obj, Delta)
+                                If TypeOf Ani.Obj Is Window Then
+                                    CType(Ani.Obj, Window).Top += Delta
+                                Else
+                                    Select Case Ani.Obj.VerticalAlignment
+                                        Case VerticalAlignment.Top
+                                            Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top + Delta, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
+                                        Case VerticalAlignment.Bottom
+                                            Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom - Delta)
+                                    End Select
+                                End If
                             Case AniTypeSub.Opacity
-                                Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
+                                If TypeOf Ani.Obj Is UIElement Then
+                                    Dim Obj As UIElement = Ani.Obj
+                                    Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
+                                ElseIf TypeOf Ani.Obj Is DropShadowEffect Then
+                                    Dim Obj As DropShadowEffect = Ani.Obj
+                                    Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
+                                End If
                             Case AniTypeSub.Width
                                 Dim Obj As FrameworkElement = Ani.Obj
                                 Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
@@ -936,7 +998,7 @@ NextAni:
 
                 Case AniType.Color
                     '利用 Last 记录了余下的小数值
-                    Dim Delta As MyColor = MathPercent(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
+                    Dim Delta As MyColor = MyColor.Lerp(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
                     Dim Obj As FrameworkElement = Ani.Obj(0)
                     Dim Prop As DependencyProperty = Ani.Obj(1)
                     Dim NewColor As MyColor = New MyColor(Obj.GetValue(Prop)) + Delta
@@ -946,21 +1008,22 @@ NextAni:
                 Case AniType.Scale
                     Dim Obj As FrameworkElement = Ani.Obj
                     Dim Delta As Double = Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)
-                    Obj.Margin = New Thickness(Obj.Margin.Left + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathPercent(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathPercent(0, Ani.Value.Top, Delta))
-                    Obj.Width = Math.Max(Obj.Width + MathPercent(0, Ani.Value.Width, Delta), 0)
-                    Obj.Height = Math.Max(Obj.Height + MathPercent(0, Ani.Value.Height, Delta), 0)
+                    Obj.Margin = New Thickness(Obj.Margin.Left + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathUtils.Lerp(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathUtils.Lerp(0, Ani.Value.Top, Delta))
+                    Obj.Width = Math.Max(Obj.Width + MathUtils.Lerp(0, Ani.Value.Width, Delta), 0)
+                    Obj.Height = Math.Max(Obj.Height + MathUtils.Lerp(0, Ani.Value.Height, Delta), 0)
 
                 Case AniType.TextAppear
-                    Dim TextCount As Integer = If(Ani.Value(1), Ani.Value(0).ToString.Length, 0) +
-                                               Math.Round(Ani.Value(0).ToString.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
-                    Dim NewText As String = Mid(Ani.Value(0), 1, TextCount)
+                    Dim Text As String = Ani.Value(0)
+                    Dim TextCount As Integer = If(Ani.Value(1), Text.Length, 0) +
+                                               Math.Round(Text.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
+                    Dim NewText As String = Text.Substring(0, TextCount)
                     '添加乱码
-                    If TextCount < Ani.Value(0).ToString.Length Then
-                        Dim NextText As String = Mid(Ani.Value(0), TextCount + 1, 1)
+                    If TextCount < Text.Length Then
+                        Dim NextText As String = Text.Substring(TextCount, 1)
                         If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then
                             NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
                         Else
-                            NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray)
+                            NewText &= RandomInteger(0, 85).ConvertRadix(86)
                         End If
                     End If
                     '设置文本
@@ -976,26 +1039,26 @@ 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))
+                    Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
                     CType(Obj.RenderTransform, ScaleTransform).ScaleX = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleX + Delta, 0)
                     CType(Obj.RenderTransform, ScaleTransform).ScaleY = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleY + Delta, 0)
 
                 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))
+                    Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
                     CType(Obj.RenderTransform, RotateTransform).Angle = CType(Obj.RenderTransform, RotateTransform).Angle + Delta
 
             End Select
             Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
         Catch ex As Exception
-            Log(ex, "执行动画失败:" & Ani.ToString, LogLevel.Hint)
+            Logger.Error(ex, $"执行动画失败:{Ani}", LogBehavior.Toast)
         End Try
         Return Ani
     End Function

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 229 - 1416
Plain Craft Launcher 2/Modules/Base/ModBase.vb


+ 213 - 121
Plain Craft Launcher 2/Modules/Base/ModLoader.vb

@@ -1,4 +1,4 @@
-Public Module ModLoader
+Public Module ModLoader
 
     '各类加载器
     ''' <summary>
@@ -37,7 +37,7 @@
                         RealParent = RealParent.Parent
                     End While
                 Catch ex As Exception
-                    Log(ex, "获取父加载器失败(" & Name & ")", LogLevel.Feedback)
+                    Logger.Error(ex, $"获取父加载器失败({Name})")
                     Return Nothing
                 End Try
             End Get
@@ -85,11 +85,12 @@
                 Return _State
             End Get
             Set(value As LoadState)
-                If _State = value Then Exit Property
+                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(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
                 _State = value
-                Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
+                If value = LoadState.Canceled Then CancellationTokenSource?.Cancel()
+                Logger.Log($"加载器 {[GetType].Name} {Name} 状态改变:{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
                 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
                 RunInUi(
                 Sub()
@@ -112,7 +113,7 @@
                 Return _LoadingState
             End Get
             Set(value As MyLoading.MyLoadingState)
-                If _LoadingState = value Then Exit Property
+                If _LoadingState = value Then Return
                 Dim OldState = _LoadingState
                 _LoadingState = value
                 RaiseEvent LoadingStateChanged(value, OldState)
@@ -148,13 +149,13 @@
                     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
             End Get
             Set(value As Double)
-                If _Progress = value Then Exit Property
+                If _Progress = value Then Return
                 Dim OldValue = _Progress
                 _Progress = value
                 RaiseEvent ProgressChanged(value, OldValue)
@@ -163,13 +164,42 @@
         Private _Progress As Double = -1
         Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
         ''' <summary>
+        ''' 创建一个 ProgressProvider,在其进度改变时,并将其进度单向映射到此加载器上。
+        ''' 这是 Loader 对新框架的兼容层。
+        ''' </summary>
+        Public Function CreateSyncProgressProvider(Optional FromPercentage As Double = 0, Optional ToPercentage As Double = 1) As ProgressProvider
+            Dim Provider As New ProgressProvider
+            AddHandler Provider.ProgressChanged,
+            Sub(ChangedProgress)
+                Dim RawProgress = Provider.GetRaw()
+                Progress = FromPercentage + (RawProgress.actual + RawProgress.skiped) * (ToPercentage - FromPercentage)
+            End Sub
+            Return Provider
+        End Function
+        ''' <summary>
         ''' 计算总进度时的权重。它应该为预计时间(秒)。
         ''' </summary>
         Public Property ProgressWeight As Double = 1
 
         '状态变化
         Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
-        Public MustOverride Sub Abort()
+        Public MustOverride Sub Cancel()
+        Public MustOverride Sub Failed(Ex As Exception)
+        Private CancellationTokenSource As CancellationTokenSource
+        ''' <summary>
+        ''' 创建一个随此加载器取消的取消令牌;令牌取消时也会调用此加载器的 Cancel。
+        ''' 这是 Loader 对新框架的兼容层。
+        ''' </summary>
+        Public Function CreateCancellationToken() As CancellationToken
+            SyncLock LockState
+                If CancellationTokenSource Is Nothing OrElse CancellationTokenSource.IsCancellationRequested Then
+                    CancellationTokenSource = New CancellationTokenSource
+                    CancellationTokenSource.Token.Register(AddressOf Cancel)
+                End If
+                If State = LoadState.Canceled Then CancellationTokenSource.Cancel()
+                Return CancellationTokenSource.Token
+            End SyncLock
+        End Function
 
         '等待结束
         Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -177,16 +207,19 @@
         ''' <summary>
         ''' 无限期地等待加载器完成,直到结束或抛出异常。若加载器尚未开始,则会开始执行。
         ''' </summary>
-        Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False)
+        Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False,
+                               Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
             Start(Input, IsForceRestart)
             Do While State = LoadState.Loading
                 If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
+                p?.Set(Progress)
+                c.ThrowIfCancellationRequested()
                 Thread.Sleep(10)
             Loop
             If State = LoadState.Finished Then
-                Exit Sub
-            ElseIf State = LoadState.Aborted Then
-                Throw New ThreadInterruptedException("加载器执行已中断。")
+                Return
+            ElseIf State = LoadState.Canceled Then
+                Throw New OperationCanceledException("加载器执行已中断")
             ElseIf IsNothing([Error]) Then
                 Throw New Exception("未知错误!")
             Else
@@ -207,9 +240,9 @@
                 If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage)
             Loop
             If State = LoadState.Finished Then
-                Exit Sub
-            ElseIf State = LoadState.Aborted Then
-                Throw New ThreadInterruptedException("加载器执行已中断。")
+                Return
+            ElseIf State = LoadState.Canceled Then
+                Throw New OperationCanceledException("加载器执行已中断")
             ElseIf IsNothing([Error]) Then
                 Throw New Exception("未知错误!")
             Else
@@ -227,28 +260,28 @@
     ''' <summary>
     ''' 用于异步执行并监控单一函数的加载器。
     ''' </summary>
-    Public Class LoaderTask(Of InputType, OutputType)
+    Public Class LoaderTask(Of TIn, TOut)
         Inherits LoaderBase
 
         '线程设定
         Protected Friend ThreadPriority As ThreadPriority
         '执行事件
-        Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType))
+        Protected Friend LoadDelegate As Action(Of LoaderTask(Of TIn, TOut))
         Protected Friend InputDelegate As Func(Of Object)
         '状态指示
         ''' <summary>
         ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。
         ''' </summary>
-        Public ReadOnly Property IsAborted As Boolean
+        Public ReadOnly Property IsCanceled As Boolean
             Get
-                Return IsAbortedWithThread(Thread.CurrentThread)
+                Return IsCanceledWithThread(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 IsCanceledWithThread(Thread As Thread) As Boolean
+            Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Canceled
         End Function
         ''' <summary>
         ''' 在输入相同时使用原有结果的超时,单位为毫秒。
@@ -263,25 +296,25 @@
         ''' </summary>
         Public LastRunningThread As Thread = Nothing
         '输入输出
-        Public Input As InputType = Nothing
-        Public Output As OutputType = Nothing
+        Public Input As TIn = Nothing
+        Public Output As TOut = Nothing
 
         '获取输入
-        Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用
+        Public Function StartGetInput(Optional Input As TIn = Nothing, Optional InputDelegate As Func(Of TIn) = Nothing) As TIn 'InputDelegate 参数存在匿名调用
             If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
-            Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing,则会导致 Input Is Nothing 永远失败,因此需要额外判断
+            Dim NewInput As TIn = Nothing '若 InputType 不能为 Nothing,则会导致 Input Is Nothing 永远失败,因此需要额外判断
             If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
                 RunInUiWait(Sub() Input = InputDelegate())
             End If
             Return Input
         End Function
         '代码执行
-        Public Function ShouldStart(ByRef Input As Object, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
+        Public Function ShouldStart(ByRef Input As TIn, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
             '获取输入
             Try
                 Input = StartGetInput(Input)
             Catch ex As Exception
-                Log(ex, "加载输入获取失败(" & Name & ")", LogLevel.Hint)
+                Logger.Error(ex, $"加载输入获取失败({Name})", LogBehavior.Toast)
                 [Error] = ex
                 SyncLock LockState
                     State = LoadState.Failed
@@ -290,75 +323,90 @@
             '检验输入以确定情况
             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
                     Progress = -1
                 End SyncLock
             Else
-                Exit Sub
+                Return
             End If
 
             LastRunningThread = New Thread(
-                Sub()
-                    Try
-                        IsForceRestarting = IsForceRestart
-                        If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
-                        LoadDelegate(Me)
-                        If IsAborted Then
-                            Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
-                        Else
-                            RaisePreviewFinish()
-                            State = LoadState.Finished
-                            LastFinishedTime = GetTimeTick() '未中断,本次输出有效
-                        End If
-                    Catch ex As CancelledException
-                        If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
-                        If Not IsAborted Then State = LoadState.Aborted
-                    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
-                    Catch ex As Exception
-                        If IsAborted Then Exit Sub
-                        Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
-                        [Error] = ex
-                        State = LoadState.Failed
-                    End Try
-                End Sub) With {.Name = Name, .Priority = ThreadPriority}
-            LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
+            Sub()
+                Try
+                    IsForceRestarting = IsForceRestart
+                    Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
+                    LoadDelegate(Me)
+                    If IsCanceled Then
+                        Logger.Warn($"加载线程 {Name} 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})")
+                        Return
+                    End If
+                    Logger.Trace(Function() $"加载线程 {Name} 已完成")
+                    RaisePreviewFinish()
+                    State = LoadState.Finished
+                    LastFinishedTime = GetTimeMs() '未中断,本次输出有效
+                Catch ex As Exception
+                    If ex.IsCanceled Then
+                        '如果线程是因为判断到 IsCanceled 而提前中止,则代表已有新线程被重启,此时不应当改为 Canceled
+                        '如果线程是在没有 IsCanceled 时手动引发了取消异常,则代表没有重启线程,这通常代表用户手动取消,应当改为 Canceled
+                        Logger.Trace(ex, $"加载线程 {Name} 已取消,当前已完成 {Math.Round(Progress * 100)}%")
+                        If Not IsCanceled Then State = LoadState.Canceled
+                    Else
+                        Failed(ex)
+                    End If
+                End Try
+            End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
+            Try
+                LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsCanceled
+            Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
+                Thread.Sleep(500)
+                LastRunningThread.Start()
+            End Try
         End Sub
-        Public Overrides Sub Abort()
-            If State <> LoadState.Loading Then Exit Sub
+        Public Overrides Sub Failed(ex As Exception)
+            [Error] = ex
             SyncLock LockState
-                State = LoadState.Aborted
+                If IsCanceled OrElse State >= LoadState.Finished Then Return
+                State = LoadState.Failed
             End SyncLock
-            TriggerThreadAbort()
+            Logger.Warn(ex, $"加载线程 {Name} 出错,已完成 {Math.Round(Progress * 100)}%")
+            TriggerThreadInterrupt()
         End Sub
-        Private Sub TriggerThreadAbort()
-            If LastRunningThread Is Nothing Then Exit Sub
-            If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
-            If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
+        Public Overrides Sub Cancel()
+            SyncLock LockState
+                If State <> LoadState.Loading Then Return
+                State = LoadState.Canceled
+            End SyncLock
+            TriggerThreadInterrupt()
+        End Sub
+        Private Sub TriggerThreadInterrupt()
+            If LastRunningThread Is Nothing Then Return
+            If LastRunningThread.IsAlive Then
+                LastRunningThread.Interrupt()
+                Logger.Trace(Function() $"加载线程 {Name} 已中断")
+            End If
             LastRunningThread = Nothing
         End Sub
 
         Public Sub New()
             '仅仅是为了避免一些智障报错(继承类必须重写 New 的情况)
         End Sub
-        Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)), Optional InputDelegate As Func(Of InputType) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
+        Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of TIn, TOut)), Optional InputDelegate As Func(Of TIn) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
             Me.Name = Name
             Me.LoadDelegate = LoadDelegate
             Me.InputDelegate = InputDelegate
@@ -366,6 +414,53 @@
         End Sub
 
     End Class
+
+    ''' <summary>
+    ''' 新 Worker 对老 Loader 的兼容包装类。
+    ''' </summary>
+    Public Class LoaderWorker
+        Inherits LoaderBase
+        Public WithEvents Worker As IWorker
+        Public Sub New(Name As String, Worker As IWorker)
+            Me.Name = Name
+            Me.Worker = Worker
+            AddHandler Worker.Progress.ProgressChanged, Sub(Raw) Progress = Raw.actual + Raw.skiped
+        End Sub
+
+        Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
+            SyncLock LockState
+                State = LoadState.Loading
+            End SyncLock
+            Logger.Trace(Function() $"Worker {Name} 已启动")
+            IsForceRestarting = IsForceRestart
+            Worker.Start()
+        End Sub
+        Private Sub Worker_Succeeded() Handles Worker.Succeeded
+            Logger.Trace(Function() $"Worker {Name} 已完成")
+            RaisePreviewFinish()
+            SyncLock LockState
+                State = LoadState.Finished
+            End SyncLock
+        End Sub
+        Public Overrides Sub Cancel() Handles Worker.Canceled
+            SyncLock LockState
+                If State <> LoadState.Loading Then Return
+                State = LoadState.Canceled
+            End SyncLock
+            Logger.Trace(Function() $"Worker {Name} 已取消,当前已完成 {Math.Round(Progress * 100)}%")
+            Worker.Cancel()
+        End Sub
+        Public Overrides Sub Failed(Ex As Exception) Handles Worker.Failed
+            SyncLock LockState
+                If State >= LoadState.Finished Then Return
+                State = LoadState.Failed
+            End SyncLock
+            Logger.Warn(Ex, $"Worker {Name} 出错,已完成 {Math.Round(Progress * 100)}%")
+            [Error] = Ex
+            Worker.Cancel()
+        End Sub
+    End Class
+
     ''' <summary>
     ''' 支持多个加载器连续运作的复合加载器。
     ''' </summary>
@@ -419,7 +514,7 @@
             '改变状态
             SyncLock LockState
                 If State = LoadState.Loading Then
-                    Exit Sub
+                    Return
                 Else
                     State = LoadState.Loading
                 End If
@@ -433,23 +528,34 @@
             End If
             RunInThread(AddressOf Update)
         End Sub
-        Public Overrides Sub Abort()
+        Public Overrides Sub Cancel()
             '改变状态
             SyncLock LockState
                 If State = LoadState.Loading OrElse State = LoadState.Waiting Then
-                    State = LoadState.Aborted
+                    State = LoadState.Canceled
                 Else
-                    Exit Sub
+                    Return
                 End If
             End SyncLock
             RunInThread(
             Sub()
                 '中断加载器
                 For Each Loader In Loaders
-                    Loader.Abort()
+                    Loader.Cancel()
                 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.Cancel()
+            Next
+            FrmMain.BtnExtraDownload.ShowRefresh()
+        End Sub
 
         ''' <summary>
         ''' 子任务状态变更。
@@ -464,38 +570,29 @@
                 Case LoadState.Finished
                     '正常结束,触发刷新
                     Update()
-                Case LoadState.Aborted
+                Case LoadState.Canceled
                     '被中断,这个任务也中断
-                    Abort()
-                Case Else
+                    Cancel()
+                Case LoadState.Failed
                     '完蛋,出错了
-                    SyncLock LockState
-                        If State >= LoadState.Finished Then Exit Sub
-                        [Error] = New Exception(Loader.Name & "失败", Loader.Error)
-                        State = Loader.State
-                    End SyncLock
-                    For Each Loader In Loaders
-                        Loader.Abort()
-                    Next
-                    FrmMain.BtnExtraDownload.ShowRefresh()
-                    Exit Sub
+                    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 Exit Sub
+            If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Canceled Then Return
             Dim IsFinished As Boolean = True
             Dim Blocked As Boolean = False
             Dim Input As Object = Me.Input
             For Each Loader In Loaders
                 Select Case Loader.State
                     Case LoadState.Finished
-                        '检查是否需要重启
-                        If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
+                        '检查 LoaderTask 是否需要重启
+                        If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
                             If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
-                                Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
+                                Logger.Info($"由于输入条件变更,重启已完成的加载器 {Loader.Name}")
                                 GoTo Restart
                             End If
                             '更新下一个加载器的输入
@@ -504,10 +601,10 @@
                         '如果不让继续启动,且已有加载器正在加载中,就不继续启动
                         If Loader.Block AndAlso Not IsFinished Then Blocked = True
                     Case LoadState.Loading
-                        '检查是否需要重启
-                        If Loader.GetType.Name.StartsWithF("LoaderTask") Then
+                        '检查 LoaderTask 是否需要重启
+                        If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
                             If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
-                                Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
+                                Logger.Warn($"由于输入条件变更,重启进行中的加载器 {Loader.Name}")
                                 GoTo Restart
                             End If
                         End If
@@ -521,13 +618,14 @@ Restart:
                         If Blocked Then Continue For
                         If Input IsNot Nothing Then
                             '若输入类型与下一个加载器相同才继续
-                            Dim LoaderType As String = Loader.GetType.Name
-                            If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
+                            If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) OrElse GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderCombo(Of ))) Then
                                 Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
-                            ElseIf LoaderType.StartsWithF("LoaderDownload") Then
+                            ElseIf TypeOf Loader Is LoaderWorker Then
+                                Loader.Start(IsForceRestart:=IsForceRestarting)
+                            ElseIf TypeOf Loader Is LoaderDownload Then
                                 Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
                             Else
-                                Throw New Exception("未知的加载器类型(" & LoaderType & ")")
+                                Throw New Exception("未知的加载器类型(" & Loader.GetType.Name & ")")
                             End If
                         Else
                             Loader.Start(IsForceRestart:=IsForceRestarting)
@@ -550,7 +648,7 @@ Restart:
         Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
             For Each SubLoader In Loader.Loaders
                 If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
-                If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
+                If GeneralUtils.IsGenericInstanceOf(SubLoader, GetType(LoaderCombo(Of ))) Then GetLoaderList(SubLoader, List)
             Next
         End Sub
         ''' <summary>
@@ -571,31 +669,26 @@ Restart:
     End Class
 
     '任务栏进度条
-    Public LoaderTaskbar As New SafeList(Of LoaderBase)
+    Public LoaderTaskbar As New ConcurrentList(Of LoaderBase)
     Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
     Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
 
     Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
         If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
         LoaderTaskbar.Add(Loader)
-        Log($"[Taskbar] {Loader.Name} 已加入任务列表")
+        Logger.Info($"{Loader.Name} 已加入任务列表")
     End Sub
     Public Sub LoaderTaskbarProgressRefresh()
         Try
             Dim NewState As Shell.TaskbarItemProgressState
             Dim NewProgress As Double = LoaderTaskbarProgressGet()
-            '检查任务是否完成,若完成则移除
-            '外显任务是否已经全部完成
-            Dim IsAllDownloadTaskCompleted As Boolean = True
-            For Each Loader In LoaderTaskbar.ToList()
-                If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
-            Next
-            '若单个任务已中止或全部任务已完成,则刷新并移除
-            For Each Task In LoaderTaskbar.ToList()
-                If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
-                    If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
+            '若单个任务已中止,或全部任务已完成,则刷新并移除
+            For Each Task In LoaderTaskbar
+                If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
+                   (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Canceled) Then
+                    FrmSpeedLeft?.TaskRefresh(Task)
                     LoaderTaskbar.Remove(Task)
-                    Log($"[Taskbar] {Task.Name} 已移出任务列表")
+                    Logger.Info($"{Task.Name} 已移出任务列表")
                 End If
             Next
             '更新平滑后的进度
@@ -620,15 +713,15 @@ Restart:
                 FrmMain.BtnExtraDownload.ShowRefresh()
             End If
         Catch ex As Exception
-            Log(ex, "刷新任务栏进度显示失败", LogLevel.Feedback)
+            Logger.Error(ex, "刷新任务栏进度显示失败")
         End Try
     End Sub
     Public Function LoaderTaskbarProgressGet() As Double
         Try
-            If Not LoaderTaskbar.Where(Function(l) l.Show).Any Then Return 1
-            Return MathClamp(LoaderTaskbar.Where(Function(l) l.Show).Select(Function(l) l.Progress).Average(), 0, 1)
+            If Not LoaderTaskbar.Any Then Return 1
+            Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
         Catch ex As Exception
-            Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
+            Logger.Error(ex, "获取任务栏进度出错")
             Return 0.5
         End Try
     End Function
@@ -656,11 +749,10 @@ Restart:
     ''' </summary>
     ''' <param name="ExtraPath">用于检查文件夹修改的额外路径。该路径不会传入加载器。</param>
     Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean
-        Dim FolderInfo As DirectoryInfo
         Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing}
         Try
             '获取数据
-            FolderInfo = New DirectoryInfo(FolderPath & ExtraPath)
+            Dim FolderInfo = DirectoryUtils.GetInfo(FolderPath & ExtraPath)
             Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
             '如果已经检查过,则跳过
             If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
@@ -672,7 +764,7 @@ Restart:
                 End If
             End If
         Catch ex As Exception
-            Log(ex, "文件夹加载器启动检测出错")
+            Logger.Warn(ex, "文件夹加载器启动检测出错")
         End Try
         '写入检查数据
         LoaderFolderDictionary(Loader) = Value

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 334 - 405
Plain Craft Launcher 2/Modules/Base/ModNet.vb


+ 83 - 42
Plain Craft Launcher 2/Modules/Base/ModValidate.vb

@@ -1,4 +1,4 @@
-'提供不同的输入验证方法,名称以 Validate 开头
+'提供不同的输入验证方法,名称以 Validate 开头
 Public Module ModValidate
 
     ''' <summary>
@@ -66,6 +66,20 @@ Public Class ValidateNullOrWhiteSpace
     End Function
 End Class
 
+''' <summary>
+''' 自定义的 Validate。
+''' </summary>
+Public Class ValidateFunc
+    Inherits Validate
+    Private ReadOnly _func As Func(Of String, String)
+    Public Sub New(F As Func(Of String, String))
+        _func = F
+    End Sub
+    Public Overrides Function Validate(Str As String) As String
+        Return _func(Str)
+    End Function
+End Class
+
 ''' <summary>
 ''' 必须满足正则表达式。
 ''' </summary>
@@ -80,7 +94,7 @@ Public Class ValidateRegex
         Me.ErrorDescription = ErrorDescription
     End Sub
     Public Overrides Function Validate(Str As String) As String
-        If Not RegexCheck(Str, Regex) Then Return ErrorDescription
+        If Not Str.RegexCheck(Regex) Then Return ErrorDescription
         Return ""
     End Function
 End Class
@@ -94,7 +108,7 @@ Public Class ValidateHttp
     End Sub '用于 XAML 初始化
     Public Overrides Function Validate(Str As String) As String
         If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
-        If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
+        If Not Str.RegexCheck("^(http[s]?)\://") Then Return "输入的网址无效!"
         Return ""
     End Function
 End Class
@@ -114,10 +128,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 +162,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 +171,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 +198,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 +208,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,23 +232,44 @@ 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>
 Public Class ValidateFolderName
     Inherits Validate
-    Public Property Path As String
+    Public Property Folder As String
     Public Property UseMinecraftCharCheck As Boolean = True
     Public Property IgnoreCase As Boolean = True
-    Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
+    Private ReadOnly PathIgnore As IEnumerable(Of String)
     Public Sub New()
     End Sub
-    Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
-        Me.Path = Path
+    Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
+        Me.Folder = Folder
         Me.IgnoreCase = IgnoreCase
         Me.UseMinecraftCharCheck = UseMinecraftCharCheck
         On Error Resume Next
-        PathIgnore = New DirectoryInfo(Path).EnumerateDirectories
+        PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
     End Sub
     Public Overrides Function Validate(Str As String) As String
         Try
@@ -245,25 +285,25 @@ Public Class ValidateFolderName
             '检查尾部小数点
             If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
             '检查特殊字符
-            Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
+            Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
             If CharactCheck <> "" Then Return CharactCheck
             '检查特殊字符串
             Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!", True).Validate(Str)
             If InvalidStrCheck <> "" Then Return InvalidStrCheck
             '检查 NTFS 8.3 文件名(#4505)
-            If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
+            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
             '检查文件夹重名
             Dim Arr As New List(Of String)
             If PathIgnore IsNot Nothing Then
-                For Each Folder As DirectoryInfo In PathIgnore
-                    Arr.Add(Folder.Name)
+                For Each FolderPath In PathIgnore
+                    Arr.Add(PathUtils.GetLastPart(FolderPath))
                 Next
             End If
             Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名!", IgnoreCase).Validate(Str)
             If Not SameNameCheck = "" Then Return SameNameCheck
             Return ""
         Catch ex As Exception
-            Log(ex, "检查文件夹名出错")
+            Logger.Warn(ex, "检查文件夹名出错")
             Return "错误:" & ex.Message
         End Try
     End Function
@@ -300,16 +340,16 @@ Public Class ValidateFileName
             '检查尾部小数点
             If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
             '检查特殊字符
-            Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
+            Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
             If CharactCheck <> "" Then Return CharactCheck
             '检查特殊字符串
             Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %!", True).Validate(Str)
             If InvalidStrCheck <> "" Then Return InvalidStrCheck
             '检查 NTFS 8.3 文件名(#4505)
-            If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
+            If Str.RegexCheck(".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
             '检查文件重名
             If ParentFolder IsNot Nothing Then
-                Dim DirInfo As New DirectoryInfo(ParentFolder)
+                Dim DirInfo = DirectoryUtils.GetInfo(ParentFolder)
                 If DirInfo.Exists Then
                     Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
                                                                "不可与现有文件重名!", IgnoreCase).Validate(Str)
@@ -320,7 +360,7 @@ Public Class ValidateFileName
             End If
             Return ""
         Catch ex As Exception
-            Log(ex, "检查文件名出错")
+            Logger.Warn(ex, "检查文件名出错")
             Return "错误:" & ex.Message
         End Try
     End Function
@@ -349,9 +389,10 @@ Public Class ValidateFolderPath
         If LengthCheck <> "" Then Return LengthCheck
         '检查开头
         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.StartsWithF(Drive.Name, True) Then GoTo Fin
+        For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
+            Dim DriveName As String = Drive.Upper.First & ":\"
+            If Str.Upper = DriveName Then Return ""
+            If Str.StartsWithF(DriveName, True) Then GoTo Fin
         Next
         Return "文件夹路径头存在错误!"
 Fin:
@@ -362,7 +403,7 @@ Fin:
             Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
             If Not SubLengthCheck = "" Then Return "文件夹路径存在错误!"
             '检查特殊字符
-            Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
+            Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
             If Not CharactCheck = "" Then Return CharactCheck
             '检查头部空格
             If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
@@ -373,7 +414,7 @@ Fin:
             Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
             If Not InvalidStrCheck = "" Then Return InvalidStrCheck
             '检查 NTFS 8.3 文件名(#4505)
-            If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
+            If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
         Next
         Return ""
     End Function

+ 23 - 22
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb

@@ -1,14 +1,9 @@
-'一个万能的自动图片类型转换工具类
+'一个万能的自动图片类型转换工具类
 
 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 = FileUtils.ReadAsStream(FilePathOrResourceName)
                     '判断是否为 WebP 文件头
                     Dim Header(1) As Byte
                     InputStream.Read(Header, 0, 2)
@@ -92,9 +91,13 @@ 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)
+                Logger.Warn(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})")
                 Exit Try
             End If
         End Try
@@ -123,9 +126,7 @@ Public Class MyBitmap
     End Sub
     Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll
         Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
-            If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
-            Dim Decoder As New Imazen.WebP.SimpleDecoder()
-            Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
+            Return New Imazen.WebP.SimpleDecoder().DecodeFromBytes(Bytes, Bytes.Length)
         End Function
     End Class
 
@@ -159,7 +160,7 @@ Public Class MyBitmap
     Public Sub Save(FilePath As String)
         Dim encoder As BitmapEncoder = New PngBitmapEncoder()
         encoder.Frames.Add(BitmapFrame.Create(Me))
-        Using fileStream As New FileStream(FilePath, FileMode.Create)
+        Using fileStream = FileUtils.CreateAsStream(FilePath)
             encoder.Save(fileStream)
         End Using
     End Sub

+ 54 - 0
Plain Craft Launcher 2/Modules/Base/PclLogger.vb

@@ -0,0 +1,54 @@
+Public Class PclLogger
+    Inherits FileLogger
+
+    ''' <inheritdoc/>
+    Public Overrides Function Format(Text As String, Level As LogLevel, FilePath As String, Ex As Exception) As String
+        Text = MyBase.Format(Text, Level, FilePath, Ex)
+        Text = FilterUserName(FilterAccessToken(Text, "*"c), "*"c)
+        Return Text
+    End Function
+
+    ''' <inheritdoc/>
+    Public Overrides Sub HandleBehavior(RawMessage As String, FormattedMessage As String, Behavior As LogBehavior, Ex As Exception)
+        If IsProgramEnding Then Return
+        MyBase.HandleBehavior(RawMessage, FormattedMessage, Behavior, Ex)
+        Dim BriefText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}:") & Ex.GetDisplay(False))
+        BriefText = FilterUserName(FilterAccessToken(BriefText, "*"c), "*"c)
+        Dim DetailText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}:") & Ex.GetDisplay(True))
+        DetailText = FilterUserName(FilterAccessToken(DetailText, "*"c), "*"c)
+        Select Case Behavior
+            Case LogBehavior.None
+                '啥也不干
+            Case LogBehavior.ToastIfDebug
+                If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & BriefText, HintType.Blue, False)
+            Case LogBehavior.Toast
+                Hint(BriefText, HintType.Red, False)
+            Case LogBehavior.Alert
+                MyMsgBox(DetailText, "错误", IsWarn:=True)
+            Case LogBehavior.AlertThenFeedback
+                If PageSetupSystem.IsLauncherNewest Then
+                    If MyMsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", "错误", "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
+                Else
+                    MyMsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", "错误", IsWarn:=True)
+                End If
+            Case LogBehavior.AlertThenCrash
+                Static FirstTrigger As Boolean = True
+                If FirstTrigger Then
+                    '首次触发
+                    FirstTrigger = False
+                    If PageSetupSystem.IsLauncherNewest Then
+                        If MsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, "错误") = MsgBoxResult.Yes Then Feedback(False, True)
+                    Else
+                        MsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, "错误")
+                    End If
+                Else
+                    '多次触发,直接使程序崩溃(这通常代表着在其他线程循环触发严重异常)
+                    Thread.Sleep(2000)
+                End If
+                FormMain.EndProgramForce(ProcessReturnValues.Exception)
+        End Select
+        '遥测
+        If Behavior >= LogBehavior.Toast Then Telemetry("错误日志", "Exception", DetailText)
+    End Sub
+
+End Class

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

@@ -1,1660 +0,0 @@
-Public Module ModComp
-
-    Public Enum CompType
-        ''' <summary>
-        ''' 允许任意种类,或种类未知。
-        ''' </summary>
-        Any = -1
-        ''' <summary> 
-        ''' Mod。
-        ''' </summary>
-        [Mod] = 0
-        ''' <summary>
-        ''' 整合包。
-        ''' </summary>
-        ModPack = 1
-        ''' <summary>
-        ''' 资源包。
-        ''' </summary>
-        ResourcePack = 2
-        ''' <summary>
-        ''' 光影包。
-        ''' </summary>
-        Shader = 3
-        ''' <summary>
-        ''' CurseForge:数据包。
-        ''' Modrinth:数据包,或数据包与 Mod 的混合。
-        ''' </summary>
-        DataPack = 4
-        ''' <summary>
-        ''' 服务端插件。
-        ''' </summary>
-        Plugin = 5
-    End Enum
-    Public Enum CompModLoaderType
-        'https://docs.curseforge.com/?http#tocS_ModLoaderType
-        Any = 0
-        Forge = 1
-        LiteLoader = 3
-        Fabric = 4
-        Quilt = 5
-        NeoForge = 6
-    End Enum
-    <Flags> Public Enum CompSourceType
-        CurseForge = 1
-        Modrinth = 2
-        Any = CurseForge Or Modrinth
-    End Enum
-
-#Region "CompDatabase | Mod 数据库"
-
-    Private _CompDatabase As List(Of CompDatabaseEntry) = Nothing
-    Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry)
-        Get
-            If _CompDatabase IsNot Nothing Then Return _CompDatabase
-            '初始化数据库
-            _CompDatabase = New List(Of CompDatabaseEntry)
-            Dim i As Integer = 0
-            For Each Line In DecodeBytes(GetResources("ModData")).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf)
-                i += 1
-                If Line = "" Then Continue For
-                For Each EntryData As String In Line.Split("¨")
-                    Dim Entry = New CompDatabaseEntry
-                    Dim SplitedLine = EntryData.Split("|")
-                    If SplitedLine(0).StartsWithF("@") Then
-                        Entry.CurseForgeSlug = Nothing
-                        Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
-                    ElseIf SplitedLine(0).EndsWithF("@") Then
-                        Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
-                        Entry.ModrinthSlug = Entry.CurseForgeSlug
-                    ElseIf SplitedLine(0).Contains("@") Then
-                        Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0)
-                        Entry.ModrinthSlug = SplitedLine(0).Split("@")(1)
-                    Else
-                        Entry.CurseForgeSlug = SplitedLine(0)
-                        Entry.ModrinthSlug = Nothing
-                    End If
-                    Entry.WikiId = i
-                    If SplitedLine.Count >= 2 Then
-                        Entry.ChineseName = SplitedLine(1)
-                        If Entry.ChineseName.Contains("*") Then '处理 *
-                            Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
-                                String.Join(" ", If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
-                        End If
-                    End If
-                    _CompDatabase.Add(Entry)
-                Next
-            Next
-            Return _CompDatabase
-        End Get
-    End Property
-
-    Private Class CompDatabaseEntry
-        ''' <summary>
-        ''' McMod 的对应 ID。
-        ''' </summary>
-        Public WikiId As Integer
-        ''' <summary>
-        ''' 中文译名。空字符串代表没有翻译。
-        ''' </summary>
-        Public ChineseName As String = ""
-        ''' <summary>
-        ''' CurseForge Slug(例如 advanced-solar-panels)。
-        ''' </summary>
-        Public CurseForgeSlug As String = Nothing
-        ''' <summary>
-        ''' Modrinth Slug(例如 advanced-solar-panels)。
-        ''' </summary>
-        Public ModrinthSlug As String = Nothing
-
-        Public Overrides Function ToString() As String
-            Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName
-        End Function
-    End Class
-
-#End Region
-
-#Region "CompProject | 工程信息"
-
-    '类定义
-
-    Public Class CompProject
-
-        '源信息
-
-        ''' <summary>
-        ''' 该工程信息来自 CurseForge 还是 Modrinth。
-        ''' </summary>
-        Public ReadOnly FromCurseForge As Boolean
-        ''' <summary>
-        ''' 工程的种类。
-        ''' 由于 Modrinth 混合使用 Mod 和数据包,结果不一定准确。
-        ''' </summary>
-        Public ReadOnly Type As CompType
-        ''' <summary>
-        ''' 工程的短名。例如 technical-enchant。
-        ''' </summary>
-        Public ReadOnly Slug As String
-        ''' <summary>
-        ''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。
-        ''' </summary>
-        Public ReadOnly Id As String
-        ''' <summary>
-        ''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。
-        ''' </summary>
-        Public ReadOnly CurseForgeFileIds As List(Of Integer)
-
-        '描述性信息
-
-        ''' <summary>
-        ''' 原始的英文名称。
-        ''' </summary>
-        Public ReadOnly RawName As String
-        ''' <summary>
-        ''' 英文描述。
-        ''' </summary>
-        Public ReadOnly Description As String
-        ''' <summary>
-        ''' 来源网站的工程页面网址。确保格式一定标准。
-        ''' CurseForge:https://www.curseforge.com/minecraft/mc-mods/jei
-        ''' Modrinth:https://modrinth.com/mod/technical-enchant
-        ''' </summary>
-        Public ReadOnly Website As String
-        ''' <summary>
-        ''' 最后一次更新的时间。可能为 Nothing。
-        ''' </summary>
-        Public ReadOnly LastUpdate As Date? = Nothing
-        ''' <summary>
-        ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量!
-        ''' </summary>
-        Public ReadOnly DownloadCount As Integer
-        ''' <summary>
-        ''' 支持的 Mod 加载器列表。可能为空。
-        ''' </summary>
-        Public ReadOnly ModLoaders As List(Of CompModLoaderType)
-        ''' <summary>
-        ''' 描述性标签的内容。已转换为中文。
-        ''' </summary>
-        Public ReadOnly Tags As List(Of String)
-        ''' <summary>
-        ''' Logo 图片的下载地址。若为 Nothing 则没有。
-        ''' </summary>
-        Public LogoUrl As String = Nothing
-        ''' <summary>
-        ''' 游戏大版本列表。例如:18, 16, 15……
-        ''' </summary>
-        Public ReadOnly GameVersions As List(Of Integer)
-
-        '数据库信息
-
-        Private LoadedDatabase As Boolean = False
-        Private _DatabaseEntry As CompDatabaseEntry = Nothing
-        ''' <summary>
-        ''' 关联的数据库条目。若为 Nothing 则没有。
-        ''' </summary>
-        Private Property DatabaseEntry As CompDatabaseEntry
-            Get
-                If Not LoadedDatabase Then
-                    LoadedDatabase = True
-                    If Type = CompType.Mod OrElse Type = CompType.DataPack Then
-                        _DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
-                    End If
-                End If
-                Return _DatabaseEntry
-            End Get
-            Set(value As CompDatabaseEntry)
-                LoadedDatabase = True
-                _DatabaseEntry = value
-            End Set
-        End Property
-        ''' <summary>
-        ''' MC 百科的页面 ID。若为 0 则没有。
-        ''' </summary>
-        Public ReadOnly Property WikiId As Integer
-            Get
-                Return If(DatabaseEntry Is Nothing, 0, DatabaseEntry.WikiId)
-            End Get
-        End Property
-        ''' <summary>
-        ''' 翻译后的中文名。若数据库没有则等同于 RawName。
-        ''' </summary>
-        Public ReadOnly Property TranslatedName As String
-            Get
-                Return If(DatabaseEntry Is Nothing OrElse DatabaseEntry.ChineseName = "", RawName, DatabaseEntry.ChineseName)
-            End Get
-        End Property
-
-        '实例化
-
-        ''' <summary>
-        ''' 从工程 Json 中初始化实例。若出错会抛出异常。
-        ''' </summary>
-        Public Sub New(Data As JObject)
-            If Data.ContainsKey("Tags") Then
-#Region "CompJson"
-                FromCurseForge = Data("DataSource") = "CurseForge"
-                Type = Data("Type").ToObject(Of Integer)
-                Slug = Data("Slug")
-                Id = Data("Id")
-                If Data.ContainsKey("CurseForgeFileIds") Then CurseForgeFileIds = CType(Data("CurseForgeFileIds"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
-                RawName = Data("RawName")
-                Description = Data("Description")
-                Website = Data("Website")
-                If Data.ContainsKey("LastUpdate") Then LastUpdate = Data("LastUpdate")
-                DownloadCount = Data("DownloadCount")
-                If Data.ContainsKey("ModLoaders") Then
-                    ModLoaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), CompModLoaderType)).ToList
-                Else
-                    ModLoaders = New List(Of CompModLoaderType)
-                End If
-                Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
-                If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
-                If Data.ContainsKey("GameVersions") Then
-                    GameVersions = CType(Data("GameVersions"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
-                Else
-                    GameVersions = New List(Of Integer)
-                End If
-#End Region
-            Else
-                FromCurseForge = Data.ContainsKey("summary")
-                If FromCurseForge Then
-#Region "CurseForge"
-                    '简单信息
-                    Id = Data("id")
-                    Slug = Data("slug")
-                    RawName = Data("name")
-                    Description = Data("summary")
-                    Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
-                    LastUpdate = Data("dateReleased") '#1194
-                    DownloadCount = Data("downloadCount")
-                    If Data("logo").Count > 0 Then
-                        If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
-                            LogoUrl = Data("logo")("url")
-                        Else
-                            LogoUrl = Data("logo")("thumbnailUrl")
-                        End If
-                    End If
-                    'Type
-                    If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
-                        Type = CompType.Mod
-                    ElseIf Website.Contains("/modpacks/") Then
-                        Type = CompType.ModPack
-                    ElseIf Website.Contains("/resourcepacks/") Then
-                        Type = CompType.ResourcePack
-                    ElseIf Website.Contains("/texture-packs/") Then
-                        Type = CompType.ResourcePack
-                    ElseIf Website.Contains("/shaders/") Then
-                        Type = CompType.Shader
-                    Else
-                        Type = CompType.DataPack
-                    End If
-                    'FileIndexes / GameVersions / ModLoaders
-                    ModLoaders = New List(Of CompModLoaderType)
-                    Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
-                    For Each File In If(Data("latestFiles"), New JArray)
-                        Dim NewFile As New CompFile(File, Type)
-                        If Not NewFile.Available Then Continue For
-                        ModLoaders.AddRange(NewFile.ModLoaders)
-                        Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
-                        If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For
-                        Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
-                    Next
-                    For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
-                        If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For
-                        Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
-                    Next
-                    CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
-                    GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
-                        Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
-                        Distinct.OrderByDescending(Function(v) v).ToList
-                    ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
-                    'Tags
-                    Tags = New List(Of String)
-                    For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831)
-                        Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
-                        Select Case Category
-                            'Mod
-                            Case 406 : Tags.Add("世界元素")
-                            Case 407 : Tags.Add("生物群系")
-                            Case 410 : Tags.Add("维度")
-                            Case 408 : Tags.Add("矿物/资源")
-                            Case 409 : Tags.Add("天然结构")
-                            Case 412 : Tags.Add("科技")
-                            Case 415 : Tags.Add("管道/物流")
-                            Case 4843 : Tags.Add("自动化")
-                            Case 417 : Tags.Add("能源")
-                            Case 4558 : Tags.Add("红石")
-                            Case 436 : Tags.Add("食物/烹饪")
-                            Case 416 : Tags.Add("农业")
-                            Case 414 : Tags.Add("运输")
-                            Case 420 : Tags.Add("仓储")
-                            Case 419 : Tags.Add("魔法")
-                            Case 422 : Tags.Add("冒险")
-                            Case 424 : Tags.Add("装饰")
-                            Case 411 : Tags.Add("生物")
-                            Case 434 : Tags.Add("装备")
-                            Case 423 : Tags.Add("信息显示")
-                            Case 435 : Tags.Add("服务器")
-                            Case 5191 : Tags.Add("改良")
-                            Case 421 : Tags.Add("支持库")
-                            '整合包
-                            Case 4484 : Tags.Add("多人")
-                            Case 4479 : Tags.Add("硬核")
-                            Case 4483 : Tags.Add("战斗")
-                            Case 4478 : Tags.Add("任务")
-                            Case 4472 : Tags.Add("科技")
-                            Case 4473 : Tags.Add("魔法")
-                            Case 4475 : Tags.Add("冒险")
-                            Case 4476 : Tags.Add("探索")
-                            Case 4477 : Tags.Add("小游戏")
-                            Case 4471 : Tags.Add("科幻")
-                            Case 4736 : Tags.Add("空岛")
-                            Case 5128 : Tags.Add("原版改良")
-                            Case 4487 : Tags.Add("FTB")
-                            Case 4480 : Tags.Add("基于地图")
-                            Case 4481 : Tags.Add("轻量")
-                            Case 4482 : Tags.Add("大型")
-                            '资源包
-                            Case 403 : Tags.Add("原版风")
-                            Case 400 : Tags.Add("写实风")
-                            Case 401 : Tags.Add("现代风")
-                            Case 402 : Tags.Add("中世纪")
-                            Case 399 : Tags.Add("蒸汽朋克")
-                            Case 5244 : Tags.Add("含字体")
-                            Case 404 : Tags.Add("动态效果")
-                            Case 4465 : Tags.Add("兼容 Mod")
-                            Case 393 : Tags.Add("16x")
-                            Case 394 : Tags.Add("32x")
-                            Case 395 : Tags.Add("64x")
-                            Case 396 : Tags.Add("128x")
-                            Case 397 : Tags.Add("256x")
-                            Case 398 : Tags.Add("超高清")
-                            Case 5193 : Tags.Add("数据包") '有这个 Tag 的项会从资源包请求中被移除
-                            '光影包
-                            Case 6553 : Tags.Add("写实风")
-                            Case 6554 : Tags.Add("幻想风")
-                            Case 6555 : Tags.Add("原版风")
-                            '数据包
-                            Case 6948 : Tags.Add("冒险")
-                            Case 6949 : Tags.Add("幻想")
-                            Case 6950 : Tags.Add("支持库")
-                            Case 6952 : Tags.Add("魔法")
-                            Case 6946 : Tags.Add("Mod 相关")
-                            Case 6951 : Tags.Add("科技")
-                            Case 6953 : Tags.Add("实用")
-                        End Select
-                    Next
-#End Region
-                Else
-#Region "Modrinth"
-                    '简单信息
-                    Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
-                    Slug = Data("slug")
-                    RawName = Data("title")
-                    Description = Data("description")
-                    LastUpdate = Data("date_modified")
-                    DownloadCount = Data("downloads")
-                    LogoUrl = Data("icon_url")
-                    If LogoUrl = "" Then LogoUrl = Nothing
-                    Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
-                    'GameVersions
-                    '搜索结果的键为 versions,获取特定工程的键为 game_versions
-                    GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
-                                       Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
-                                       Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
-                                       Distinct.OrderByDescending(Function(v) v).ToList
-                    'Type
-                    Select Case Data("project_type").ToString
-                        Case "modpack" : Type = CompType.ModPack
-                        Case "resourcepack" : Type = CompType.ResourcePack
-                        Case "shader" : Type = CompType.Shader
-                        Case Else : Type = CompType.Mod 'Modrinth 将数据包标为 Mod
-                    End Select
-                    'Tags & ModLoaders
-                    Tags = New List(Of String)
-                    ModLoaders = New List(Of CompModLoaderType)
-                    If Data.ContainsKey("loaders") Then
-                        For Each Category In Data("loaders").Select(Function(t) t.ToString)
-                            Select Case Category
-                                Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
-                                Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
-                                Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
-                                Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
-                            End Select
-                        Next
-                    End If
-                    For Each Category In Data("categories").Select(Function(t) t.ToString)
-                        Select Case Category
-                            '加载器
-                            Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
-                            Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
-                            Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
-                            Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
-                            Case "datapack" : Type = CompType.DataPack '若包含数据包版本,则优先标为 DataPack
-                            '共用
-                            Case "technology" : Tags.Add("科技")
-                            Case "magic" : Tags.Add("魔法")
-                            Case "adventure" : Tags.Add("冒险")
-                            Case "utility" : Tags.Add("实用")
-                            Case "optimization" : Tags.Add("性能优化")
-                            Case "vanilla-like" : Tags.Add("原版风")
-                            Case "realistic" : Tags.Add("写实风")
-                            'Mod/数据包
-                            Case "worldgen" : Tags.Add("世界元素")
-                            Case "food" : Tags.Add("食物/烹饪")
-                            Case "game-mechanics" : Tags.Add("游戏机制")
-                            Case "transportation" : Tags.Add("运输")
-                            Case "storage" : Tags.Add("仓储")
-                            Case "decoration" : If Type <> CompType.ResourcePack Then Tags.Add("装饰")
-                            Case "mobs" : If Type <> CompType.ResourcePack Then Tags.Add("生物")
-                            Case "equipment" : If Type <> CompType.ResourcePack Then Tags.Add("装备")
-                            Case "social" : Tags.Add("服务器")
-                            Case "library" : Tags.Add("支持库")
-                            '整合包
-                            Case "multiplayer" : Tags.Add("多人")
-                            Case "challenging" : Tags.Add("硬核")
-                            Case "combat" : Tags.Add("战斗")
-                            Case "quests" : Tags.Add("任务")
-                            Case "kitchen-sink" : Tags.Add("水槽包")
-                            Case "lightweight" : Tags.Add("轻量")
-                            '资源包
-                            Case "simplistic" : Tags.Add("简洁")
-                            Case "combat" : Tags.Add("战斗")
-                            Case "tweaks" : Tags.Add("改良")
-
-                            Case "8x-" : Tags.Add("极简")
-                            Case "16x" : Tags.Add("16x")
-                            Case "32x" : Tags.Add("32x")
-                            Case "48x" : Tags.Add("48x")
-                            Case "64x" : Tags.Add("64x")
-                            Case "128x" : Tags.Add("128x")
-                            Case "256x" : Tags.Add("256x")
-                            Case "512x+" : Tags.Add("超高清")
-
-                            Case "audio" : Tags.Add("含声音")
-                            Case "fonts" : Tags.Add("含字体")
-                            Case "models" : Tags.Add("含模型")
-                            Case "gui" : Tags.Add("含 UI")
-                            Case "locale" : Tags.Add("含语言")
-                            Case "core-shaders" : Tags.Add("核心着色器")
-                            Case "modded" : Tags.Add("兼容 Mod")
-                            '光影包
-                            Case "fantasy" : Tags.Add("幻想风")
-                            Case "semi-realistic" : Tags.Add("半写实风")
-                            Case "cartoon" : Tags.Add("卡通风")
-                            '暂时不添加性能负荷 Tag
-                            'Case "potato" : Tags.Add("极低")
-                            'Case "low" : Tags.Add("低")
-                            'Case "medium" : Tags.Add("中")
-                            'Case "high" : Tags.Add("高")
-                            Case "colored-lighting" : Tags.Add("彩色光照")
-                            Case "path-tracing" : Tags.Add("路径追踪")
-                            Case "pbr" : Tags.Add("PBR")
-                            Case "reflections" : Tags.Add("反射")
-                            Case "vanilla" : Tags.Add("原版可用")
-                        End Select
-                    Next
-#End Region
-                End If
-                If Not Tags.Any() Then Tags.Add("其他")
-                Tags.Sort()
-                ModLoaders.Sort()
-            End If
-            '保存缓存
-            CompProjectCache(Id) = Me
-        End Sub
-        ''' <summary>
-        ''' 将当前实例转为可用于保存缓存的 Json。
-        ''' </summary>
-        Public Function ToJson() As JObject
-            Dim Json As New JObject
-            Json("DataSource") = If(FromCurseForge, "CurseForge", "Modrinth")
-            Json("Type") = CInt(Type)
-            Json("Slug") = Slug
-            Json("Id") = Id
-            If CurseForgeFileIds IsNot Nothing Then Json("CurseForgeFileIds") = New JArray(CurseForgeFileIds)
-            Json("RawName") = RawName
-            Json("Description") = Description
-            Json("Website") = Website
-            If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate
-            Json("DownloadCount") = DownloadCount
-            If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
-            Json("Tags") = New JArray(Tags)
-            If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
-            If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
-            Json("CacheTime") = Date.Now '用于检查缓存时间
-            Return Json
-        End Function
-        ''' <summary>
-        ''' 将当前工程信息实例化为控件。
-        ''' </summary>
-        Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyCompItem
-            '获取版本描述
-            Dim GameVersionDescription As String
-            If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
-                GameVersionDescription = "仅快照版本" '#5412
-            Else
-                Dim SpaVersions As New List(Of String)
-                Dim IsOld As Boolean = False
-                For i = 0 To GameVersions.Count - 1 '版本号一定为降序
-                    '获取当前连续的版本号段
-                    Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
-                    If StartVersion < 10 Then '如果支持新版本,则不显示 1.9-
-                        If SpaVersions.Any() AndAlso Not IsOld Then
-                            Exit For
-                        Else
-                            IsOld = True
-                        End If
-                    End If
-                    For ii = i + 1 To GameVersions.Count - 1
-                        If GameVersions(ii) <> EndVersion - 1 Then Exit For
-                        EndVersion = GameVersions(ii)
-                        i = ii
-                    Next
-                    '将版本号段转为描述文本
-                    If StartVersion = EndVersion Then
-                        SpaVersions.Add("1." & StartVersion)
-                    ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
-                        If EndVersion < 10 Then
-                            SpaVersions.Clear()
-                            SpaVersions.Add("全版本")
-                            Exit For
-                        Else
-                            SpaVersions.Add("1." & EndVersion & "+")
-                        End If
-                    ElseIf EndVersion < 10 Then
-                        SpaVersions.Add("1." & StartVersion & "-")
-                        Exit For
-                    ElseIf StartVersion - EndVersion = 1 Then
-                        SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
-                    Else
-                        SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
-                    End If
-                Next
-                GameVersionDescription = SpaVersions.Join(", ")
-            End If
-            '获取 Mod 加载器描述
-            Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
-            Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
-            If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
-            Select Case ModLoadersForDesc.Count
-                Case 0
-                    If ModLoaders.Count = 1 Then
-                        ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
-                        ModLoaderDescriptionPart = ModLoaders.Single.ToString
-                    Else
-                        ModLoaderDescriptionFull = "未知"
-                        ModLoaderDescriptionPart = ""
-                    End If
-                Case 1
-                    ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
-                    ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
-                Case Else
-                    Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99)
-                    If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
-                       (MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
-                       (MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
-                       (MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
-                        ModLoaderDescriptionFull = "任意"
-                        ModLoaderDescriptionPart = ""
-                    Else
-                        ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
-                        ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
-                    End If
-            End Select
-            '实例化 UI
-            Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
-            Dim Title = GetControlTitle(True)
-            NewItem.Title = Title.Key
-            If Title.Value = "" Then
-                CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
-            Else
-                NewItem.SubTitle = Title.Value
-            End If
-            NewItem.Tags = Tags
-            NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
-            '下边栏
-            If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
-                '全部隐藏
-                CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
-                CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
-                NewItem.ColumnVersion1.Width = New GridLength(0)
-                NewItem.ColumnVersion2.MaxWidth = 0
-                NewItem.ColumnVersion3.Width = New GridLength(0)
-            ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
-                '全部显示
-                NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
-            ElseIf ShowMcVersionDesc Then
-                '仅显示版本
-                NewItem.LabVersion.Text = GameVersionDescription
-            Else
-                '仅显示 Mod 加载器
-                NewItem.LabVersion.Text = ModLoaderDescriptionFull
-            End If
-            NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
-            If LastUpdate IsNot Nothing Then
-                NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
-            Else
-                NewItem.LabTime.Visibility = Visibility.Collapsed
-                NewItem.ColumnTime1.Width = New GridLength(0)
-                NewItem.ColumnTime2.Width = New GridLength(0)
-                NewItem.ColumnTime3.Width = New GridLength(0)
-            End If
-            NewItem.LabDownload.Text =
-                If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
-                    If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
-            Return NewItem
-        End Function
-        Public Function GetControlLogo() As String
-            If String.IsNullOrEmpty(LogoUrl) Then
-                Return PathImage & "Icons/NoIcon.png"
-            Else
-                Return LogoUrl
-            End If
-        End Function
-        Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String)
-            '检查下列代码时可以参考 #1567 的测试例
-            Dim Title As String = RawName
-            Dim SubtitleList As List(Of String)
-            If TranslatedName = RawName Then
-                '没有中文翻译
-                '将所有名称分段
-                Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
-                    Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
-                If NameLists.Count = 1 Then GoTo NoSubtitle
-                '查找其中的缩写、Forge/Fabric 等版本标记
-                SubtitleList = New List(Of String)
-                Dim NormalNameList = New List(Of String)
-                For Each Name In NameLists
-                    Dim LowerName As String = Name.ToLower
-                    If Name.ToUpper = Name AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
-                        '缩写
-                        SubtitleList.Add(Name)
-                    ElseIf (LowerName.Contains("forge") OrElse LowerName.Contains("fabric") OrElse LowerName.Contains("quilt")) AndAlso
-                        Not RegexCheck(LowerName.Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母
-                        'Forge/Fabric 等版本标记
-                        SubtitleList.Add(Name)
-                    Else
-                        '其他部分
-                        NormalNameList.Add(Name)
-                    End If
-                Next
-                '根据分类后的结果处理
-                If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
-                '同时包含 NormalName 和 Subtitle
-                Title = NormalNameList.Join(" - ")
-            Else
-                '有中文翻译
-                '尝试将文本分为三段:Title (EnglishName) - Suffix
-                '检查时注意 Carpet:它没有中文译名,但有 Suffix
-                Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
-                Dim Suffix As String = ""
-                If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
-                Dim EnglishName As String = TranslatedName
-                If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
-                EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
-                '中段的额外信息截取
-                SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
-                        Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
-                If SubtitleList.Count > 1 AndAlso
-                   Not SubtitleList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版
-                   Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.ToUpper = SubtitleList.Last) Then '不是缩写
-                    SubtitleList = New List(Of String) From {EnglishName} '使用原名
-                End If
-                '添加后缀
-                If Suffix <> "" Then SubtitleList.Add(Suffix)
-            End If
-            SubtitleList = SubtitleList.Distinct.ToList()
-            '设置标题与描述
-            Dim Subtitle As String = ""
-            If SubtitleList.Any Then
-                For Each Ex In SubtitleList
-                    Dim IsModLoaderDescription As Boolean =
-                        Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")
-                    '是否显示 ModLoader 信息
-                    If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
-                    '去除 “Forge/Fabric” 这一无意义提示
-                    If Ex.Length < 16 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For
-                    '将 “Forge” 等提示改为 “Forge 版”
-                    If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
-                        Ex.ToLower.Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
-                        Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
-                    End If
-                    '将 “forge” 等词语的首字母大写
-                    Ex = Ex.Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
-                    Subtitle &= "  |  " & Ex.Trim
-                Next
-            Else
-NoSubtitle:
-                Subtitle = ""
-            End If
-            Return New KeyValuePair(Of String, String)(Title, Subtitle)
-        End Function
-
-        '辅助函数
-
-        ''' <summary>
-        ''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。
-        ''' </summary>
-        Public Function IsLike(Project As CompProject) As Boolean
-            If Id = Project.Id Then Return True '相同实例
-            '提取字符串中的字母和数字
-            Dim GetRaw =
-            Function(Data As String) As String
-                Dim Result As New StringBuilder()
-                For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
-                    Result.Append(r)
-                Next
-                Return Result.ToString.ToLower
-            End Function
-            '来自不同的网站
-            If FromCurseForge = Project.FromCurseForge Then Return False
-            'Mod 加载器一致
-            If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
-            '若不为光影,则要求 MC 版本一致
-            If Type <> CompType.Shader AndAlso (GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any()) Then Return False
-            '最近更新时间差距在一周以内
-            If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
-               Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
-            'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
-            If TranslatedName = Project.TranslatedName OrElse
-               RawName = Project.RawName OrElse Description = Project.Description OrElse
-               GetRaw(Slug) = GetRaw(Project.Slug) Then
-                Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
-                '如果只有一个有 DatabaseEntry,设置给另外一个
-                If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry
-                If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry
-                Return True
-            End If
-            Return False
-        End Function
-
-        Public Overrides Function ToString() As String
-            Return $"{Id} ({Slug}): {RawName}"
-        End Function
-        Public Overrides Function Equals(obj As Object) As Boolean
-            Dim project = TryCast(obj, CompProject)
-            Return project IsNot Nothing AndAlso Id = project.Id
-        End Function
-        Public Shared Operator =(left As CompProject, right As CompProject) As Boolean
-            Return EqualityComparer(Of CompProject).Default.Equals(left, right)
-        End Operator
-        Public Shared Operator <>(left As CompProject, right As CompProject) As Boolean
-            Return Not left = right
-        End Operator
-
-    End Class
-
-    '输入与输出
-
-    Public Class CompProjectRequest
-
-        '结果要求
-
-        ''' <summary>
-        ''' 加载后应输出到的结果存储器。
-        ''' </summary>
-        Public Storage As CompProjectStorage
-        ''' <summary>
-        ''' 应当尽量达成的结果数量。
-        ''' </summary>
-        Public TargetResultCount As Integer
-        ''' <summary>
-        ''' 根据加载位置记录,是否还可以继续获取内容。
-        ''' </summary>
-        Public ReadOnly Property CanContinue As Boolean
-            Get
-                If Tag.StartsWithF("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
-                If Tag.EndsWithF("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
-                If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
-                Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
-            End Get
-        End Property
-
-        '输入内容
-
-        ''' <summary>
-        ''' 筛选资源种类。
-        ''' </summary>
-        Public Type As CompType
-        ''' <summary>
-        ''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。
-        ''' </summary>
-        Public Tag As String = ""
-        ''' <summary>
-        ''' 筛选 Mod 加载器类别。
-        ''' </summary>
-        Public ModLoader As CompModLoaderType = CompModLoaderType.Any
-        ''' <summary>
-        ''' 筛选 MC 版本。
-        ''' </summary>
-        Public GameVersion As String = Nothing
-        ''' <summary>
-        ''' 搜索的文本内容。
-        ''' </summary>
-        Public SearchText As String = Nothing
-        ''' <summary>
-        ''' 允许的来源。
-        ''' </summary>
-        Public Source As CompSourceType = CompSourceType.Any
-        ''' <summary>
-        ''' 构造函数。
-        ''' </summary>
-        Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer)
-            Me.Type = Type
-            Me.Storage = Storage
-            Me.TargetResultCount = TargetResultCount
-        End Sub
-
-        '构造请求
-
-        ''' <summary>
-        ''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。
-        ''' </summary>
-        Public Function GetCurseForgeAddress() As String
-            If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
-            If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
-            If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
-            '应用筛选参数
-            Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
-            Select Case Type
-                Case CompType.Mod
-                    Address += "&classId=6"
-                Case CompType.ModPack
-                    Address += "&classId=4471"
-                Case CompType.DataPack
-                    Address += "&classId=6945"
-                Case CompType.Shader
-                    Address += "&classId=6552"
-                Case CompType.ResourcePack
-                    Address += "&classId=12"
-            End Select
-            Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
-            If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
-            If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
-            If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
-            If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
-            Return Address
-        End Function
-        ''' <summary>
-        ''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。
-        ''' </summary>
-        Public Function GetModrinthAddress() As String
-            If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
-            If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
-            If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
-            '应用筛选参数
-            Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
-            If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText)
-            If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
-            'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
-            Dim Facets As New List(Of String)
-            Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
-            If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
-            If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
-            If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
-            Address += "&facets=[" & String.Join(",", Facets) & "]"
-            Return Address
-        End Function
-
-        '相同判断
-        Public Overrides Function Equals(obj As Object) As Boolean
-            Dim request = TryCast(obj, CompProjectRequest)
-            Return request IsNot Nothing AndAlso
-                Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
-                Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso Source = request.Source AndAlso
-                GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
-        End Function
-        Public Shared Operator =(left As CompProjectRequest, right As CompProjectRequest) As Boolean
-            Return EqualityComparer(Of CompProjectRequest).Default.Equals(left, right)
-        End Operator
-        Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean
-            Return Not left = right
-        End Operator
-
-    End Class
-    Public Class CompProjectStorage
-
-        '加载位置记录
-
-        Public CurseForgeOffset As Integer = 0
-        Public CurseForgeTotal As Integer = -1
-
-        Public ModrinthOffset As Integer = 0
-        Public ModrinthTotal As Integer = -1
-
-        '结果列表
-
-        ''' <summary>
-        ''' 可供展示的所有工程的列表。
-        ''' </summary>
-        Public Results As New List(Of CompProject)
-        ''' <summary>
-        ''' 当前的错误信息。如果没有则为 Nothing。
-        ''' </summary>
-        Public ErrorMessage As String = Nothing
-
-    End Class
-
-    '实际的获取
-
-    Private Const CompPageSize = 40
-    ''' <summary>
-    ''' 已知工程信息的缓存。
-    ''' </summary>
-    Public CompProjectCache As New Dictionary(Of String, CompProject)
-    ''' <summary>
-    ''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。
-    ''' </summary>
-    Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
-        Dim Storage = Task.Input.Storage '避免多线程问题
-
-        If Task.Input.Storage.Results.Count >= Task.Input.TargetResultCount Then
-            Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
-            Exit Sub
-        ElseIf Not Task.Input.CanContinue Then
-            If Not Task.Input.Storage.Results.Any() Then
-                Throw New Exception("没有符合条件的结果")
-            Else
-                Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
-                Exit Sub
-            End If
-        End If
-
-#Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)"
-
-        If Task.Input.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
-            Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
-        End If
-
-#End Region
-
-#Region "处理搜索文本,赋值回 Task.Input.SearchText"
-
-        Dim RawFilter As String = If(Task.Input.SearchText, "").Trim
-        Task.Input.SearchText = RawFilter
-        RawFilter = RawFilter.ToLower
-        Log("[Comp] 工程列表搜索原始文本:" & RawFilter)
-
-        '中文请求关键字处理
-        Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter)
-        If IsChineseSearch AndAlso (Task.Input.Type = CompType.Mod OrElse Task.Input.Type = CompType.DataPack) Then
-            '构造搜索请求
-            Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
-            For Each Entry In CompDatabase
-                If Entry.ChineseName.Contains("动态的树") Then Continue For '这玩意儿附属太多了
-                SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With {
-                    .Item = Entry,
-                    .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
-                        New KeyValuePair(Of String, Double)(Entry.ChineseName & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 1)
-                    }
-                })
-            Next
-            '获取搜索结果
-            Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
-            If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
-            Dim SearchResult As String = ""
-            For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
-                If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
-                If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
-                If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
-                SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
-                    Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
-            Next
-            Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
-            '去除常见连接词
-            Dim RealFilter As String = ""
-            For Each Word In SearchResult.Split(" ")
-                If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLowerInvariant) OrElse Val(Word) > 0 Then Continue For
-                If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
-                RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
-            Next
-            Task.Input.SearchText = RealFilter
-            Log("[Comp] 中文搜索最终关键词:" & RealFilter, LogLevel.Developer)
-        End If
-
-        '驼峰英文请求关键字处理
-        Dim SpacedKeywords = Task.Input.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
-        Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
-        Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
-
-        '最终处理关键字:分割、去重
-        Dim RightKeywords As New List(Of String)
-        For Each Keyword In AllPossibleKeywords.Split(" ")
-            Keyword = Keyword.Trim("["c, "]"c)
-            If Keyword = "" Then Continue For
-            If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
-                Log("[Comp] 已跳过搜索关键词:" & Keyword, LogLevel.Developer)
-                Continue For
-            End If
-            RightKeywords.Add(Keyword)
-        Next
-        If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
-            Task.Input.SearchText = RawFilter '全都被过滤掉了
-        Else
-            Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
-        End If
-
-        '例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
-        If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
-        If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
-        Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
-        Task.Progress = 0.1
-
-#End Region
-
-        Dim RealResults As New List(Of CompProject)
-Retry:
-        Dim RawResults As New List(Of CompProject)
-        Dim [Error] As Exception = Nothing
-
-#Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
-
-        Dim CurseForgeThread As Thread = Nothing
-        Dim ModrinthThread As Thread = Nothing
-        Dim ResultsLock As New Object
-
-        Try
-
-            '启动 CurseForge 线程
-            Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress()
-            Dim CurseForgeFailed As Boolean = False
-            If CurseForgeUrl IsNot Nothing Then
-                CurseForgeThread = RunInNewThread(
-                Sub()
-                    Try
-                        '获取工程列表
-                        Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
-                        Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
-                        Task.Progress += 0.2
-                        Dim ProjectList As New List(Of CompProject)
-                        For Each JsonEntry As JObject In RequestResult("data")
-                            Dim Project As New CompProject(JsonEntry)
-                            If Task.Input.Type = CompType.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
-                            ProjectList.Add(Project)
-                        Next
-                        '更新结果
-                        SyncLock ResultsLock
-                            RawResults.AddRange(ProjectList)
-                        End SyncLock
-                        Storage.CurseForgeOffset += ProjectList.Count
-                        Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
-                        Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
-                    Catch ex As Exception
-                        Log(ex, "从 CurseForge 获取工程列表失败")
-                        Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
-                        [Error] = ex
-                        CurseForgeFailed = True
-                    End Try
-                End Sub, "CurseForge Project Request")
-            End If
-
-            '启动 Modrinth 线程
-            Dim ModrinthUrl As String = Task.Input.GetModrinthAddress()
-            Dim ModrinthFailed As Boolean = False
-            If ModrinthUrl IsNot Nothing Then
-                ModrinthThread = RunInNewThread(
-                Sub()
-                    Try
-                        Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
-                        Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
-                        Task.Progress += 0.2
-                        Dim ProjectList As New List(Of CompProject)
-                        For Each JsonEntry As JObject In RequestResult("hits")
-                            ProjectList.Add(New CompProject(JsonEntry))
-                        Next
-                        '更新结果
-                        SyncLock ResultsLock
-                            For Each Project In ProjectList
-                                RawResults.Add(Project)
-                            Next
-                        End SyncLock
-                        Storage.ModrinthOffset += ProjectList.Count
-                        Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
-                        Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
-                    Catch ex As Exception
-                        Log(ex, "从 Modrinth 获取工程列表失败")
-                        Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
-                        [Error] = ex
-                        ModrinthFailed = True
-                    End Try
-                End Sub, "Modrinth Project Request")
-            End If
-
-            '等待线程结束
-            If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join()
-            If Task.IsAborted Then Exit Sub '会自动触发 Finally
-            If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
-            If Task.IsAborted Then Exit Sub
-
-            '确保存在结果
-            Storage.ErrorMessage = Nothing
-            If Not RawResults.Any() Then
-                If [Error] IsNot Nothing Then
-                    Throw [Error]
-                Else
-                    If IsChineseSearch AndAlso Not (Task.Input.Type = CompType.Mod OrElse Task.Input.Type = CompType.DataPack) Then
-                        Throw New Exception("没有搜索结果,请尝试使用英文搜索")
-                    ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
-                        Throw New Exception("CurseForge 不兼容所选的类型")
-                    ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
-                        Throw New Exception("Modrinth 不兼容所选的类型")
-                    Else
-                        Throw New Exception("没有搜索结果")
-                    End If
-                End If
-            ElseIf [Error] IsNot Nothing Then
-                '有结果但是有错误
-                If CurseForgeFailed Then
-                    Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。"
-                Else
-                    Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。"
-                End If
-            End If
-
-        Finally
-            If CurseForgeThread IsNot Nothing Then CurseForgeThread.Interrupt()
-            If ModrinthThread IsNot Nothing Then ModrinthThread.Interrupt()
-        End Try
-
-#End Region
-
-#Region "提取非重复项,存储于 RealResults"
-
-        '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同
-        '这样做的话,去重后将优先保留 CurseForge 内容
-        RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
-        'RawResults 去重
-        RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
-        '已有内容去重
-        RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
-                                                  Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
-        '加入列表
-        RealResults.AddRange(RawResults)
-        Log($"[Comp] 去重、筛选后累计新增结果 {RealResults.Count} 个")
-
-#End Region
-
-#Region "检查结果数量,如果不足且可继续,会继续加载下一页"
-
-        If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
-            Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
-            If Task.Input.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
-                Log("[Comp] 将继续尝试加载下一页")
-                GoTo Retry
-            Else
-                Log("[Comp] 无法继续加载,将强制结束")
-            End If
-        End If
-
-#End Region
-
-#Region "将结果排序并添加"
-
-        Dim Scores As New Dictionary(Of CompProject, Double) '排序分
-        Dim GetDownloadCountMult =
-        Function(Project As CompProject) As Double
-            Select Case Task.Input.Type
-                Case CompType.Mod, CompType.ModPack
-                    Return If(Project.FromCurseForge, 1, 7)
-                Case CompType.DataPack
-                    Return If(Project.FromCurseForge, 10, 1)
-                Case CompType.ResourcePack, CompType.Shader
-                    Return If(Project.FromCurseForge, 1, 5)
-                Case Else
-                    Return 1
-            End Select
-        End Function
-        If String.IsNullOrEmpty(Task.Input.SearchText) Then
-            '如果没有搜索文本,按下载量将结果排序
-            For Each Result As CompProject In RealResults
-                Scores.Add(Result, Result.DownloadCount * GetDownloadCountMult(Result))
-            Next
-        Else
-            '如果有搜索文本,按关联度将结果排序
-            '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
-            Dim Entry As New List(Of SearchEntry(Of CompProject))
-            For Each Result As CompProject In RealResults
-                Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
-                           Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9)
-                Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
-                          New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
-                          New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
-            Next
-            Dim SearchResult = Search(Entry, RawFilter, 101, -1)
-            For Each OneResult In SearchResult
-                Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity '最高 1 分的相似度分
-            Next
-        End If
-        '根据排序分得出结果并添加
-        Storage.Results.AddRange(
-            Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
-
-#End Region
-
-    End Sub
-
-#End Region
-
-#Region "CompFile | 文件信息"
-
-    '类定义
-
-    Public Enum CompFileStatus
-        Release = 1 '枚举值来源:https://docs.curseforge.com/#tocS_FileReleaseType
-        Beta = 2
-        Alpha = 3
-    End Enum
-    Public Class CompFile
-
-        '源信息
-
-        ''' <summary>
-        ''' 文件的种类。
-        ''' </summary>
-        Public ReadOnly Type As CompType
-        ''' <summary>
-        ''' 该文件来自 CurseForge 还是 Modrinth。
-        ''' </summary>
-        Public ReadOnly FromCurseForge As Boolean
-        ''' <summary>
-        ''' 用于唯一性鉴别该文件的 ID。CurseForge 中为 123456 的大整数,Modrinth 中为英文乱码的 Version 字段。
-        ''' </summary>
-        Public ReadOnly Id As String
-
-        '描述性信息
-
-        ''' <summary>
-        ''' 文件描述名(并非文件名,是自定义的字段)。对很多 Mod,这会给出 Mod 版本号。
-        ''' </summary>
-        Public DisplayName As String
-        ''' <summary>
-        ''' 发布时间。
-        ''' </summary>
-        Public ReadOnly ReleaseDate As Date
-        ''' <summary>
-        ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量,且 CurseForge 可能错误地返回 0。
-        ''' </summary>
-        Public ReadOnly DownloadCount As Integer
-        ''' <summary>
-        ''' 支持的 Mod 加载器列表。可能为空。
-        ''' </summary>
-        Public ReadOnly ModLoaders As List(Of CompModLoaderType)
-        ''' <summary>
-        ''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
-        ''' </summary>
-        Public ReadOnly GameVersions As List(Of String)
-        ''' <summary>
-        ''' 发布状态:Release/Beta/Alpha。
-        ''' </summary>
-        Public ReadOnly Status As CompFileStatus
-        ''' <summary>
-        ''' 发布状态的友好描述。例如:"正式版","Beta 版"。
-        ''' </summary>
-        Public ReadOnly Property StatusDescription As String
-            Get
-                Select Case Status
-                    Case CompFileStatus.Release
-                        Return "正式版"
-                    Case CompFileStatus.Beta
-                        Return If(ModeDebug, "Beta 版", "测试版")
-                    Case Else
-                        Return If(ModeDebug, "Alpha 版", "早期测试版")
-                End Select
-            End Get
-        End Property
-
-        '下载信息
-        ''' <summary>
-        ''' 下载信息是否可用。
-        ''' </summary>
-        Public ReadOnly Property Available As Boolean
-            Get
-                Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
-            End Get
-        End Property
-        ''' <summary>
-        ''' 下载的文件名。
-        ''' </summary>
-        Public ReadOnly FileName As String = Nothing
-        ''' <summary>
-        ''' 文件所有可能的下载源。
-        ''' </summary>
-        Public DownloadUrls As List(Of String)
-        ''' <summary>
-        ''' 文件的 SHA1 或 MD5。
-        ''' </summary>
-        Public ReadOnly Hash As String = Nothing
-        ''' <summary>
-        ''' 该文件的所有依赖工程的原始 ID。
-        ''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
-        ''' </summary>
-        Public ReadOnly RawDependencies As New List(Of String)
-        ''' <summary>
-        ''' 该文件的所有依赖工程的 Project.Id。
-        ''' </summary>
-        Public ReadOnly Dependencies As New List(Of String)
-        ''' <summary>
-        ''' 获取下载信息。
-        ''' </summary>
-        ''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
-        Public Function ToNetFile(LocalAddress As String) As NetFile
-            Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
-        End Function
-
-        '实例化
-
-        ''' <summary>
-        ''' 从文件 Json 中初始化实例。若出错会抛出异常。
-        ''' </summary>
-        Public Sub New(Data As JObject, DefaultType As CompType)
-            Type = DefaultType
-            If Data.ContainsKey("FromCurseForge") Then
-#Region "CompJson"
-                FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
-                Id = Data("Id").ToString
-                DisplayName = Data("DisplayName").ToString
-                ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
-                DownloadCount = Data("DownloadCount").ToObject(Of Integer)
-                Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
-                If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString
-                If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
-                If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType))
-                If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString
-                If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String))
-                If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
-                If Data.ContainsKey("Dependencies") Then Dependencies = Data("Dependencies").ToObject(Of List(Of String))
-#End Region
-            Else
-                FromCurseForge = Data.ContainsKey("gameId")
-                If FromCurseForge Then
-#Region "CurseForge"
-                    '简单信息
-                    Id = Data("id")
-                    DisplayName = Data("displayName").ToString.Replace("	", "").Trim(" ")
-                    ReleaseDate = Data("fileDate")
-                    Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
-                    DownloadCount = Data("downloadCount")
-                    FileName = Data("fileName")
-                    Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
-                    If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
-                    'DownloadAddress
-                    Dim Url = Data("downloadUrl").ToString
-                    If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
-                    Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
-                    DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
-                    DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
-                    DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
-                    'Dependencies
-                    If Data.ContainsKey("dependencies") Then
-                        RawDependencies = Data("dependencies").
-                            Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
-                                              d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
-                            Select(Function(d) d("modId").ToString).ToList
-                    End If
-                    'GameVersions
-                    Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
-                    GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
-                    If GameVersions.Count > 1 Then
-                        GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
-                        If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
-                    ElseIf GameVersions.Count = 1 Then
-                        GameVersions = GameVersions.ToList
-                    Else
-                        GameVersions = New List(Of String) From {"未知版本"}
-                    End If
-                    'ModLoaders
-                    ModLoaders = New List(Of CompModLoaderType)
-                    If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
-                    If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
-                    If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
-                    If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
-#End Region
-                Else
-#Region "Modrinth"
-                    '简单信息
-                    Id = Data("id")
-                    DisplayName = Data("name").ToString.Replace("	", "").Trim(" ")
-                    ReleaseDate = Data("date_published")
-                    Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
-                    DownloadCount = Data("downloads")
-                    If CType(Data("files"), JArray).Any() Then '可能为空
-                        Dim File As JToken = Data("files")(0)
-                        FileName = File("filename")
-                        DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
-                        Hash = File("hashes")("sha1")
-                    End If
-                    'ModLoaders
-                    '结果可能混杂着 Mod、数据包和服务端插件
-                    Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
-                    ModLoaders = New List(Of CompModLoaderType)
-                    If Type = CompType.Mod Then '以尽量宽容的方式检测加载器,以免同时兼容两种的项被删除
-                        If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then Type = CompType.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
-                        If RawLoaders.Contains("datapack") Then Type = CompType.DataPack
-                        If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) : Type = CompType.Mod
-                        If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge) : Type = CompType.Mod
-                        If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) : Type = CompType.Mod
-                        If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) : Type = CompType.Mod
-                    ElseIf Type = CompType.DataPack Then
-                        If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then Type = CompType.Plugin
-                        If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) : Type = CompType.Mod
-                        If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge) : Type = CompType.Mod
-                        If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) : Type = CompType.Mod
-                        If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) : Type = CompType.Mod
-                        If RawLoaders.Contains("datapack") Then Type = CompType.DataPack
-                    End If
-                    'Dependencies
-                    If Data.ContainsKey("dependencies") Then
-                        RawDependencies = Data("dependencies").
-                            Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
-                                              d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
-                                              d("project_id").ToString.Length > 0). '有时候真的会空……
-                            Select(Function(d) d("project_id").ToString).ToList
-                    End If
-                    'GameVersions
-                    Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
-                    GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
-                                               Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
-                    If GameVersions.Count > 1 Then
-                        GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
-                        If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
-                    ElseIf GameVersions.Count = 1 Then
-                        '无需处理
-                    ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
-                        GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
-                    Else
-                        GameVersions = New List(Of String) From {"未知版本"}
-                    End If
-#End Region
-                End If
-            End If
-        End Sub
-
-        ''' <summary>
-        ''' 重新整理 CurseForge 的下载地址。
-        ''' </summary>
-        Public Shared Function HandleCurseForgeDownloadUrls(Url As String) As List(Of String)
-            Return {
-                Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
-                Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
-                Url.Replace("://edge", "://media"),
-                Url
-            }.Distinct.ToList
-        End Function
-
-        ''' <summary>
-        ''' 将当前实例转为可用于保存缓存的 Json。
-        ''' </summary>
-        Public Function ToJson() As JObject
-            Dim Json As New JObject
-            Json.Add("FromCurseForge", FromCurseForge)
-            Json.Add("Id", Id)
-            Json.Add("DisplayName", DisplayName)
-            Json.Add("ReleaseDate", ReleaseDate)
-            Json.Add("DownloadCount", DownloadCount)
-            Json.Add("ModLoaders", New JArray(ModLoaders.Select(Function(m) CInt(m))))
-            Json.Add("GameVersions", New JArray(GameVersions))
-            Json.Add("Status", CInt(Status))
-            If FileName IsNot Nothing Then Json.Add("FileName", FileName)
-            If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls))
-            If Hash IsNot Nothing Then Json.Add("Hash", Hash)
-            Json.Add("RawDependencies", New JArray(RawDependencies))
-            Json.Add("Dependencies", New JArray(Dependencies))
-            Return Json
-        End Function
-        ''' <summary>
-        ''' 将当前文件信息实例化为控件。
-        ''' </summary>
-        Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
-                                   Optional BadDisplayName As Boolean = False) As MyListItem
-
-            '获取描述信息
-            Dim Title As String = If(BadDisplayName, FileName, DisplayName)
-            Dim Info As New List(Of String)
-            If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
-            If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
-            If GameVersions.All(Function(v) Not IsVersionNameLikeRelease(v)) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
-            If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
-                Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
-            End If
-            Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
-            If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
-
-            '建立控件
-            Dim NewItem As New MyListItem With {
-                .Title = Title,
-                .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
-                .Info = Info.Join(",")
-            }
-            Select Case Status
-                Case CompFileStatus.Release
-                    NewItem.Logo = PathImage & "Icons/R.png"
-                Case CompFileStatus.Beta
-                    NewItem.Logo = PathImage & "Icons/B.png"
-                Case Else 'Alpha
-                    NewItem.Logo = PathImage & "Icons/A.png"
-            End Select
-            AddHandler NewItem.Click, OnClick
-
-            '建立另存为按钮
-            If OnSaveClick IsNot Nothing Then
-                Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
-                ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
-                ToolTipService.SetVerticalOffset(BtnSave, 30)
-                ToolTipService.SetHorizontalOffset(BtnSave, 2)
-                AddHandler BtnSave.Click, OnSaveClick
-                NewItem.Buttons = {BtnSave}
-            End If
-
-            '结束
-            Return NewItem
-        End Function
-
-        '辅助函数
-
-        Public Overrides Function ToString() As String
-            Return $"{Id}: {FileName}"
-        End Function
-
-    End Class
-
-    '获取
-
-    ''' <summary>
-    ''' 已知文件信息的缓存。
-    ''' </summary>
-    Public CompFilesCache As New Dictionary(Of String, List(Of CompFile))
-    ''' <summary>
-    ''' 获取某个工程下的全部文件列表。
-    ''' 必须在工作线程执行,失败会抛出异常。
-    ''' </summary>
-    Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
-        '获取工程对象
-        Dim TargetProject As CompProject
-        If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
-            TargetProject = CompProjectCache(ProjectId)
-        ElseIf FromCurseForge Then 'CurseForge
-            TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
-        Else 'Modrinth
-            TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
-        End If
-        '获取工程对象的文件列表
-        If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回,这时候前置可能没获取(#5173)
-            Log("[Comp] 开始获取文件列表:" & ProjectId)
-            Dim ResultJsonArray As JArray
-            If FromCurseForge Then
-                'CurseForge
-                'HMCL 一次性请求了 10000 个文件,虽然不知道会不会出问题但先这样吧……(#5522)
-                ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=10000", IsJson:=True)("data")
-                '之前只请求一部分文件的方法备份如下:
-                'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
-                '    ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
-                'Else '否则使用全部文件
-                '    ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
-                'End If
-            Else
-                'Modrinth
-                ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
-            End If
-            CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
-                Where(Function(a) a.Available).ToList.
-                Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
-        End If
-        '获取前置列表
-        Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
-        Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
-        '获取前置工程信息
-        If UndoneDeps.Any Then
-            Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置:{Join(UndoneDeps, ",")}")
-            Dim Projects As JArray
-            If TargetProject.FromCurseForge Then
-                Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
-                    "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
-            Else
-                Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
-            End If
-            For Each Project In Projects
-                Dim Unused As New CompProject(Project) '在 New 的时候会添加缓存以便之后读取
-            Next
-        End If
-        '更新前置信息
-        If Deps.Any Then
-            For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
-                For Each File In CompFilesCache(ProjectId)
-                    If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
-                        If Not File.Dependencies.Contains(DepProject.Id) Then File.Dependencies.Add(DepProject.Id)
-                    End If
-                Next
-            Next
-        End If
-        Return CompFilesCache(ProjectId)
-    End Function
-
-    ''' <summary>
-    ''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置列表。
-    ''' </summary>
-    Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile))
-        '获取卡片对应的前置 ID
-        '如果为整合包就不会有 Dependencies 信息,所以不用管
-        Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
-        Deps.Sort()
-        If Not Deps.Any() Then Exit Sub
-        Deps = Deps.Where(
-        Function(dep)
-            If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置信息", LogLevel.Debug)
-            Return CompProjectCache.ContainsKey(dep)
-        End Function).ToList
-        '添加开头间隔
-        Stack.Children.Add(New TextBlock With {.Text = "前置资源", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
-        '添加前置列表
-        For Each Dep In Deps
-            Dim Item = CompProjectCache(Dep).ToCompItem(False, False)
-            Stack.Children.Add(Item)
-        Next
-        '添加结尾间隔
-        Stack.Children.Add(New TextBlock With {.Text = "版本列表", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
-    End Sub
-
-#End Region
-
-End Module

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 254 - 243
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb


Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 287 - 257
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb


+ 507 - 703
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb

@@ -1,777 +1,581 @@
-Public Module ModJava
-    Public JavaListCacheVersion As Integer = 7
+Public Module ModJava
 
     ''' <summary>
-    ''' 目前所有可用的 Java。
+    ''' 初始化 Java 列表。
+    ''' 若没有任何可用的 Java,则触发搜索。
     ''' </summary>
-    Public JavaList As New List(Of JavaEntry)
-
-    Public Class JavaEntry
-
-        '路径
-        ''' <summary>
-        ''' Java.exe 文件的完整路径。
-        ''' </summary>
-        Public ReadOnly Property PathJava As String
-            Get
-                Return PathFolder & "java.exe"
-            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 文件所在文件夹的路径,以 \ 结尾。
-        ''' </summary>
-        Public PathFolder As String
-        ''' <summary>
-        ''' 是否为用户手动导入的 Java。
-        ''' </summary>
-        Public IsUserImport As Boolean
-
-        '版本信息
-        ''' <summary>
-        ''' Java 的详细版本。若不足 4 位会在前方补 1,例如 1.16.0.1。
-        ''' 其大版本号为 Minor。
-        ''' </summary>
-        Public Version As Version
-        ''' <summary>
-        ''' Java 的大版本号。
-        ''' </summary>
-        Public ReadOnly Property VersionCode As Integer
-            Get
-                Return Version.Minor
-            End Get
-        End Property
-        ''' <summary>
-        ''' 是否为 Java Runtime Environment。
-        ''' </summary>
-        Public IsJre As Boolean
-        ''' <summary>
-        ''' 是否为 64 位 Java。
-        ''' </summary>
-        Public Is64Bit As Boolean
-        ''' <summary>
-        ''' 是否已设置环境变量。
-        ''' </summary>
-        Public ReadOnly Property HasEnvironment As Boolean
-            Get
-                If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
-                Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
-            End Get
-        End Property
-
-        '序列化
-        Public Function ToJson() As JObject
-            Return New JObject({New JProperty("Path", PathFolder), New JProperty("VersionString", Version.ToString), New JProperty("IsJre", IsJre), New JProperty("Is64Bit", Is64Bit), New JProperty("IsUserImport", IsUserImport)})
-        End Function
-        Public Shared Function FromJson(Data As JObject) As JavaEntry
-            Return New JavaEntry(Data("Path"), Data("IsUserImport")) With {.Version = New Version(Data("VersionString")), .IsJre = Data("IsJre"), .Is64Bit = Data("Is64Bit")}
-        End Function
-        ''' <summary>
-        ''' 转化为用户友好的字符串输出。
-        ''' </summary>
-        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
-        End Function
-
-        '构造
-        ''' <summary>
-        ''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
-        ''' </summary>
-        Public Sub New(Folder As String, IsUserImport As Boolean)
-            If Not Folder.EndsWithF("\") Then Folder += "\"
-            PathFolder = Folder.Replace("/", "\")
-            Me.IsUserImport = IsUserImport
-        End Sub
-
-        '方法
-        Private IsChecked As Boolean = False
-        ''' <summary>
-        ''' 检查并获取 Java 详细信息。在 Java 存在异常时抛出错误。
-        ''' </summary>
-        Public Sub Check()
-            If IsChecked Then Exit Sub
-            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
-                IsJre = Not File.Exists(PathFolder & "javac.exe")
-                '运行 -version
-                Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
-                If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
-                If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
-                If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
-                '获取详细信息
-                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"
-                Do While VersionString.Split(".").Count < 4
-                    If VersionString.StartsWithF("1.") Then
-                        VersionString = VersionString & ".0"
-                    Else
-                        VersionString = "1." & VersionString
+    Public Sub JavaInit()
+        Try
+            '从老版本迁移
+            If Configs.JavaConfigVersion.Get() = 0 Then
+                Try
+                    'Java 列表
+                    Logger.Warn("正在从老版本迁移 Java 列表")
+                    Dim OldJavaList = Settings.Get(Of String)("LaunchArgumentJavaAll").DeserializeJson(Of JArray).
+                                      Select(Function(JavaObject) New Java(JavaObject("Path").ToString)).ToList()
+                    OldJavaList = JavaUtils.SortAsync(OldJavaList).Run()
+                    Logger.Info($"已从老版本设置中发现 {OldJavaList.Count} 个 Java")
+                    '强制选择的 Java
+                    Dim SelectedJavaSetting = Settings.Get(Of String)("LaunchArgumentJavaSelect")
+                    Dim SelectedJava = If(SelectedJavaSetting.StartsWithF("{"), SelectedJavaSetting.DeserializeJson(Of JObject)()("Path").ToString, "")
+                    Dim Match = OldJavaList.FirstOrDefault(Function(j) j.Folder.Equals(SelectedJava, StringComparison.OrdinalIgnoreCase))
+                    If Match IsNot Nothing Then
+                        OldJavaList.Remove(Match)
+                        OldJavaList.Insert(0, Match)
+                        Logger.Info($"已将老版本设置中强制选择的 Java 置顶:{Match}")
                     End If
-                Loop
-                If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为:{vbCrLf}{Output}", "")}")
-                Version = New Version(VersionString)
-                If Version.Minor = 0 Then
-                    Log("[Java] 疑似 X.0.X.X 格式版本号:" & Version.ToString)
-                    Version = New Version(1, Version.Major, Version.Build, Version.Revision)
-                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
-                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)
-            End Try
-            IsChecked = True
-        End Sub
-
-    End Class
+                    Configs.JavaList.Set(New ConcurrentList(Of Java)(OldJavaList))
+                    '完成迁移
+                    Configs.JavaConfigVersion.Set(Versions.JavaConfigVersion)
+                Catch ex As Exception
+                    Logger.Error(ex, "从老版本 PCL 迁移 Java 列表失败")
+                End Try
+            End If
+            '读取缓存
+            Dim List = Configs.JavaList.Get()
+            If List.Any Then
+                Logger.Info($"共有 {List.Count} 个可用的 Java:{vbCrLf}- {List.Select(Function(j) j.ToString).Join(vbCrLf + "- ")}")
+                Return
+            End If
+            '如果没有 Java,则触发搜索
+            Logger.Warn("初始化未找到可用的 Java,将自动触发搜索")
+            JavaListRefreshWorker.Start()
+        Catch ex As Exception
+            Logger.Error(ex, "初始化 Java 列表失败")
+            Configs.JavaList.Reset()
+        End Try
+    End Sub
 
     ''' <summary>
-    ''' Path 环境变量。
+    ''' 搜索并获取所有可用的 Java,检查所有 Java 的可用性,写入设置,并在结束后更新设置页面显示。
     ''' </summary>
-    Private ReadOnly Property PathEnv As String
-        Get
-            If _PathEnv Is Nothing Then _PathEnv = If(Environment.GetEnvironmentVariable("Path"), "")
-            Return _PathEnv
-        End Get
-    End Property
-    Private _PathEnv As String = Nothing
+    Public WithEvents JavaListRefreshWorker As New RedoableWorker(Sub(c, p) JavaUtils.RefreshListAsync(c, p).Run())
+
+#Region "UI 事件"
 
     ''' <summary>
-    ''' JAVA_HOME 环境变量。
+    ''' 更新设置页面的 Java 列表显示。
     ''' </summary>
-    Private ReadOnly Property PathJavaHome As String
-        Get
-            If _PathJavaHome Is Nothing Then _PathJavaHome = If(Environment.GetEnvironmentVariable("JAVA_HOME"), "")
-            Return _PathJavaHome
-        End Get
-    End Property
-    Private _PathJavaHome As String = Nothing
+    Public Sub UpdateJavaLists() Handles JavaListRefreshWorker.Started, JavaListRefreshWorker.Stopped
+        RunInUi(
+        Sub()
+            FrmSetupLaunch?.UpdateJavaList()
+            FrmInstanceSetup?.UpdateJavaList()
+        End Sub)
+    End Sub
 
     ''' <summary>
-    ''' 初始化 Java 列表,但除非没有 Java,否则不进行检查。
+    ''' 手动触发导入 Java。
     ''' </summary>
-    Public Sub JavaListInit()
-        JavaList = New List(Of JavaEntry)
-        Try
-            If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then
-                '不使用缓存
-                Log("[Java] 要求 Java 列表缓存更新")
-                Setup.Set("CacheJavaListVersion", JavaListCacheVersion)
-            Else
-                '使用缓存
-                For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll"))
-                    JavaList.Add(JavaEntry.FromJson(JsonEntry))
-                Next
-            End If
-            If Not JavaList.Any() Then
-                Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
-                JavaSearchLoader.Start(0)
-            Else
-                Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java:")
-                JavaList.ForEach(Sub(j) Log($"[Java]  - {j}"))
-            End If
-        Catch ex As Exception
-            Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
-            Setup.Set("LaunchArgumentJavaAll", "[]")
-        End Try
+    Public Sub ManuallyImportJava()
+        '选择
+        Dim NewJavaPath As String = Dialogs.SelectFile("选择 java.exe(可能在 bin 文件夹中)", False, filter:="java.exe|java.exe").FirstOrDefault()
+        If String.IsNullOrEmpty(NewJavaPath) Then Return
+        '验证 Java 可用
+        Dim NewJava As New Java(PathUtils.RemoveLastPart(NewJavaPath))
+        If Not NewJava.CheckAsync().Run() Then
+            Hint("该 Java 存在异常,无法使用", HintType.Red)
+            Return
+        End If
+        '不再移除它
+        Configs.JavaRemovedList.Edit(Sub(ByRef List) List.RemoveIf(Function(f) f.Equals(NewJava.Folder, StringComparison.OrdinalIgnoreCase)))
+        '加入列表顶部
+        Configs.JavaList.Edit(
+        Sub(ByRef List)
+            List.Remove(NewJava)
+            List.Insert(0, NewJava)
+        End Sub)
+        Hint($"已将 Java 加入列表:{NewJavaPath}", HintType.Green)
+        UpdateJavaLists()
     End Sub
 
     ''' <summary>
-    ''' 防止多个需要 Java 的部分同时要求下载 Java(#3797)。
+    ''' 手动从 Java 列表中移除指定的 Java,并记录到已移除列表中。
     ''' </summary>
-    Public JavaLock As New Object
+    Public Sub ManuallyRemoveJava(JavaEntry As Java)
+        Configs.JavaList.Edit(Sub(ByRef List) List.Remove(JavaEntry)) '从 Java 列表中移除
+        Configs.JavaRemovedList.Edit(Function(List) List.Append(JavaEntry.Folder).DistinctBy(Function(s) s.Lower()).ToList()) '记录已移除
+        Hint($"已将 Java 移除出列表:{JavaEntry}", HintType.Green)
+        UpdateJavaLists()
+        PageInstanceLeft.ReloadCurrentJava() '如果强制指定了该 Java,这会把它自动重置掉
+    End Sub
+
     ''' <summary>
-    ''' 根据要求返回最适合的 Java,若找不到则返回 Nothing。
-    ''' 最小与最大版本在与输入相同时也会通过。
-    ''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
+    ''' 手动触发搜索 Java。
     ''' </summary>
-    Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
-                               Optional RelatedVersion As McVersion = 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% 的话)
-            End If
-            JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
-            JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
-                ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
-            If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
-            Dim TargetJavaList As New List(Of JavaEntry)
-            For Each Entry In JavaPreList
-                TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
-            Next
-
-            '检查特定的 Java
-            If TargetJavaList.Any Then
-                TargetJavaList = JavaCheckList(TargetJavaList)
-                Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java:")
-                For Each Java In TargetJavaList
-                    Log($"[Java]  - {Java}")
-                Next
+    Public Sub ManuallySearchJava(Optional CancellationToken As CancellationToken = Nothing)
+        RunInThread(
+        Sub()
+            JavaListRefreshWorker.Start(cancellationToken:=CancellationToken)
+            JavaListRefreshWorker.WaitIfRunningAsync(cancellationToken:=CancellationToken).Run() 'worker 开始/结束时会自动重载 UI
+            If Configs.JavaList.Get().Any Then
+                Hint("已找到 " & Configs.JavaList.Get().Count & " 个 Java!", HintType.Green)
+            Else
+                Hint("未找到可用的 Java!", HintType.Red)
             End If
+        End Sub)
+    End Sub
 
-#Region "添加用户指定的 Java,储存到 UserJava 中"
-
-            Dim UserJava As JavaEntry = Nothing
-
-            '获取版本独立设置中指定的 Java
-            Dim VersionSelect As String = ""
-            If RelatedVersion IsNot Nothing Then
-                VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
-                If VersionSelect.StartsWithF("{") Then
-                    Try
-                        UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
-                        UserJava.Check()
-                    Catch ex As ThreadInterruptedException
-                        Throw
-                    Catch ex As Exception
-                        UserJava = Nothing
-                        Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
-                        Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
-                    End Try
-                End If
-            End If
+#End Region
 
-            '获取全局设置中指定的 Java
-            If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
-                Try
-                    UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
-                    UserJava.Check()
-                Catch ex As ThreadInterruptedException
-                    Throw
-                Catch ex As Exception
-                    UserJava = Nothing
-                    Setup.Reset("LaunchArgumentJavaSelect")
-                    Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
-                End Try
-            End If
+#Region "选取"
 
-            '添加到特定 Java 列表
-            If UserJava IsNot Nothing Then
-                Log($"[Java] 用户指定的 Java:{UserJava}")
-                TargetJavaList.Add(UserJava)
-            End If
+    ''' <summary>
+    ''' 分析指定 Minecraft 版本的基础 Java 版本要求。不受设置影响。
+    ''' 如果由于 Java 版本要求冲突而导致没有可用的 Java,则返回 null。
+    ''' </summary>
+    Public Function GetJavaRequirement(Instance As McInstance) As (Range As ValueRange(Of Version), RecommendedComponent As String)
 
-#End Region
+        '版本设置已经强制指定了 Java 版本要求
+        If Settings.Get(Of Integer)("VersionArgumentJavaV2", Instance) = 1 Then
+            Try
+                Dim Range = ValueRange(Of Version).FromString(Settings.Get(Of String)("VersionArgumentJavaRange", Instance), Function(s) StringUtils.ParseVersionWithDefaults(s))
+                Return (Range, Nothing)
+            Catch ex As Exception
+                Logger.Warn($"版本设置中指定的 Java 版本范围有误({Settings.Get(Of String)("VersionArgumentJavaRange", Instance)}),这可能是因为首次修改此设置,尚未初始化")
+            End Try
+        End If
 
-RetryGet:
-            '等待进行中的搜索结束
-            If JavaSearchLoader.State <> LoadState.Finished AndAlso JavaSearchLoader.State <> LoadState.Waiting Then JavaSearchLoader.WaitForExit()
-            Select Case JavaSearchLoader.State
-                Case LoadState.Failed
-                    Throw JavaSearchLoader.Error
-                Case LoadState.Aborted
-                    Throw New ThreadInterruptedException("Java 搜索加载器已中断")
-            End Select
+        '----------------------------------- 从 Minecraft 版本信息获取需求 -----------------------------------
 
-            '生成完整的 Java 列表
-            Dim AllJavaList As New List(Of JavaEntry)
-            AllJavaList.AddRange(TargetJavaList)
-            AllJavaList.AddRange(JavaList)
-
-            '根据选定条件进行过滤
-            For Each Java In AllJavaList
-                If MinVersion IsNot Nothing AndAlso Java.Version < MinVersion Then Continue For
-                If MaxVersion IsNot Nothing AndAlso Java.Version > MaxVersion Then Continue For
-                If Java.Is64Bit AndAlso Is32BitSystem Then Continue For
-                AllowedJavaList.Add(Java)
-            Next
+        Dim JavaRange = ValueRange(Of Version).All()
+        Dim AddConstraint =
+        Sub(Constraint As ValueRange(Of Version))
+            JavaRange = JavaRange?.Intersect(Constraint)
+            If JavaRange.IsEmpty Then Logger.Warn($"Java 版本要求冲突(当前追加的要求为 {Constraint},版本为 {Instance.VersionDisplayName})")
+        End Sub
 
-            '若未找到适合的 Java,尝试触发搜索
-            If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
-                Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
-                JavaSearchLoader.Start(IsForceRestart:=True)
-                GoTo RetryGet
-            End If
+        '原版 26-:通过版本号判断
+        If (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2024, 4, 2)) OrElse
+           (Instance.Version.Vaild AndAlso Instance.Version.Vanilla >= New Version(20, 0, 5)) Then
+            '1.20.5+(24w14a+):至少 Java 21
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(21, 0)))
+        ElseIf (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2021, 11, 16)) OrElse
+               (Instance.Version.Vaild AndAlso Instance.Version.Vanilla.Major >= 18) Then
+            '1.18 pre2+:至少 Java 17
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(17, 0)))
+        ElseIf (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2021, 5, 11)) OrElse
+               (Instance.Version.Vaild AndAlso Instance.Version.Vanilla.Major >= 17) Then
+            '1.17+ (21w19a+):至少 Java 16
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(16, 0)))
+        ElseIf Instance.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
+            '1.12+:至少 Java 8
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(8, 0)))
+        ElseIf Instance.ReleaseTime <= New Date(2013, 5, 1) AndAlso Instance.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
+            '1.5.2-:最高 Java 8
+            AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
+        End If
 
-#Region "检查用户指定的 Java 是否可用"
+        '原版 26+:获取 Mojang 要求的 Java 版本
+        Dim RecommendedComponent As String = Nothing
+        Dim RecommendedCode As Integer =
+            If(Instance.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
+            If(Instance.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
+        If RecommendedCode >= 22 Then
+            Logger.Info("Mojang 要求至少使用 Java " & RecommendedCode)
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(RecommendedCode, 0)))
+            RecommendedComponent =
+                If(Instance.JsonObject?("javaVersion")?("component")?.ToString,
+                   Instance.JsonVersion?("java_component")?.ToString)
+            If RecommendedComponent = "" Then RecommendedComponent = Nothing
+        End If
 
-            '确保指定的 Java 可用
-            If UserJava Is Nothing Then GoTo ExitUserJavaCheck
-            If AllowedJavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
-                Log("[Java] 使用用户指定的 Java:" & UserJava.PathFolder)
-                AllowedJavaList = New List(Of JavaEntry) From {UserJava}
-                GoTo UserPass
+        'OptiFine 检测
+        If Instance.Version.HasOptiFine AndAlso Instance.Version.Vaild Then '不管非标准版本
+            If Instance.Version.Vanilla.Major < 7 Then
+                '<1.7:至多 Java 8
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
+            ElseIf Instance.Version.Vanilla.Major >= 8 AndAlso Instance.Version.Vanilla.Major < 12 Then
+                '1.8 - 1.11:必须恰好 Java 8
+                AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(8, 0), New Version(9, 0)))
+            ElseIf Instance.Version.Vanilla.Major = 12 Then
+                '1.12:最高 Java 8
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
             End If
+        End If
 
-            '指定的 Java 不可用,弹窗要求选择
-            Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString)
-            Log($"[Java] 目前实际可用的 Java 列表:")
-            For Each Java In AllowedJavaList
-                Log($"[Java]  - {Java}")
-            Next
-            Dim Requirement As String = ""
-            Dim ShowRevision As Boolean = False
-            If (MinVersion Is Nothing OrElse MinVersion.Minor = 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 999) Then
-                ShowRevision = MaxVersion.MinorRevision < 999
-                Requirement = "最高兼容到 Java " & MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
-            ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion Is Nothing OrElse MaxVersion.Minor >= 999) Then
-                ShowRevision = MinVersion.MinorRevision > 0 OrElse MinVersion.MajorRevision > 0
-                Requirement = "至少需要 Java " & MinVersion.Minor & If(ShowRevision, "." & MinVersion.MajorRevision & "." & MinVersion.MinorRevision, "")
-            ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 999) Then
-                ShowRevision = MinVersion.MinorRevision > 0 OrElse MinVersion.MajorRevision > 0 OrElse MaxVersion.MinorRevision < 999
-                Dim Left As String = MinVersion.Minor & If(ShowRevision, "." & MinVersion.MajorRevision & "." & MinVersion.MinorRevision, "")
-                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
-                '直接跳过弹窗
-                Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
-                AllowedJavaList = New List(Of JavaEntry) From {UserJava}
-            Else
-                Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf &
-                            "如果强制使用该 Java,可能导致游戏崩溃。" & vbCrLf &
-                            "你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf &
-                            vbCrLf &
-                            " - 指定的 Java:" & UserJava.ToString,
-                            "Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消")
-                    Case 1 '让 PCL 自动选择
-                    Case 2 '强制使用指定的 Java
-                        Log("[Java] 已强制使用用户指定的不兼容 Java")
-                        AllowedJavaList = New List(Of JavaEntry) From {UserJava}
-                    Case 3 '取消启动
-                        Throw New Exception(CancelException)
-                End Select
+        'Forge 检测(部分测试结果见 #8432)
+        If Instance.Version.HasForge Then
+            If Instance.Version.Vanilla >= New Version(6, 0, 1) AndAlso Instance.Version.Vanilla <= New Version(7, 0, 2) Then
+                '1.6.1 - 1.7.2:必须 Java 7
+                AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(7, 0), New Version(8, 0)))
+            ElseIf Instance.Version.Vanilla.Major <= 12 OrElse Not Instance.Version.Vaild Then '非标准版本
+                '<=1.12:Java 8
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
+            ElseIf Instance.Version.Vanilla.Major <= 14 Then
+                '1.13 - 1.14:Java 8 - 10
+                AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(8, 0), New Version(11, 0)))
+            ElseIf Instance.Version.Vanilla.Major = 15 Then
+                '1.15:Java 8 - 15
+                AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(8, 0), New Version(16, 0)))
+            ElseIf CompareVersionGE(Instance.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", Instance.Version.Forge) Then
+                '1.16.3~5,Forge 34.0.0 ~ 36.2.25:最高 Java 8u320
+                AddConstraint(ValueRange(Of Version).AtMost(New Version(8, 0, 320)))
+            ElseIf CompareVersionGE(Instance.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999999.999999", Instance.Version.Forge) Then
+                '1.16.5,Forge 36.2.26+,<37.0.0:最高 Java 23
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(24, 0)))
+            ElseIf CompareVersionGE(Instance.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", Instance.Version.Forge) Then
+                '1.17.1,Forge 37.0.0 ~ 37.0.79:最高 Java 16
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(17, 0)))
+            ElseIf Instance.Version.Vanilla.Major = 18 AndAlso Instance.Version.HasOptiFine Then '#305
+                '1.18:若安装了 OptiFine,最高 Java 18
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(19, 0)))
+            ElseIf CompareVersionGE(Instance.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", Instance.Version.Forge) Then
+                '1.19.4,Forge 45.0.21 ~ 45.0.65:最高 Java 19
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(20, 0)))
+            ElseIf CompareVersionGE(Instance.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", Instance.Version.Forge) Then
+                '1.19.4~1.20.1,Forge 45.0.66 ~ 47.4.8:最高 Java 21
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(22, 0)))
             End If
+        End If
 
-ExitUserJavaCheck:
-#End Region
-
-            '若依然未找到适合的 Java,直接返回
-            If Not AllowedJavaList.Any() Then Return Nothing
-
-            '优先使用特定目录下的 Java
-            For Each Java In AllowedJavaList
-                '如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例
-                If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For
-                If Java.PathFolder.Contains("PCL\MyDownload\") Then Continue For '#5780
-                If TargetJavaList.Contains(Java) Then
-                    '直接使用指定的 Java
-                    AllowedJavaList = New List(Of JavaEntry) From {Java}
-                    Log("[Java] 优先使用特定路径下的 Java:" & Java.ToString)
-                    GoTo UserPass
-                End If
-            Next
-UserPass:
+        'NeoForge 检测
+        If Instance.Version.HasNeoForge Then
+            If Instance.Version.Vanilla = New Version(20, 0, 1) OrElse
+               (CompareVersionGE("20.2.62-beta", Instance.Version.NeoForge) AndAlso Not Instance.Version.NeoForge.Contains("25w14craftmine")) Then
+                '1.20.1,以及 1.20.2 的 20.2.62-beta 之前:最高 Java 21
+                AddConstraint(ValueRange(Of Version).LessThan(New Version(22, 0)))
+            End If
+        End If
 
-            '对适合的 Java 进行排序
-            AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
-            Log($"[Java] 排序后的 Java 优先顺序:")
-            For Each Java In AllowedJavaList
-                Log($"[Java]  - {Java}")
-            Next
+        'Fabric 检测
+        If Instance.Version.HasFabric AndAlso Instance.Version.Vaild Then '不管非标准版本
+            If Instance.Version.Vanilla.Major >= 15 AndAlso Instance.Version.Vanilla.Major <= 16 Then
+                '1.15 - 1.16:Java 8+
+                AddConstraint(ValueRange(Of Version).AtLeast(New Version(8, 0)))
+            ElseIf Instance.Version.Vanilla.Major >= 18 Then
+                '1.18+:Java 17+
+                AddConstraint(ValueRange(Of Version).AtLeast(New Version(17, 0)))
+            End If
+        End If
 
-            '检查选定的 Java,若测试失败则尝试进行搜索
-            Dim SelectedJava = AllowedJavaList.First
-            Try
-                SelectedJava.Check()
-            Catch ex As ThreadInterruptedException
-                Throw
-            Catch ex As Exception
-                If ex.InnerException IsNot Nothing AndAlso TypeOf (ex.InnerException) Is ThreadInterruptedException Then Throw ex.InnerException
-                Log(ex, "最终选定的 Java 已无法使用,尝试进行搜索")
-                AllowedJavaList = New List(Of JavaEntry)
-                JavaSearchLoader.Start(IsForceRestart:=True)
-                GoTo RetryGet
-            End Try
+        'LiteLoader 检测
+        If Instance.Version.HasLiteLoader AndAlso Instance.Version.Vaild Then '不管非标准版本
+            '最高 Java 8
+            AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
+        End If
 
-            '返回
-            Log("[Java] 最终选定的 Java:" & AllowedJavaList.First.ToString)
-            Return SelectedJava
+        '统一通行证检测
+        If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Nide Then
+            '至少 Java 8u101
+            AddConstraint(ValueRange(Of Version).AtLeast(New Version(8, 0, 141)))
+        End If
 
-        Catch ex As ThreadInterruptedException
-            Log(ex, "查找符合条件的 Java 时出现加载器中断")
-            Return Nothing
-        Catch ex As Exception
-            If ex.Message = "$$" Then Throw ex
-            Log(ex, "查找符合条件的 Java 失败", LogLevel.Feedback)
-            Return Nothing
-        End Try
+        Return (JavaRange, RecommendedComponent)
     End Function
+
     ''' <summary>
-    ''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。
+    ''' 根据版本或 Java 范围要求寻找适合的 Java。
+    ''' 若指定了 <paramref name="TryFixOrHint"/>,则会在找不到时会尝试下载 Java 或提示用户下载,否则只会静默运行。
     ''' </summary>
-    Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean
+    ''' <returns>最适合的 Java。若找不到或失败则返回 null,除非取消否则不会抛出异常。</returns>
+    Public Function SelectOrDownloadJava(Target As OneOf(Of ValueRange(Of Version), McInstance), TryFixOrHint As Boolean, Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing) As Java
         Try
-            '检查强制指定
-            Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
-            If RelatedVersion IsNot Nothing Then
-                Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
-                If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
-            End If
-            If UserSetup <> "" Then
-                Dim UserJava As JavaEntry = Nothing
-                Try
-                    UserJava = JavaEntry.FromJson(GetJson(UserSetup))
-                Catch ex As Exception
-                    Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java")
-                    Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion)
-                    GoTo NoUserJava
-                End Try
-                For Each Java In JavaList
-                    If Java.PathFolder = UserJava.PathFolder Then Return UserJava.Is64Bit
-                Next
-            End If
-NoUserJava:
-            '检查列表
-            For Each Java In JavaList
-                If Java.Is64Bit Then Return True
-            Next
-            Return False
+            If Target.Is(Of McInstance) Then MigrateInstanceJavaSettings(Target.As(Of McInstance), c, p?.SplitTo(0.2)) '迁移
+            Dim Instance As McInstance = If(Target.Is(Of McInstance), Target.As(Of McInstance), Nothing)
+            Select Case If(Instance Is Nothing, 0, Settings.Get(Of Integer)("VersionArgumentJavaV2", Instance))
+
+                Case 2 '============================= 使用版本文件夹中的 Java =============================
+
+                    '查找版本文件夹下的 Java
+                    Logger.Info($"版本设置要求使用版本文件夹中的 Java:{Instance.PathVersion}")
+                    Dim JavaFound = JavaUtils.SearchFoldersAsync(True, {Instance.PathVersion}, c, p?.SplitTo(1)).Run().FirstOrDefault()
+                    If JavaFound IsNot Nothing Then
+                        Logger.Info($"已发现版本文件夹中的 Java:{JavaFound}")
+                        Return JavaFound
+                    End If
+                    '未能找到
+                    If TryFixOrHint Then
+                        SwitchToInstanceSetup(Instance)
+                        MyMsgBox($"该版本的版本设置选择了 {vbLQ}使用版本文件夹中的 Java{vbRQ},但版本文件夹里没能找到 Java。{vbCrLf}请先修改启动选项中的 Java 设置,或在版本文件夹中放一个 Java,然后再试。",
+                            "未找到 Java", IsWarn:=True, ForceWait:=True)
+                    End If
+                    Return Nothing
+
+                Case 3 '=============================== 强制指定特定 Java ===============================
+
+                    Dim ChosenJava = Configs.InstanceForcedJava.Get(Instance.Config)
+                    Logger.Info($"版本设置中强制指定的 Java:{Instance.PathVersion} → {ChosenJava}")
+                    If ChosenJava Is Nothing Then
+                        If TryFixOrHint Then
+                            SwitchToInstanceSetup(Instance)
+                            MyMsgBox($"该版本的版本设置选择了 {vbLQ}使用指定的 Java{vbRQ},但还没有指定任何 Java。{vbCrLf}请先选择你想使用的 Java,然后再试。",
+                                "未选择 Java", IsWarn:=True, ForceWait:=True)
+                        End If
+                        p?.Skip() : Return Nothing '<==== 设置中未指定 Java
+                    End If
+                    If Not Configs.JavaList.Get().Contains(ChosenJava) Then
+                        Configs.InstanceForcedJava.Reset(Instance.Config)
+                        UpdateJavaLists()
+                        If TryFixOrHint Then
+                            SwitchToInstanceSetup(Instance)
+                            Logger.Error("版本设置中指定的 Java 不在 Java 列表中,请重新选择一个 Java!", LogBehavior.Alert)
+                        End If
+                        p?.Skip() : Return Nothing '<==== 设置中指定的 Java 不在列表中
+                    End If
+                    If Not ChosenJava.CheckAsync(c).Run() Then
+                        Configs.InstanceForcedJava.Reset(Instance.Config)
+                        UpdateJavaLists()
+                        If TryFixOrHint Then
+                            SwitchToInstanceSetup(Instance)
+                            Logger.Error("版本设置中指定的 Java 已无法使用,请重新选择一个 Java,然后再试。", LogBehavior.Alert)
+                        Else
+                            Logger.Error("版本设置中指定的 Java 已无法使用,请重新选择一个 Java!", LogBehavior.Toast)
+                        End If
+                        p?.Finish() : Return Nothing '<==== 指定的 Java 存在异常
+                    End If
+                    p?.Finish() : Return ChosenJava '<==== 成功找到并检查通过
+
+                Case Else '======================== 根据版本范围自动选择 JavaList 中的 Java ========================
+
+                    '获取范围
+                    Dim Range As ValueRange(Of Version) =
+                        If(Target.Is(Of McInstance), GetJavaRequirement(Instance).Range, Target.As(Of ValueRange(Of Version)))
+                    Dim RecommendedComponent As String =
+                        If(Target.Is(Of McInstance), GetJavaRequirement(Instance).RecommendedComponent, Nothing)
+                    Logger.Info($"自动选择以下范围的 Java:{Range} {RecommendedComponent}")
+                    If Range.IsEmpty Then Throw New Exception("Java 版本需求存在冲突,导致没有任何可能适配的 Java,请查看 PCL 的日志了解详细信息!")
+
+                    '搜索 Java
+                    Dim SelectJavaFromJavaList =
+                    Function() As Java
+                        JavaListRefreshWorker.WaitIfRunning() '等待进行中的搜索结束
+                        For Each ChosenJava In Configs.JavaList.Get()
+                            If Not ChosenJava.CheckAsync(c).Run() Then '检查
+                                Logger.Warn($"Java 检查失败,将尝试列表中的下一个 Java:{ChosenJava}")
+                                Continue For
+                            End If
+                            If ChosenJava.Version Is Nothing OrElse Not Range.Contains(ChosenJava.Version) Then Continue For '版本范围
+                            Logger.Info($"已选定 Java:{ChosenJava}")
+                            Return ChosenJava
+                        Next
+                        Return Nothing
+                    End Function
+                    p?.Set(0.25)
+                    Dim Result = SelectJavaFromJavaList()
+                    If Result IsNot Nothing Then p?.Skip() : Return Result
+
+                    SyncLock JavaLock '#3797
+                        '既有列表中没有合适的 Java,重新触发搜索
+                        Logger.Warn($"既有列表中没有合适的 Java,重新触发搜索")
+                        JavaListRefreshWorker.Start(c, p?.SplitTo(0.3))
+                        Result = SelectJavaFromJavaList()
+                        If Result IsNot Nothing Then p?.Skip() : Return Result
+                        If Not TryFixOrHint Then Return Nothing
+
+                        '电脑中没有合适的 Java,获取 Mojang 提供的 Java 下载列表
+                        Logger.Warn($"电脑中没有合适的 Java,开始获取 Mojang 提供的 Java 下载列表")
+                        Dim Components = DownloadJavaList()
+                        c.ThrowIfCancellationRequested()
+                        p?.Set(0.4)
+
+                        '确定要下载的目标 Java
+                        Dim JavaToDownload As JavaDownloadInfo = If(
+                        Components.FirstOrDefault(Function(Comp) Comp.Java("version")("name").ToString = RecommendedComponent), '优先选择指定的 Component
+                        Components.FirstOrDefault(Function(Comp) Range.Contains(Comp.JavaVersion)))
+                        If JavaToDownload Is Nothing Then
+                            Logger.Warn($"Mojang 提供的 Java 列表中没有合适的 Java,无法自动下载")
+                            '提示需要手动下载 Java
+                            Dim Description As String
+                            Dim HasPureLower As Boolean = Range.HasLower AndAlso Range.IsLowerInclusive AndAlso
+                            Range.Lower.Minor <= 0 AndAlso Range.Lower.Build <= 0 AndAlso Range.Lower.Revision <= 0
+                            Dim HasPureUpper As Boolean = Range.HasUpper AndAlso Not Range.IsUpperInclusive AndAlso
+                            Range.Upper.Minor <= 0 AndAlso Range.Upper.Build <= 0 AndAlso Range.Upper.Revision <= 0
+                            If Range.HasLower AndAlso Range.HasUpper Then '有上下界
+                                If HasPureLower AndAlso HasPureUpper Then
+                                    If Range.Lower.Major = Range.Upper.Major - 1 Then
+                                        Description = $" Java {Range.Lower.Major}"
+                                    Else
+                                        Description = $" Java {Range.Lower.Major} ~ {Range.Upper.Major - 1}"
+                                    End If
+                                Else
+                                    Description = $" Java {Range}" '摆烂
+                                End If
+                            ElseIf Range.HasLower Then '只有下界
+                                If HasPureLower Then
+                                    Description = $" Java {Range.Lower.Major} 或更高版本的 Java"
+                                ElseIf Range.IsLowerInclusive Then
+                                    Description = $" Java {Range.Lower} 或更高版本的 Java"
+                                Else
+                                    Description = $"版本高于 {Range.Lower} 的 Java"
+                                End If
+                            Else '只有上界
+                                If HasPureUpper Then
+                                    Description = $" Java {Range.Upper.Major - 1} 或更低版本的 Java"
+                                ElseIf Range.IsUpperInclusive Then
+                                    Description = $" Java {Range.Upper} 或更低版本的 Java"
+                                Else
+                                    Description = $"版本低于 {Range.Upper} 的 Java"
+                                End If
+                            End If
+                            MyMsgBox($"PCL 没能找到合适的 Java。{vbCrLf}请在网上搜索并手动安装{Description}, 然后在【设置 → 启动 → 高级选项 → Java 列表】中导入它。", "需要手动安装 Java")
+                            Return Nothing
+                        End If
+
+                        '自动下载 Java
+                        Dim JavaLoader = CreateJavaDownloadLoader(JavaToDownload)
+                        Try
+                            JavaLoader.WaitForExit(IsForceRestart:=True, c:=c, p:=p?.SplitTo(0.95))
+                        Finally
+                            JavaLoader.Cancel() '确保取消时中止 Java 下载
+                        End Try
+                        Result = SelectJavaFromJavaList()
+                        If Result IsNot Nothing Then p?.Finish() : Return Result
+                        Throw New Exception($"下载 Java {JavaToDownload.ComponentName} 后仍然无法找到合适的 Java")
+                    End SyncLock
+            End Select
         Catch ex As Exception
-            Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
-            Setup.Set("LaunchArgumentJavaSelect", "")
-            Return True
+            ex.ThrowIfCanceled()
+            Logger.Error(ex, "选择 Java 时出现异常")
+            p?.Skip() : Return Nothing
         End Try
     End Function
-    ''' <summary>
-    ''' 将 Java 按照适用性排序。
-    ''' </summary>
-    Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
-        '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
-        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 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
-        '2. 尽量使用 64 位
-        If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True
-        If Not Left.Is64Bit AndAlso Right.Is64Bit Then Return False
-        '3. 尽量不使用 JDK
-        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)
-        End If
-        '5. 最次级版本号更接近 51
-        Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
-    End Function
-
-#Region "搜索"
+    Private Sub SwitchToInstanceSetup(Instance As McInstance)
+        RunInUi(
+        Sub()
+            PageInstanceLeft.Instance = Instance
+            FrmMain.PageChange(FormMain.PageType.InstanceSetup, FormMain.PageSubType.InstanceSetup)
+        End Sub)
+    End Sub
+    Private ReadOnly JavaLock As New Object
 
     ''' <summary>
-    ''' 模糊搜索并获取所有可用的 Java,并在结束后更新设置页面显示。输出将直接写入 JavaList。
+    ''' 从老版本 PCL 迁移版本独立的 Java 设置。
     ''' </summary>
-    Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
-    Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
-        If FrmSetupLaunch IsNot Nothing Then
-            RunInUiWait(
-            Sub()
-                FrmSetupLaunch.ComboArgumentJava.Items.Clear()
-                FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
-            End Sub)
-        End If
-        If FrmVersionSetup IsNot Nothing Then
-            RunInUiWait(
-            Sub()
-                FrmVersionSetup.ComboArgumentJava.Items.Clear()
-                FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
-            End Sub)
-        End If
-
+    Private Sub MigrateInstanceJavaSettings(Instance As McInstance, Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
+        If Configs.InstanceMigratedJava.Get(Instance.Config) Then p?.Skip() : Return
+        If FrmInstanceSetup IsNot Nothing Then RunInUiWait(Sub() FrmInstanceSetup.ComboArgumentJava.IsEnabled = False)
         Try
-
-            '可能包含 Java 的文件夹列表,以 “\” 结尾,且仅包含 “\”
-            'Key:文件夹地址
-            'Value: 是否为玩家手动导入
-            Dim JavaPreList As New Dictionary(Of String, Boolean)
-
-#Region "模糊查找可能可用的 Java"
-
-            '查找环境变量中的 Java
-            For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
-                PathInEnv = PathInEnv.Trim(" """.ToCharArray())
-                If PathInEnv = "" Then Continue For
-                If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
-                '粗略检查有效性
-                If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
-            Next
-            '查找磁盘中的 Java
-            For Each Disk As DriveInfo In DriveInfo.GetDrives()
-                If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
-                JavaSearchFolder(Disk.Name, JavaPreList, False)
-            Next
-            '查找 APPDATA 文件夹中的 Java
-            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
-            JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
-            '查找启动器目录中的 Java
-            JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
-            '查找所选 Minecraft 文件夹中的 Java
-            If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then
-                JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
+            Logger.Info($"正在尝试迁移版本独立的 Java 设置({Instance.Name})")
+            '强制使用指定 Java
+            Dim ForcedJavaSetting = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance)
+            If Not ForcedJavaSetting.StartsWithF("{") Then
+                p?.Set(0.4, True) : GoTo NoForcedJava
             End If
-
-            '若不全为符号链接,则清除符号链接的地址
-            Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
-            For Each Pair In JavaPreList
-                Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\")
-                Dim Info As FileSystemInfo = New FileInfo(Folder & "javaw.exe")
-                Do
-                    If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
-                        Log("[Java] 位于 " & Folder & " 的 Java 包含符号链接")
-                        Continue For
-                    End If
-                    Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent)
-                Loop While Info IsNot Nothing
-                Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
-                JavaWithoutReparse.Add(Pair.Key, Pair.Value)
-            Next
-            If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
-
-            '若不全为特殊引用,则清除特殊引用的地址
-            Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
-            For Each Pair In JavaPreList
-                If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.ContainsF("system32") Then
-                    Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径,不应优先使用")
-                Else
-                    JavaWithoutInherit.Add(Pair.Key, Pair.Value)
-                End If
-            Next
-            If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit
-
-#End Region
-
-#Region "添加玩家手动导入的 Java"
-
-            Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll")
-            Try
-                For Each JavaJsonObject In GetJson(ImportedJava)
-                    Dim Entry = JavaEntry.FromJson(JavaJsonObject)
-                    If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
-                Next
-            Catch ex As Exception
-                Log(ex, "Java 列表已损坏", LogLevel.Feedback)
-                Setup.Set("LaunchArgumentJavaAll", "[]")
-            End Try
+            Dim ForcedJava = New Java(ForcedJavaSetting.DeserializeJson(Of JObject)()("Path").ToString)
+            If Not ForcedJava.CheckAsync(c).Run() Then
+                Hint("该版本的设置中强制指定的 Java 存在异常,该设置已重置", HintType.Red)
+                p?.Set(0.4) : GoTo NoForcedJava
+            End If
+            Logger.Info($"将版本独立设置改为老版本中强制指定的 Java:{ForcedJava}")
+            If Not Configs.JavaList.Get().Contains(ForcedJava) Then
+                Configs.JavaList.Edit(Sub(ByRef List) List.Add(ForcedJava)) '加入列表底部
+                Logger.Info($"已将强制指定的 Java 加入 Java 列表底部:{ForcedJava}")
+            End If
+            Configs.InstanceForcedJava.Set(ForcedJava, Instance.Config)
+            Settings.Set("VersionArgumentJavaV2", 3, Instance)
+            UpdateJavaLists()
+            Configs.InstanceMigratedJava.Set(True, Instance.Config) '完成
+            p?.Finish() : Return
+NoForcedJava:
+            Dim JavaFound = JavaUtils.SearchFoldersAsync(True, {Instance.PathVersion}, c, p?.SplitTo(1)).Run()
+            If JavaFound.Any() Then
+                '从版本文件夹中发现了 Java
+                Logger.Info($"在版本文件夹中发现了 Java,将版本独立设置改为优先使用版本文件夹的 Java:{JavaFound}")
+                Settings.Set("VersionArgumentJavaV2", 2, Instance)
+            Else
+                '自动选择
+                Logger.Info("没有需要迁移的内容,自动选择 Java")
+                Settings.Set("VersionArgumentJavaV2", 0, Instance)
+            End If
+            Configs.InstanceMigratedJava.Set(True, Instance.Config) '完成
+        Finally
+            If FrmInstanceSetup IsNot Nothing Then RunInUiWait(
+            Sub()
+                SettingService.RefreshSettings(FrmInstanceSetup.ComboArgumentJava)
+                SettingService.RefreshSettings(FrmInstanceSetup.ComboArgumentJavaSelect)
+                FrmInstanceSetup.ComboArgumentJava.IsEnabled = True
+            End Sub)
+        End Try
+    End Sub
 
 #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
-                NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
-            Next
-            NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
+#Region "下载(均为内部工具方法,无外部调用)"
 
-            '修改设置项
-            Dim AllList As New JArray
-            For Each Java In NewJavaList
-                AllList.Add(Java.ToJson)
-            Next
-            Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
-            JavaList = NewJavaList
-
-        Catch ex As Exception
-            Log(ex, "搜索 Java 时出错", LogLevel.Feedback)
-            JavaList = New List(Of JavaEntry)
-        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())
-    End Sub
+    Private Class JavaDownloadInfo
+        Public Property ComponentName As String
+        Public Property Java As JObject
+        Public Property JavaVersion As Version
+    End Class
 
     ''' <summary>
-    ''' 多线程检查列表中的所有 Java 项。
+    ''' 下载 Mojang 提供的 Java 列表。
+    ''' <para/> 若本次打开程序已经下载过,则会直接返回缓存的结果。
     ''' </summary>
-    Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry)
-        Log("[Java] 开始确认列表 Java 状态,共 " & JavaEntries.Count & " 项")
-        JavaCheckList = New List(Of JavaEntry)
-        Dim ListLock As New Object
-
-        '启动检查线程
-        Dim CheckThreads As New List(Of Thread)
-        For Each Entry In JavaEntries
-            Dim CheckThread As New Thread(
-            Sub()
+    Private Function DownloadJavaList() As List(Of JavaDownloadInfo)
+        'TODO: 写一个更简单的 Lazy,允许重置缓存
+        Static Components As New Lazy(Of List(Of JavaDownloadInfo))(
+        Function()
+            '下载 Mojang 提供的 Java 列表
+            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)
+            '解析 Java 列表
+            Dim Results = New List(Of JavaDownloadInfo)
+            For Each Prop As JProperty In IndexFileStr.DeserializeJson(Of JObject)()("windows-x64")
+                If Prop.Name = "minecraft-java-exe" Then Continue For '不是完整 Java
                 Try
-                    Entry.Check()
-                    If ModeDebug Then Log("[Java]  - " & Entry.ToString)
-                    SyncLock ListLock
-                        JavaCheckList.Add(Entry)
-                    End SyncLock
-                Catch ex As ThreadInterruptedException
-                Catch ex As Exception
-                    If Entry.IsUserImport Then
-                        Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常,将被自动移除", LogLevel.Hint)
+                    Dim Entry = Prop.Value.FirstOrDefault
+                    If Entry Is Nothing Then Continue For
+                    Dim JavaName = Entry("version")("name").ToString '可能的名称格式:"12"、"8u51-cacert462b08"、"17.0.8.1"、"17.0.1.12.1"、"21.0.7"
+                    If JavaName.Contains(".") Then
+                        Dim Parts As String() = JavaName.Split(".")
+                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(Parts(0)), Val(Parts(1)), If(Parts.Length >= 3, Val(Parts(2)), 0), If(Parts.Length >= 4, Val(Parts(3)), 0))})
+                    ElseIf JavaName.StartsWithF("8u51-") Then
+                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(8, 0, 51, 0)})
                     Else
-                        Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
+                        Results.Add(New JavaDownloadInfo With {.ComponentName = Prop.Name, .Java = Entry, .JavaVersion = New Version(Val(JavaName.BeforeFirstOfAny({"u", "."})), 0, 0, 0)})
                     End If
+                Catch ex As Exception
+                    Logger.Warn(ex, $"解析 Mojang 提供的 Java 列表项失败,已跳过({Prop.Name})")
                 End Try
-            End Sub)
-            CheckThreads.Add(CheckThread)
-            CheckThread.Start()
-        Next
-
-        '等待构造线程完成
-Wait:
-        Thread.Sleep(10)
-        For Each CheckThread In CheckThreads
-            If CheckThread.IsAlive Then GoTo Wait
-        Next
-    End Function
-    ''' <summary>
-    ''' 模糊搜索指定文件夹下的 Java,并只进行粗略的检查。这不会搜索全部路径。
-    ''' </summary>
-    ''' <param name="OriginalPath">开始搜索的起始路径,不限制结尾。</param>
-    ''' <param name="IsFullSearch">搜索当前文件夹下的全部文件夹(此参数不会传递到子文件夹)。</param>
-    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)
-        Catch ex As UnauthorizedAccessException
-            Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath)
-        Catch ex As Exception
-            Log(ex, "遍历查找 Java 时出错(" & OriginalPath & ")")
-        End Try
-    End Sub
-    ''' <summary>
-    ''' 模糊搜索指定文件夹下的 Java,并只进行粗略的检查。这不会搜索全部路径。
-    ''' </summary>
-    ''' <param name="OriginalPath">开始搜索的起始路径,不限制结尾。</param>
-    ''' <param name="IsFullSearch">搜索当前文件夹下的全部文件夹(此参数不会传递到子文件夹)。</param>
-    Private Sub JavaSearchFolder(OriginalPath As DirectoryInfo, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
-        Try
-            '确认目录存在
-            If Not OriginalPath.Exists Then Exit Sub
-            Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
-            If Not Path.EndsWithF("\") Then Path += "\"
-            '若该目录有 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.", "启动"}
-            For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
-                If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
-                Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
-                If IsFullSearch OrElse
-                   OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
-                    JavaSearchFolder(FolderInfo, Results, Source)
-                End If
             Next
-        Catch ex As UnauthorizedAccessException
-            Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath.FullName)
-        Catch ex As Exception
-            Log(ex, "遍历查找 Java 时出错(" & OriginalPath.FullName & ")")
-        End Try
-    End Sub
-
-#End Region
-
-#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
+            Return Results
+        End Function)
+        Return Components.Value
     End Function
 
     ''' <summary>
-    ''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
+    ''' 构建下载指定 Java 的加载器。
     ''' </summary>
-    Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
-        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},
-            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
-                Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug)
-                DeleteDirectory(LastJavaBaseDir)
-            ElseIf NewState = LoadState.Finished Then
-                LastJavaBaseDir = Nothing
-            End If
-        End Sub
-        JavaDownloadLoader.HasOnStateChangedThread = True
-        Return Loader
-    End Function
-    Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
-    Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
-        Log("[Java] 开始获取 Java 下载信息")
-        Dim IndexFileStr As String = NetGetCodeByLoader(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}")
-        '获取文件列表
-        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 Results As New List(Of NetFile)
-        For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
+    Private Function CreateJavaDownloadLoader(Target As JavaDownloadInfo) As LoaderCombo(Of Integer)
+
+        '分析需要下载的 Java 文件列表
+        Dim Address As String = Target.Java("manifest")("url")
+        Logger.Info($"准备下载 Java {Target.Java("version")("name")}({Target.ComponentName}):{Address}")
+        Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
+        Dim BaseDir As String = $"{Paths.AppData}.minecraft\runtime\{Target.ComponentName}\"
+        Dim FilesToDownload As New List(Of NetFile)
+        For Each File As JProperty In CType(ListFileStr.DeserializeJson(), JObject)("files")
             If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
             Dim Info As JObject = CType(File.Value, JObject)("downloads")("raw")
-            Dim Checker As New FileChecker(ActualSize:=Info("size"), Hash:=Info("sha1"))
+            Dim Checker As New FileChecker With {.ActualSize = Info("size"), .Hash = Info("sha1")}
             If Checker.Hash = "12976a6c2b227cbac58969c1455444596c894656" OrElse Checker.Hash = "c80e4bab46e34d02826eab226a4441d0970f2aba" OrElse Checker.Hash = "84d2102ad171863db04e7ee22a259d1f6c5de4a5" Then
-                '跳过 3 个无意义大量重复文件(#3827)
-                Continue For
+                Continue For '跳过 3 个无意义大量重复文件(#3827)
             End If
-            If Checker.Check(LastJavaBaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
             Dim Url As String = Info("url")
-            Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker))
+            FilesToDownload.Add(New NetFile(
+                DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}),
+                BaseDir & File.Name, Checker))
         Next
-        Loader.Output = Results
-        Log($"[Java] 需要下载 {Results.Count} 个文件,目标文件夹:{LastJavaBaseDir}")
-    End Sub
+        Logger.Info($"该 Java 需要下载 {FilesToDownload.Count} 个文件,目标文件夹:{BaseDir}")
+
+        '构建加载器
+        Dim Loader = New LoaderCombo(Of Integer)("下载 Java", {
+            New LoaderDownload("下载 Java 文件", FilesToDownload) With {.ProgressWeight = 10},
+            New LoaderWorker("刷新 Java 列表", JavaListRefreshWorker)
+        }) With {.OnStateChanged =
+        Sub(RawLoader As LoaderCombo(Of Integer))
+            If RawLoader.State = LoadState.Failed OrElse RawLoader.State = LoadState.Canceled Then
+                Logger.Warn($"由于 Java 下载未完成,清理未下载完成的 Java 文件夹:{BaseDir}")
+                DirectoryUtils.Delete(BaseDir)
+            End If
+        End Sub}
+        Return Loader
+
+    End Function
 
 #End Region
 

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 311 - 280
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb


Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 493 - 397
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb


+ 0 - 1276
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb

@@ -1,1276 +0,0 @@
-Imports System.IO.Compression
-
-Public Module ModMod
-    Private Const LocalModCacheVersion As Integer = 7
-
-    Public Class McMod
-
-#Region "基础"
-
-        ''' <summary>
-        ''' Mod 文件的地址。
-        ''' </summary>
-        Public ReadOnly Path As String
-        Public Sub New(Path As String)
-            Me.Path = If(Path, "")
-        End Sub
-        ''' <summary>
-        ''' Mod 的完整路径,去除最后的 .disabled 和 .old。
-        ''' </summary>
-        Public ReadOnly Property RawPath As String
-            Get
-                Return GetPathFromFullPath(Path) & RawFileName
-            End Get
-        End Property
-
-        ''' <summary>
-        ''' Mod 的完整文件名。
-        ''' </summary>
-        Public ReadOnly Property FileName As String
-            Get
-                Return GetFileNameFromPath(Path)
-            End Get
-        End Property
-
-        ''' <summary>
-        ''' Mod 的完整文件名,去除最后的 .disabled 和 .old。
-        ''' </summary>
-        Public ReadOnly Property RawFileName As String
-            Get
-                Return FileName.Replace(".disabled", "").Replace(".old", "")
-            End Get
-        End Property
-
-        ''' <summary>
-        ''' Mod 的状态。
-        ''' </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
-                    Return McModState.Disabled
-                Else
-                    Return McModState.Fine
-                End If
-            End Get
-        End Property
-        Public Enum McModState As Integer
-            Fine = 0
-            Disabled = 1
-            Unavailable = 2
-        End Enum
-
-#End Region
-
-#Region "信息项"
-
-        ''' <summary>
-        ''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。
-        ''' </summary>
-        Public Property Name As String
-            Get
-                If _Name Is Nothing Then Load()
-                If _Name Is Nothing Then _Name = _ModId
-                If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(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
-                    _Name = value
-                End If
-            End Set
-        End Property
-        Private _Name As String = Nothing
-
-        ''' <summary>
-        ''' Mod 的描述信息。
-        ''' </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 += "."
-                End If
-            End Set
-        End Property
-        Private _Description As String = Nothing
-
-        ''' <summary>
-        ''' Mod 的版本,不保证符合版本格式规范。
-        ''' </summary>
-        Public Property Version As String
-            Get
-                If _Version Is Nothing Then Load()
-                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" '需要修改的标识
-                _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 Exit Sub
-            ModID = ModID.ToLower
-            If ModID = "name" OrElse Val(ModID).ToString = ModID Then Exit Sub '跳过 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 "加载步骤标记"
-
-        '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。
-        ''' </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 Exit Sub
-            '初始化
-            Init()
-            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))
-                '信息获取
-                LookupMetadata(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)
-
-#Region "尝试使用 mcmod.info"
-            Try
-                '获取信息文件
-                Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
-                Dim InfoString As String = Nothing
-                If InfoEntry IsNot Nothing Then
-                    InfoString = ReadFile(InfoEntry.Open())
-                    If InfoString.Length < 15 Then InfoString = Nothing
-                End If
-                If InfoString Is Nothing Then Exit Try
-                '获取可用 Json 项
-                Dim InfoObject As JObject
-                Dim JsonObject = GetJson(InfoString)
-                If JsonObject.Type = JTokenType.Array Then
-                    InfoObject = JsonObject(0)
-                Else
-                    InfoObject = JsonObject("modList")(0)
-                End If
-                '从文件中获取 Mod 信息项
-                Name = 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
-#End Region
-#Region "尝试使用 fabric.mod.json"
-            Try
-                '获取 fabric.mod.json 文件
-                Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
-                Dim FabricText As String = Nothing
-                If FabricEntry IsNot Nothing Then
-                    FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
-                    If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
-                End If
-                If FabricText Is Nothing Then Exit Try
-                Dim FabricObject As JObject = GetJson(FabricText)
-GotFabric:
-                '从文件中获取 Mod 信息项
-                If FabricObject.ContainsKey("name") Then Name = 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
-                Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
-            End Try
-#End Region
-#Region "尝试使用 mods.toml"
-            Try
-                '获取 mods.toml 文件
-                Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
-                Dim TomlText As String = Nothing
-                If TomlEntry IsNot Nothing Then
-                    TomlText = ReadFile(TomlEntry.Open())
-                    If TomlText.Length < 15 Then TomlText = Nothing
-                End If
-                If TomlText Is Nothing Then Exit Try
-                '文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
-                Dim Lines As New List(Of String)
-                For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
-                    If Line.StartsWithF("#") Then '去除注释
-                        Continue For
-                    ElseIf Line.Contains("#") Then
-                        Line = Line.Substring(0, Line.IndexOfF("#"))
-                    End If
-                    Line = Line.Trim(New Char() {" "c, "	"c, " "c}) '去除头尾的空格
-                    If Line.Any Then Lines.Add(Line) '去除空行
-                Next
-                '读取文件数据
-                Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
-                For i = 0 To Lines.Count - 1
-                    Dim Line As String = Lines(i)
-                    If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
-                        '段落标记
-                        Dim Header = Line.Trim("[]".ToCharArray)
-                        TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
-                    ElseIf Line.Contains("=") Then
-                        '字段标记
-                        Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, "	"c, " "c})
-                        Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, "	"c, " "c})
-                        Dim Value As Object
-                        If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
-                            '单行字符串
-                            Value = RawValue.Trim("""")
-                        ElseIf RawValue.StartsWithF("'''") Then
-                            '多行字符串
-                            Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
-                            If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
-                                ValueLines(0) = ValueLines(0).TrimEnd("'")
-                            Else
-                                Do Until i >= Lines.Count - 1
-                                    i += 1
-                                    Dim ValueLine As String = Lines(i)
-                                    If ValueLine.EndsWithF("'''") Then
-                                        ValueLines.Add(ValueLine.TrimEnd("'"))
-                                        Exit Do
-                                    Else
-                                        ValueLines.Add(ValueLine)
-                                    End If
-                                Loop
-                            End If
-                            Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
-                        ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then
-                            '布尔型
-                            Value = (RawValue.ToLower = "true")
-                        ElseIf Val(RawValue).ToString = RawValue Then
-                            '数字型
-                            Value = Val(RawValue)
-                        Else
-                            '不知道是个啥玩意儿,直接存储
-                            Value = RawValue
-                        End If
-                        TomlData.Last.Value(Key) = Value
-                    Else
-                        '不知道是个啥玩意儿
-                        Exit Try
-                    End If
-                Next
-                '从文件数据中获取信息
-                Dim ModEntry As Dictionary(Of String, Object) = Nothing
-                For Each TomlSubData In TomlData
-                    If TomlSubData.Key = "mods" Then
-                        ModEntry = TomlSubData.Value
-                        Exit For
-                    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("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
-                Log(ex, "读取 mods.toml 时出现未知错误(" & Path & ")", LogLevel.Developer)
-            End Try
-#End Region
-#Region "尝试使用 fml_cache_annotation.json"
-            Try
-                '获取 fml_cache_annotation.json 文件
-                Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
-                Dim FmlText As String = Nothing
-                If FmlEntry IsNot Nothing Then
-                    FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8)
-                    If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
-                End If
-                If FmlText Is Nothing Then Exit Try
-                Dim FmlJson As JObject = GetJson(FmlText)
-                '获取可用 Json 项
-                Dim FmlObject As JObject = Nothing
-                For Each ModFilePair In FmlJson
-                    Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
-                    If ModFileAnnos IsNot Nothing Then
-                        '先获取 Mod
-                        For Each ModFileAnno In ModFileAnnos
-                            Dim Name As String = If(ModFileAnno("name"), "")
-                            If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
-                                FmlObject = ModFileAnno("values")
-                                GoTo Got
-                            End If
-                        Next
-                    End If
-                Next
-                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("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
-            Catch ex As Exception
-                Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
-            End Try
-#End Region
-Finished:
-#Region "将 Version 代号转换为 META-INF 中的版本"
-            If _Version = "version" Then
-                Try
-                    Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
-                    If MetaEntry IsNot Nothing Then
-                        Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
-                        If MetaString.Contains("Implementation-Version:") Then
-                            MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
-                            MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
-                            Version = MetaString
-                        End If
-                    End If
-                Catch ex As Exception
-                    Log("获取 META-INF 中的版本信息失败(" & Path & ")", LogLevel.Developer)
-                    Version = Nothing
-                End Try
-            End If
-            If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
-#End Region
-
-        End Sub
-
-#End Region
-
-#Region "网络信息"
-
-        ''' <summary>
-        ''' 当任何网络信息更新时触发。
-        ''' </summary>
-        Public Event OnCompUpdate(sender As McMod)
-
-        ''' <summary>
-        ''' 该 Mod 关联的网络项目。
-        ''' </summary>
-        Public Property Comp As CompProject
-            Get
-                Return _Comp
-            End Get
-            Set(value As CompProject)
-                _Comp = value
-                RaiseEvent OnCompUpdate(Me)
-            End Set
-        End Property
-        Private _Comp As CompProject
-
-        ''' <summary>
-        ''' 本地文件对应的联网文件信息。
-        ''' </summary>
-        Public CompFile As CompFile
-
-        ''' <summary>
-        ''' 该 Mod 对应的联网最新版本。
-        ''' </summary>
-        Public Property UpdateFile As CompFile
-            Get
-                Return _UpdateFile
-            End Get
-            Set(value As CompFile)
-                _UpdateFile = value
-                RaiseEvent OnCompUpdate(Me)
-            End Set
-        End Property
-        Private _UpdateFile As CompFile
-
-        ''' <summary>
-        ''' 该 Mod 的更新日志网址。
-        ''' </summary>
-        Public ChangelogUrls As New List(Of String)
-        ''' <summary>
-        ''' 所有网络信息是否已成功加载。
-        ''' </summary>
-        Public CompLoaded As Boolean = False
-
-        ''' <summary>
-        ''' 将网络信息保存为 Json。
-        ''' </summary>
-        Public Function ToJson() As JObject
-            Dim Json As New JObject
-            If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
-            Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
-            Json.Add("CompLoaded", CompLoaded)
-            If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
-            If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
-            Return Json
-        End Function
-        ''' <summary>
-        ''' 从 Json 中读取网络信息。
-        ''' </summary>
-        Public Sub FromJson(Json As JObject)
-            CompLoaded = Json("CompLoaded")
-            If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
-            If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
-            If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
-            If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
-        End Sub
-
-        ''' <summary>
-        ''' 该文件是否可以更新。
-        ''' </summary>
-        Public ReadOnly Property CanUpdate As Boolean
-            Get
-                Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
-            End Get
-        End Property
-
-        ''' <summary>
-        ''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
-        ''' </summary>
-        Public ReadOnly Property CurseForgeHash As UInteger
-            Get
-                If _CurseForgeHash Is Nothing Then
-                    '读取缓存
-                    Dim Info As New FileInfo(Path)
-                    Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
-                    Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
-                    If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
-                        _CurseForgeHash = Cached
-                        Return _CurseForgeHash
-                    End If
-                    '读取文件
-                    Dim data As New List(Of Byte)
-                    For Each b As Byte In ReadFileBytes(Path)
-                        If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
-                        data.Add(b)
-                    Next
-                    '计算 MurmurHash2
-                    Dim length As Integer = data.Count
-                    Dim h As UInteger = 1 Xor length '1 是种子
-                    Dim i As Integer
-                    For i = 0 To length - 4 Step 4
-                        Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
-                        k = (k * &H5BD1E995L) And &HFFFFFFFFL
-                        k = k Xor (k >> 24)
-                        k = (k * &H5BD1E995L) And &HFFFFFFFFL
-                        h = (h * &H5BD1E995L) And &HFFFFFFFFL
-                        h = h Xor k
-                    Next
-                    Select Case length - i
-                        Case 3
-                            h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
-                            h = h Xor (CUInt(data(i + 2)) << 16)
-                            h = (h * &H5BD1E995L) And &HFFFFFFFFL
-                        Case 2
-                            h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
-                            h = (h * &H5BD1E995L) And &HFFFFFFFFL
-                        Case 1
-                            h = h Xor data(i)
-                            h = (h * &H5BD1E995L) And &HFFFFFFFFL
-                    End Select
-                    h = h Xor (h >> 13)
-                    h = (h * &H5BD1E995L) And &HFFFFFFFFL
-                    h = h Xor (h >> 15)
-                    _CurseForgeHash = h
-                    '写入缓存
-                    WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
-                End If
-                Return _CurseForgeHash
-            End Get
-        End Property
-        Private _CurseForgeHash As UInteger?
-
-        ''' <summary>
-        ''' 获取用于 Modrinth 信息获取的 Hash 值(SHA1)。
-        ''' </summary>
-        Public ReadOnly Property ModrinthHash As String
-            Get
-                If _ModrinthHash Is Nothing Then
-                    '读取缓存
-                    Dim Info As New FileInfo(Path)
-                    Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
-                    Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
-                    If Cached <> "" Then
-                        _ModrinthHash = Cached
-                        Return _ModrinthHash
-                    End If
-                    '计算 SHA1
-                    _ModrinthHash = GetFileSHA1(Path)
-                    '写入缓存
-                    WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
-                End If
-                Return _ModrinthHash
-            End Get
-        End Property
-        Private _ModrinthHash As String
-
-#End Region
-
-#Region "API"
-
-        Public Overrides Function ToString() As String
-            Return $"{State} - {Path}"
-        End Function
-        Public Overrides Function Equals(obj As Object) As Boolean
-            Dim target = TryCast(obj, McMod)
-            Return target IsNot Nothing AndAlso Path = target.Path
-        End Function
-
-#End Region
-
-        ''' <summary>
-        ''' 是否可能为前置 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"))
-        End Function
-
-        ''' <summary>
-        ''' 根据完整文件路径的文件扩展名判断是否为 Mod 文件。
-        ''' </summary>
-        Public Shared Function IsModFile(Path As String)
-            If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
-            Path = Path.ToLower
-            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
-            Return False
-        End Function
-
-    End Class
-
-    '加载 Mod 列表
-    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)
-
-            '等待 Mod 更新完成
-            If PageVersionMod.UpdatingVersions.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 Exit Sub
-                        Thread.Sleep(100)
-                    Loop
-                Finally
-                    RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
-                End Try
-                FrmVersionMod.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
-                For Each File As FileInfo In EnumerateFiles(Loader.Input)
-                    If File.DirectoryName.ToLower & "\" <> 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
-                            Continue For
-                        End If
-                    End If
-                    If McMod.IsModFile(File.FullName) Then ModFileList.Add(File)
-                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
-            Try
-                Dim CacheContent As String = ReadFile(CachePath)
-                If Not String.IsNullOrWhiteSpace(CacheContent) Then
-                    Cache = GetJson(CacheContent)
-                    If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
-                        Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
-                        Cache = New JObject
-                    End If
-                End If
-            Catch ex As Exception
-                Log(ex, "读取本地 Mod 信息缓存失败,已重置")
-                Cache = New JObject
-            End Try
-            Cache("version") = LocalModCacheVersion
-
-            '加载 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 Exit Sub
-                '加载 McMod 对象
-                Dim ModEntry As New McMod(ModFile.FullName)
-                ModEntry.Load()
-                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)
-                    If DisabledMod Is ModEntry Then
-                        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} 个需要更新信息")
-
-            '排序
-            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)
-
-            '回设
-            If Loader.IsAborted Then Exit Sub
-            Loader.Output = ModList
-
-            '开始联网加载
-            If ModUpdateList.Any() Then
-                'TODO: 添加信息获取中提示
-                McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
-            End If
-
-        Catch ex As Exception
-            Log(ex, "Mod 列表加载失败", LogLevel.Debug)
-            Throw
-        End Try
-    End Sub
-    '联网加载 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 Cache As JObject = Loader.Input.Value
-        '获取作为检查目标的加载器和版本
-        '此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
-        Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
-        Dim ModLoaders = GetTargetModLoaders()
-        Dim McVersion = TargetMcVersion.McName
-        '开始网络获取
-        Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
-        Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
-        Dim MainThread As Thread = Thread.CurrentThread
-        '从 Modrinth 获取信息
-        RunInNewThread(
-        Sub()
-            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)
-                Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
-                '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
-                If ModrinthVersion.Count = 0 Then Exit Sub
-                Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
-                For Each Entry In Mods
-                    If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
-                    If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
-                    Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
-                    If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
-                    If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
-                    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
-                Next
-                If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
-                Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
-                '步骤 3:获取工程信息
-                If Not ModrinthMapping.Any() Then Exit Sub
-                Dim ModrinthProject = CType(GetJson(DlModRequest(
-                    $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
-                    "GET", "", "application/json")), JArray)
-                For Each ProjectJson In ModrinthProject
-                    Dim Project As New CompProject(ProjectJson)
-                    For Each Entry In ModrinthMapping(Project.Id)
-                        Entry.Comp = Project
-                    Next
-                Next
-                Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
-                '步骤 4:获取更新信息
-                Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
-                    $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", 
-                    ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
-                For Each Entry In Mods
-                    If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
-                    Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
-                    If Not UpdateFile.Available Then Continue For
-                    If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
-                    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}")
-                        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.UpdateFile = UpdateFile
-                    End If
-                Next
-                Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
-            Catch ex As Exception
-                Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
-                IsFailed = True
-            Finally
-                EndedThreadCount += 1
-            End Try
-        End Sub, "Mod List Detail Loader Modrinth")
-        '从 CurseForge 获取信息
-        RunInNewThread(
-        Sub()
-            Try
-                '步骤 1:获取 Hash 与对应的工程 ID
-                Dim CurseForgeHashes As New List(Of UInteger)
-                For Each Entry In Mods
-                    CurseForgeHashes.Add(Entry.CurseForgeHash)
-                    If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
-                Next
-                Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
-                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
-                Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
-                '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
-                If Not CurseForgeRaw.Any() Then Exit Sub
-                Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
-                For Each Project In CurseForgeRaw
-                    Dim ProjectId = Project("id").ToString
-                    Dim Hash As UInteger = Project("file")("fileFingerprint")
-                    For Each Entry In Mods
-                        If Entry.CurseForgeHash <> Hash Then Continue For
-                        If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
-                        If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
-                        CurseForgeMapping(ProjectId).Add(Entry)
-                        '记录对应的 CompFile
-                        Dim File As New CompFile(Project("file"), CompType.Mod)
-                        If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
-                    Next
-                Next
-                If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
-                Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
-                '步骤 3:获取工程信息
-                If Not CurseForgeMapping.Any() Then Exit Sub
-                Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
-                    $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
-                Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
-                Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
-                For Each ProjectJson In CurseForgeProject
-                    If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
-                    '设置 Entry 中的工程信息
-                    Dim Project As New CompProject(ProjectJson)
-                    For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
-                        If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
-                            Entry.Comp = Entry.Comp '再次触发修改事件
-                            Continue For
-                        End If
-                        Entry.Comp = Project
-                    Next
-                    '查找或许版本更新的文件列表
-                    If ModLoaders.Count = 1 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 版本匹配
-                            '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
-                            If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
-                            If NewestVersion <> IndexVersion Then
-                                NewestVersion = IndexVersion
-                                NewestFileIds.Clear()
-                            End If
-                            NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
-                        Next
-                        For Each FileId In NewestFileIds
-                            If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of McMod)
-                            UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
-                            FileIdToProjectSlug(FileId) = Project.Slug
-                        Next
-                    End If
-                Next
-                Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
-                '步骤 4:获取更新文件信息
-                If Not UpdateFileIds.Any() Then Exit Sub
-                Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
-                                    $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
-                Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
-                For Each FileJson In CurseForgeFiles
-                    Dim File As New CompFile(FileJson, CompType.Mod)
-                    If Not File.Available Then Continue For
-                    For Each Entry As McMod In UpdateFileIds(File.Id)
-                        If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
-                        UpdateFiles(Entry) = File
-                    Next
-                Next
-                For Each Pair In UpdateFiles
-                    Dim Entry As McMod = Pair.Key
-                    Dim UpdateFile As CompFile = Pair.Value
-                    If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
-                    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://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
-                        Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
-                    ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
-                        Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
-                        Entry.UpdateFile = UpdateFile
-                    End If
-                Next
-                Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
-            Catch ex As Exception
-                Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
-                IsFailed = True
-            Finally
-                EndedThreadCount += 1
-            End Try
-        End Sub, "Mod List Detail Loader CurseForge")
-        '等待线程结束
-        Do Until EndedThreadCount = 2
-            If Loader.IsAborted Then Exit Sub
-            Thread.Sleep(10)
-        Loop
-        '保存缓存
-        Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
-        Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
-        If Not Mods.Any() Then Exit Sub
-        For Each Entry In Mods
-            Entry.CompLoaded = Not IsFailed
-            Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
-        Next
-        WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
-        '刷新边栏
-        If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
-            RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
-        Else
-            RunInUi(Sub() FrmVersionMod?.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 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

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 297 - 270
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb


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

@@ -1,4 +1,4 @@
-Public Module ModWatcher
+Public Module ModWatcher
 
     '对全体的监视
     Public McWatcherList As New List(Of Watcher)
@@ -15,7 +15,7 @@
                 TriggerLauncherShutdown = False
             End If
         Next
-        If IsWatcherRunning = IsRunning Then Exit Sub
+        If IsWatcherRunning = IsRunning Then Return
         IsWatcherRunning = IsRunning
         If IsWatcherRunning Then
             MinecraftStart()
@@ -33,13 +33,13 @@
         HasRunningMinecraft = False
         FrmMain.BtnExtraShutdown.ShowRefresh()
         '音乐播放
-        If Setup.Get("UiMusicStop") Then
-            RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放"))
-        ElseIf Setup.Get("UiMusicStart") Then
-            RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放"))
+        If Settings.Get(Of Boolean)("UiMusicStop") Then
+            RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置,在结束后开始音乐播放"))
+        ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
+            RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置,在结束后暂停音乐播放"))
         End If
         '启动器可见性
-        Select Case Setup.Get("LaunchArgumentVisible")
+        Select Case Settings.Get(Of Integer)("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 日志监控")
@@ -81,7 +81,7 @@
             WatcherStateChanged()
 
             '初始化进程与日志读取
-            Me.GameProcess = Loader.Input
+            GameProcess = Loader.Input
             GameProcess.BeginOutputReadLine()
             GameProcess.BeginErrorReadLine()
             AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived
@@ -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.Canceled
                         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)
@@ -105,7 +105,7 @@
                     Loop
                     WatcherLog("Minecraft 日志监控已退出")
                 Catch ex As Exception
-                    Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
+                    Logger.Error(ex, "Minecraft 日志监控主循环出错")
                     State = MinecraftState.Ended
                 End Try
             End Sub, "Minecraft Watcher PID " & PID)
@@ -118,7 +118,7 @@
                 Return _State
             End Get
             Set(value As MinecraftState)
-                If _State = value Then Exit Property
+                If _State = value Then Return
                 _State = value
                 WatcherStateChanged()
             End Set
@@ -144,7 +144,7 @@
                 '输出文本
                 Dim Copyed As New List(Of String)
                 SyncLock WaitingLogLock
-                    If Not WaitingLog.Any() Then Exit Sub
+                    If Not WaitingLog.Any() Then Return
                     Copyed = WaitingLog
                     WaitingLog = New List(Of String)(1000)
                 End SyncLock
@@ -162,11 +162,11 @@
                     'Else
                     If State = MinecraftState.Loading Then
                         '窗口未出现
-                        WatcherLog("Minecraft 尚未加载完成,可能已崩溃")
+                        WatcherLog("Minecraft 尚未加载完成,可能已崩溃", LogLevel.Error)
                         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 返回值异常,可能已崩溃")
+                        WatcherLog("Minecraft 返回值异常,可能已崩溃", LogLevel.Error)
                         Crashed()
                     ElseIf State <> MinecraftState.Crashed Then
                         '正常关闭
@@ -174,17 +174,19 @@
                     End If
                 End If
             Catch ex As Exception
-                Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback)
+                Logger.Error(ex, "输出 Minecraft 日志失败")
             End Try
         End Sub
-        Public LatestLog As New Queue(Of String)
+        Public LatestLog As New ConcurrentQueue(Of String)
         Private Sub GameLog(Text As String)
             '预处理
-            If Text Is Nothing Then Exit Sub
-            Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
+            If Text Is Nothing Then Return
+            Text = Text.ReplaceLineEndings(vbCrLf)
+            'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text)
             '加入预存储
             LatestLog.Enqueue(Text)
-            If LatestLog.Count >= 501 Then LatestLog.Dequeue()
+            If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
+            Logger.Trace(Text)
             '进度处理
             If LogProgress < 1 Then
                 WatcherLog("日志 1/5:已出现日志输出")
@@ -193,7 +195,7 @@
             If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
                 WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
                 LogProgress = 2
-            ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
+            ElseIf LogProgress < 3 AndAlso Text.ContainsIgnoreCase("lwjgl version") Then
                 WatcherLog("日志 3/5:LWJGL 版本已确认")
                 LogProgress = 3
             ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -213,15 +215,15 @@
                 ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then
                     ' Text.Contains("Minecraft ran into a problem! Report saved to:") Then
                     'Minecraft 崩溃,忽略 VanillaFix
-                    WatcherLog("识别为崩溃的 Log:" & Text)
+                    WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error)
                     Crashed()
                 ElseIf Text.Contains("Could not save crash report to") Then
                     'Minecraft 崩溃,无法保存崩溃日志
-                    WatcherLog("识别为崩溃的 Log:" & Text)
+                    WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error)
                     Crashed()
                 ElseIf Text.Contains("/ERROR]: Unable to launch") OrElse Text.Contains("An exception was thrown, the game will display an error screen and halt.") Then
                     'Forge 崩溃
-                    WatcherLog("识别为崩溃的 Log:" & Text)
+                    WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error)
                     Crashed()
                     'ElseIf Text.Contains("Shutdown failure!") Then
                     '    'Minecraft 强行崩溃,由于点 X 强行关闭也会触发这句话,所以不可用
@@ -229,8 +231,8 @@
                 End If
             End If
         End Sub
-        Private Sub WatcherLog(Text As String)
-            McLaunchLog("[" & PID & "] " & Text)
+        Private Sub WatcherLog(Text As String, Optional Level As LogLevel = LogLevel.Info)
+            McLaunchLog("[" & PID & "] " & Text, Level)
         End Sub
 
         '进度更新
@@ -256,27 +258,27 @@
         Private WindowHandle As IntPtr
         Private Sub TimerWindow()
             Try
-                If GameProcess.HasExited Then Exit Sub
-                If IsWindowFinished Then Exit Sub
+                If GameProcess.HasExited Then Return
+                If IsWindowFinished Then Return
                 '获取全部窗口,检查是否有新增的
                 Dim MinecraftWindow As KeyValuePair(Of IntPtr, String)? = Nothing
                 Try
                     MinecraftWindow = TryGetMinecraftWindow()
                 Catch ex As ComponentModel.Win32Exception
                     '拒绝访问(#1062)
-                    Log(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogLevel.Hint)
+                    Logger.Error(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogBehavior.Toast)
                     IsWindowFinished = True
                 End Try
-                If MinecraftWindow Is Nothing Then Exit Sub
+                If MinecraftWindow Is Nothing Then Return
                 Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
                 '已找到窗口
-                If Not MinecraftWindowName.StartsWithF("FML") Then
+                If Not MinecraftWindowName.StartsWithF("FML") AndAlso Not MinecraftWindowName.StartsWithF("Quilt Loader") Then
                     '已找到 Minecraft 窗口
                     WindowHandle = MinecraftWindowHandle
                     WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
                     IsWindowFinished = True
                     '最大化
-                    If Setup.Get("LaunchArgumentWindowType") = 4 Then
+                    If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then
                         RunInNewThread(
                         Sub()
                             Try
@@ -286,17 +288,17 @@
                                 ShowWindow(WindowHandle, 3)
                                 WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
                             Catch ex As Exception
-                                Log(ex, "最大化 Minecraft 窗口时出现错误")
+                                Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误")
                             End Try
                         End Sub, "MinecraftWindowMaximize")
                     End If
                 ElseIf Not IsWindowAppeared Then
-                    '已找到 FML 窗口
-                    WatcherLog("FML 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")")
+                    '已找到 Mod Loader 窗口
+                    WatcherLog("Mod Loader 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")")
                 End If
                 IsWindowAppeared = True
             Catch ex As Exception
-                Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback)
+                Logger.Error(ex, "检查 Minecraft 窗口失败")
             End Try
         End Sub
         ''' <summary>
@@ -304,35 +306,35 @@
         ''' Nothing 代表未找到。
         ''' </summary>
         Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)?
-            TryGetMinecraftWindow = Nothing
+            Dim Result = Nothing
             EnumWindows(
                 Sub(hwnd As IntPtr, lParam As Integer)
-                    If TryGetMinecraftWindow IsNot Nothing Then Exit Sub
+                    If Result IsNot Nothing Then Return
                     '检查类名
                     Dim str As New StringBuilder(512)
                     GetClassName(hwnd, str, str.Capacity)
                     Dim ClassName As String = str.ToString
-                    If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Exit Sub
+                    If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
                     '获取窗口标题名
                     str = New StringBuilder(512)
                     GetWindowText(hwnd, str, str.Capacity)
                     Dim WindowText As String = str.ToString
                     '有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
                     '部分版本会搞个 GLFW message window 出来所以得反选
-                    If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
+                    If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Return
                     '获取窗口关联的进程
                     Dim ProcessId As Integer
                     GetWindowThreadProcessId(hwnd, ProcessId)
                     Try
-                        If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Exit Sub '需要是此后启动的进程
+                        If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
                     Catch ex As Exception
-                        Log(ex, "枚举 Minecraft 窗口进程失败")
-                        Exit Sub
+                        Logger.Warn(ex, "枚举 Minecraft 窗口进程失败")
+                        Return
                     End Try
                     '返回
-                    TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
+                    Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
                 End Sub, 0)
-            Return TryGetMinecraftWindow
+            Return Result
         End Function
         Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer)
         Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean
@@ -344,25 +346,25 @@
 
         '崩溃处理
         Private Sub Crashed()
-            If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Exit Sub
+            If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Return
             State = MinecraftState.Crashed
             '崩溃分析
-            WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
-            Hint("检测到 Minecraft 出现错误,错误分析已开始……")
+            WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析", LogLevel.Error)
+            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", Paths.Base & "PCL\Log1.txt", Paths.Base & "PCL\LatestLaunch.bat"})
                 Catch ex As Exception
-                    Log(ex, "崩溃分析失败", LogLevel.Feedback)
+                    Logger.Error(ex, "崩溃分析失败")
                 End Try
             End Sub, "Crash Analyzer")
         End Sub
@@ -375,7 +377,7 @@
                 If Not GameProcess.HasExited Then GameProcess.Kill()
                 WatcherLog("已强制结束 Minecraft 进程")
             Catch ex As Exception
-                Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint)
+                Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast)
             End Try
         End Sub
 

Энэ ялгаанд хэт олон файл өөрчлөгдсөн тул зарим файлыг харуулаагүй болно