Compare commits

..
62 Commits
Author SHA1 Message Date
龙腾猫跃 8c8b1066bf 2.6.13 正式版 2024-01-06 22:46:38 +08:00
龙腾猫跃 fb4386952d 2.6.13 2024-01-06 22:35:35 +08:00
龙腾猫跃 fa054d9a9e 2.6.12 正式版 2023-12-26 16:52:03 +08:00
龙腾猫跃 6705444fb4 2.6.12 2023-12-18 04:56:23 +08:00
龙腾猫跃 c98e0367d0 2.6.10 正式版重新签名 2023-11-28 18:01:30 +08:00
龙腾猫跃 2c7b532188 2.6.11 2023-11-27 00:49:59 +08:00
龙腾猫跃 e2a3dd3281 Merge pull request #2864 from zkitefly/minecraft.wiki
`https://minecraft.fandom.com/zh/wiki/` -> `https://zh.minecraft.wiki/w/`
2023-11-21 18:14:34 +08:00
zkitefly e712280c7b Update ModDownloadLib.vb 2023-11-11 11:26:52 +08:00
龙腾猫跃 8308577549 2.6.10 正式版 2023-10-25 16:36:22 +08:00
龙腾猫跃 f0c634db78 2.6.10 修正 2023-10-23 23:37:34 +08:00
龙腾猫跃 7b623dbc2d 2.6.10 2023-10-23 23:34:18 +08:00
龙腾猫跃 037e6b19b4 2.6.9 2023-10-07 05:29:24 +08:00
龙腾猫跃 5ff7aed46e Merge pull request #2724 from JingHai-Lingyun/main
Update PageLoginMs.xaml.vb
2023-09-30 04:08:43 +08:00
凌云 3779d74e93 Update PageLoginMs.xaml.vb 2023-09-29 10:16:25 +08:00
龙腾猫跃 3b8de89309 2.6.8 2023-09-12 00:55:44 +08:00
龙腾猫跃 f18ede2c7a Merge pull request #2649 from zkitefly/patch-4
Update ModCrash.vb
2023-09-07 16:58:36 +08:00
龙腾猫跃 4158e95f87 * 2023-09-06 17:36:44 +08:00
龙腾猫跃 a77c2385cd * 2023-09-06 17:32:16 +08:00
龙腾猫跃 fe5dc2d07f 修改 issue 模板 2023-09-06 17:28:27 +08:00
zkitefly 17c2049d2c Update ModCrash.vb 2023-08-31 21:33:05 +08:00
zkitefly 0eebb8ec78 Update ModCrash.vb 2023-08-31 10:15:50 +08:00
zkitefly 58d40976a7 Update ModCrash.vb 2023-08-31 10:07:12 +08:00
龙腾猫跃 b2f2bcf4b6 Merge pull request #2617 from so1ve/main-1
在issue template中添加讨论链接
2023-08-26 00:28:12 +08:00
Ray 2a6708cc08 Update config.yml 2023-08-26 00:14:35 +08:00
Ray c9c00bc23f Update config.yml 2023-08-26 00:12:42 +08:00
Ray 7fa092eb25 Update config.yml 2023-08-26 00:12:05 +08:00
Ray d4e692b69f Update config.yml 2023-08-26 00:10:15 +08:00
龙腾猫跃 8479c47da0 Merge pull request #2574 from zkitefly/issue
https://github.com/Hex-Dragon/PCL2/discussions/2572
2023-08-23 02:40:57 +08:00
zkitefly 971aa0034d 还是换回去吧( 2023-08-22 23:11:08 +08:00
龙腾猫跃 b717bb31c8 2.6.7 正式版 2023-08-22 22:47:42 +08:00
zkitefly 3037a9e384 改一下 2023-08-22 22:41:40 +08:00
zkitefly 6794b24292 https://github.com/Hex-Dragon/PCL2/discussions/2572 2023-08-22 22:39:33 +08:00
龙腾猫跃 d774de5436 2.6.7 2023-08-22 16:19:12 +08:00
龙腾猫跃 e4ae1a057a 2.6.6 正式版 2023-08-21 14:22:57 +08:00
龙腾猫跃 41250d8387 2.6.6 2023-08-21 04:02:19 +08:00
龙腾猫跃 79778490d5 2.6.5 2023-08-15 16:38:52 +08:00
龙腾猫跃 e1e084aea3 Merge pull request #2487 from SALTWOOD/main
Fix #2486
2023-08-13 19:22:36 +08:00
SALTWOOD 836d55e445 Fix #2486 2023-08-13 17:26:35 +08:00
龙腾猫跃 3574931bfb Merge pull request #2301 from zkitefly/patch-2
Update ModCrash.vb
2023-08-06 11:25:17 +08:00
zkitefly c9aabd6a55 Update ModCrash.vb 2023-07-21 09:30:39 +08:00
龙腾猫跃 e6c6975047 2.6.4 2023-07-18 04:45:38 +08:00
龙腾猫跃 9c41a807c3 Merge pull request #2271 from zkitefly/patch-2
Update ModCrash.vb
2023-07-17 18:17:15 +08:00
zkitefly a0fe5903f0 Update ModCrash.vb 2023-07-17 16:43:44 +08:00
zkitefly 06be5b5b17 Update ModCrash.vb
https://github.com/Hex-Dragon/PCL2/discussions/2270
2023-07-17 16:08:38 +08:00
龙腾猫跃 73d43310c9 Merge pull request #2173 from zkitefly/patch-2
Update PageVersionSetup.xaml
2023-07-16 00:55:53 +08:00
龙腾猫跃 9b54ea3dee Merge pull request #2148 from zkitefly/log
添加检查:Mod依赖项未完善
2023-07-16 00:53:21 +08:00
zkitefly fa5026ccd7 Update PageVersionSetup.xaml 2023-07-04 17:48:05 +08:00
zkitefly ca3e7f40e1 Update PageVersionSetup.xaml 2023-07-04 17:47:15 +08:00
zkitefly 8004385d6f Update PageVersionSetup.xaml 2023-07-04 17:46:50 +08:00
龙腾猫跃 2c2bd2d489 2.6.3 正式版 2023-07-02 22:04:24 +08:00
[email protected] 80cf5957f2 更新 ModCrash.vb 2023-06-30 11:57:25 +08:00
[email protected] 7d139cbd73 添加检查:Mod依赖项未完善
https://mclo.gs/p25LjXV
2023-06-30 11:17:10 +08:00
龙腾猫跃 8a770f63cf 2.6.3 重新上传 2023-06-24 17:32:40 +08:00
龙腾猫跃 07e824b0a1 Merge branch 'main' of https://github.com/Hex-Dragon/PCL2 2023-06-22 17:04:56 +08:00
龙腾猫跃 794c3003f3 2.6.3 2023-06-22 17:04:23 +08:00
龙腾猫跃 d956fb2521 Merge pull request #1954 from zkitefly/patch-4
在安装 MMC 和 MCBBS 整合包时如果加载器是 org.quiltmc.quilt-loader ,则提示不支持
2023-06-17 17:21:04 +08:00
龙腾猫跃 6005856661 Merge pull request #2055 from zkitefly/log2
部分mod需要JDK11报错时的错误分析检测优化
2023-06-17 17:17:17 +08:00
龙腾猫跃 920817cc34 Merge pull request #2057 from zkitefly/log3
`OptiFine与Forge不兼容`的新规则
2023-06-17 17:11:40 +08:00
[email protected] c1167632a6 OptiFine与Forge不兼容的新规则
1.20的qwq
2023-06-17 01:14:06 +08:00
[email protected] 352799c0ed 部分mod需要JDK11报错时的错误分析检测优化
https://mclo.gs/D5MVHDa#L30
https://mclo.gs/nWMnElV#L34
https://mclo.gs/eoO8xjH#L14
https://mclo.gs/BVagUsw#L14
https://mclo.gs/Jw1dRMZ#L27
https://mclo.gs/PYRFCj3#L21
https://mclo.gs/4dCbKcJ#L19
https://mclo.gs/NCfhHYC#L14
2023-06-17 00:47:12 +08:00
zkitefly 3e5ba70516 Update ModModpack.vb 2023-06-09 22:14:59 +08:00
zkitefly 9420c37640 在安装 MMC 整合包时如果加载器是 org.quiltmc.quilt-loader ,则提示不支持 2023-06-03 02:07:36 +08:00
114 changed files with 8299 additions and 4295 deletions

No files matched your search

+16 -10
View File
@@ -1,5 +1,5 @@
name: "Minecraft 崩溃"
description: "PCL2 提示 “Minecraft 出现错误”,或游戏崩溃"
description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃"
labels: [· Bug, 新反馈]
body:
- type: checkboxes
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃不是 PCL2 的原因,请 **不要** 提交反馈。你可以在 QQ 群里或者论坛找人求助,但这里并不是你求助的地方。"
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃基本不是 PCL 的原因,请 **不要** 提交反馈。你可以在论坛或社区找人求助,但这里并不是你求助的地方。"
required: false
- label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: true
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是游戏本身的问题,并非 PCL2 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
required: true
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
@@ -26,8 +24,16 @@ body:
- type: textarea
id: "yml-3"
attributes:
label: 错误报告、日志与附件
description: "上传 PCL2 提供的错误报告(在崩溃时选择导出错误报告)。如果没有,也可以上传 PCL 文件夹中的 Log1~5.txt。"
label: PCL 错误报告、日志与附件
description: "上传 PCL 提供的错误报告(在崩溃时选择导出错误报告)。如果没有,也可以上传 PCL 文件夹中的 Log1~5.txt。"
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
validations:
required: true
required: true
- type: textarea
id: "yml-4"
attributes:
label: HMCL 启动脚本
description: "在 HMCL 中进入版本列表,点击版本右侧的三个点,选择 生成启动脚本。"
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
validations:
required: false
+5 -7
View File
@@ -1,5 +1,5 @@
name: "下载或登录时卡住或失败"
description: "下载游戏、Mod 或整合包,登录正版账号时出现问题"
description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题"
labels: [· Bug, 新反馈]
body:
- type: checkboxes
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL2 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
required: true
- label: "我已知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题是 PCL2 导致的,和我的网络环境无关。"
required: true
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+1 -3
View File
@@ -8,9 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: false
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+1 -3
View File
@@ -8,9 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未实现这项建议。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一建议未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/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/),确认了这一建议未在投票列表中。"
required: true
+5 -2
View File
@@ -2,7 +2,10 @@ blank_issues_enabled: false
contact_links:
- name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues
about: 提交 PCL2 帮助系统(更多 → 帮助)相关的反馈
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
- name: 提问
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE
about: 我不想提交反馈,只是想问一些问题
about: 我想问一些 PCL 相关的问题……
- name: 讨论
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E8%AE%A8%E8%AE%BA
about: 我想讨论一些 PCL 相关的事情……
+2 -4
View File
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未实现这一功能。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一提案未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/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/),确认了这一提案未在投票列表中。"
required: true
- label: "我已知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
- label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
required: true
- type: textarea
id: "yml-2"
+6 -6
View File
@@ -133,7 +133,7 @@
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="4" MaxWidth="500" Background="#E5FFFFFF" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="4" MaxWidth="500" Background="#E5FFFFFF" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.3" BlurRadius="4" ShadowDepth="2" Color="{DynamicResource ColorObject1}" />
</Border.Effect>
@@ -147,7 +147,7 @@
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
@@ -293,7 +293,7 @@
<!-- 由于未知原因,TextView 会有 2,0 的 Margin -->
</Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.3" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.25" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid>
@@ -345,7 +345,7 @@
<!-- ComboBox -->
<DataTemplate x:Key="ComboBoxItemTemplateWithDelete">
<local:MyListItem Title="{Binding}" FontSize="13" PaddingRight="40" MaxHeight="26" IsScaleAnimationEnabled="False" Margin="-3,0,0,0">
<local:MyListItem Title="{Binding}" FontSize="13" MaxHeight="26" IsScaleAnimationEnabled="False" Margin="-3,0,0,0">
<local:MyListItem.Buttons>
<x:Array Type="local:MyIconButton">
<local:MyIconButton Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Tag="{Binding}" Click="MyIconButton_Click" 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" />
@@ -466,9 +466,9 @@
</Style>
<Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="ToolTipService.Placement" Value="Right" />
<Setter Property="ToolTipService.Placement" Value="Relative" />
<Setter Property="ToolTipService.VerticalOffset" Value="-2" />
<Setter Property="ToolTipService.HorizontalOffset" Value="-250" />
<Setter Property="ToolTipService.HorizontalOffset" Value="200" />
<Setter Property="ToolTipService.InitialShowDelay" Value="150" />
<Setter Property="ToolTipService.BetweenShowDelay" Value="150" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
+18 -6
View File
@@ -41,8 +41,11 @@ Public Class Application
MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败")
Environment.Exit(-1)
End Try
Ram = My.Computer.Info.AvailablePhysicalMemory - Ram
Environment.Exit(Math.Max(0, Ram / 1024)) '返回清理的内存量(K)
If My.Computer.Info.AvailablePhysicalMemory < Ram Then '避免 ULong 相减出现负数
Environment.Exit(0)
Else
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
End If
#If DEBUG Then
ElseIf e.Args(0) = "--make" Then
'制作更新包
@@ -71,7 +74,8 @@ Public Class Application
Directory.CreateDirectory(PathAppdata)
'检测单例
#If Not DEBUG Then
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2 ")
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
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
@@ -112,9 +116,9 @@ Public Class Application
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 1024
ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean
Return True
End Function)
'ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean
' Return True
' End Function)
'计时
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick()
@@ -243,4 +247,12 @@ Public Class Application
End Select
End Sub
Public Shared ShowingTooltips As New List(Of Border)
Private Sub TooltipLoaded(sender As Border, e As EventArgs)
ShowingTooltips.Add(sender)
End Sub
Private Sub TooltipUnloaded(sender As Border, e As RoutedEventArgs)
ShowingTooltips.Remove(sender)
End Sub
End Class
@@ -134,23 +134,21 @@
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
If Not IsMouseDown Then Exit Sub
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
ModEvent.TryStartEvent(EventType, EventData)
End If
ModEvent.TryStartEvent(EventType, EventData)
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
@@ -159,8 +157,7 @@
Get
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
+6 -7
View File
@@ -41,10 +41,6 @@
End Sub
Private IsLoad As Boolean = False
Private Sub MyCard_Loaded() Handles Me.Loaded
'卡片的进入时动画已被页面通用切换动画替代
'If LoadAnimation AndAlso IsLoad Then
' StartHeightAnimation(Math.Min(50, ActualHeight), ActualHeight - Math.Min(50, ActualHeight), True)
'End If
If IsLoad Then Exit Sub
'初次加载限定
If Not Title = "" AndAlso IsNothing(MainTextBlock) Then
@@ -113,7 +109,7 @@
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
CompFilesCardPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick)
CompFilesCardPreload(Stack, Stack.Tag)
End Select
'实现控件虚拟化
For Each Data As Object In Stack.Tag
@@ -166,7 +162,9 @@
End Sub
'事件
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
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))
@@ -178,6 +176,7 @@
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
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))
@@ -210,7 +209,7 @@
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
'高度增加较大,使用弹起动画
Dim Delta As Double = MathRange(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
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))
@@ -218,7 +217,7 @@
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathRange(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
End If
AnimList.Add(AaCode(Sub()
@@ -16,9 +16,9 @@
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<Border x:Name="PanProgress" CornerRadius="1000" BorderThickness="0.001" Background="#2AFFFFFF" ClipToBounds="True" Visibility="Collapsed">
<Border x:Name="PanProgress" CornerRadius="1000" BorderThickness="0.001" Background="#2FFFFFFF" ClipToBounds="True" Visibility="Collapsed">
<Border.Clip>
<RectangleGeometry x:Name="RectProgress" Rect="0,0,40,25" />
<RectangleGeometry x:Name="RectProgress" Rect="0,5,40,35" />
</Border.Clip>
</Border>
<Path x:Name="Path" Stretch="Uniform" Margin="12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
@@ -17,7 +17,7 @@
PanProgress.Visibility = Visibility.Collapsed
Else
PanProgress.Visibility = Visibility.Visible
RectProgress.Rect = New Rect(0, 0, 40, 40 * (1 - value))
RectProgress.Rect = New Rect(0, 40 * (1 - value), 40, 40 * value)
End If
End Set
End Property
@@ -102,7 +102,7 @@
Get
Return _CanRightClick
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
_CanRightClick = value
End Set
End Property
@@ -179,7 +179,7 @@
AniStop("MyExtraButton Color " & Uuid)
If IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush2")
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
+42 -9
View File
@@ -11,17 +11,17 @@
If _IsWarn = value Then Exit Property
_IsWarn = value
If _IsWarn Then
BorderBrush = New MyColor("#99FF4444")
Gradient1.Color = New MyColor("#88FFBBBB")
Gradient2.Color = New MyColor("#88FF8888")
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 ")
Else
BorderBrush = New MyColor("#994D76FF")
Gradient1.Color = New MyColor("#88B0D0FF")
Gradient2.Color = New MyColor("#889EBAFF")
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")
@@ -34,7 +34,7 @@
Get
Return LabText.Text
End Get
Set(ByVal value As String)
Set(value As String)
LabText.Text = value
End Set
End Property
@@ -43,13 +43,12 @@
Get
Return BtnClose.Visibility = Visibility.Visible
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public 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
@@ -60,6 +59,40 @@
AniDispose(Me, False)
End Sub
'触发点击事件
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))
e.Handled = True
ModEvent.TryStartEvent(EventType, EventData)
End Sub
Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
End Sub
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)
@@ -50,13 +50,31 @@
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
End If
If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
ModEvent.TryStartEvent(EventType, EventData)
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
@@ -115,7 +133,7 @@
Dim AnimList As New List(Of AniData)
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush5", AnimationColorOut))
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
Case Themes.White
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush8", AnimationColorOut))
@@ -0,0 +1,9 @@
<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">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="7,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -0,0 +1,186 @@
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 事件
'自定义属性
Public Property Logo As String
Get
Return ShapeLogo.Data.ToString
End Get
Set(value As String)
ShapeLogo.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(ShapeLogo) Then ShapeLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue
End Sub)))
Public Enum ColorState
Black
Highlight
End Enum
Private _ColorType As ColorState = ColorState.Black
Public Property ColorType As ColorState
Get
Return _ColorType
End Get
Set(value As ColorState)
_ColorType = value
RefreshColor()
End Set
End Property '颜色类别
Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata())
'点击事件
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)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
ModEvent.TryStartEvent(EventType, EventData)
RefreshColor()
End Sub
Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
IsMouseDown = True
RefreshColor()
End Sub
Private Sub MyIconTextButton_MouseLeave() Handles Me.MouseLeave
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))
'动画
Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度
Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画,若强制不执行动画,则 e 为 False
Select Case ColorType
Case ColorState.Black
If IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", 70), "MyIconTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrushBg1", AnimationTimeOfMouseIn), "MyIconTextButton Color " & Uuid)
ElseIf IsEnabled Then
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush1", AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush1", AnimationTimeOfMouseOut)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
Else
'禁用
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrushGray5", 100),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrushGray5", 100)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
End If
Case ColorState.Highlight
If IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", 70), "MyIconTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrushBg1", AnimationTimeOfMouseIn), "MyIconTextButton Color " & Uuid)
ElseIf IsEnabled Then
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseOut)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
Else
'禁用
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrushGray5", 100),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrushGray5", 100)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
End If
End Select
Else
'不使用动画
AniStop("MyIconTextButton Checked " & Uuid)
AniStop("MyIconTextButton Color " & Uuid)
Select Case ColorType
Case ColorState.Black
Background = ColorSemiTransparent
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
Case ColorState.Highlight
Background = ColorSemiTransparent
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, If(IsEnabled, "ColorBrush3", "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush3", "ColorBrushGray5"))
End Select
End If
Catch ex As Exception
Log(ex, "刷新带图标按钮颜色出错")
End Try
End Sub
End Class
@@ -11,7 +11,7 @@
<ColumnDefinition x:Name="ColumnPaddingLeft" Width="0" />
<ColumnDefinition x:Name="ColumnLogo" Width="4" />
<ColumnDefinition Width="1*"/>
<ColumnDefinition x:Name="ColumnPaddingRight" Width="0" />
<ColumnDefinition x:Name="ColumnPaddingRight" Width="4" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
@@ -15,7 +15,7 @@
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled, 6, 0)),
.CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled OrElse Height > 40, 6, 0)),
.RenderTransform = If(IsScaleAnimationEnabled, New ScaleTransform(0.8, 0.8), Nothing),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
@@ -104,42 +104,34 @@
ColumnPaddingLeft.Width = New GridLength(value)
End Set
End Property
Public Property PaddingRight As Integer
Get
Return ColumnPaddingRight.Width.Value
End Get
Set(value As Integer)
ColumnPaddingRight.Width = New GridLength(value)
End Set
End Property
''' <summary>
''' 右边距的最小值。
''' 在存在右侧按钮时,右边距会被自动设置为 5 + 按钮数 * 25。
''' </summary>
Public Property MinPaddingRight As Integer = 4
'按钮
Private _Buttons As IEnumerable
Public Property Buttons As IEnumerable
Private _Buttons As IEnumerable(Of MyIconButton)
Public Property Buttons As IEnumerable(Of MyIconButton)
Get
Return _Buttons
End Get
Set(value As IEnumerable)
Set(value As IEnumerable(Of MyIconButton))
_Buttons = value
'没有特殊按钮,移除原 Stack
If Not IsNothing(ButtonStack) Then
If ButtonStack IsNot Nothing Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
'获取按钮数量
Dim Count As Integer = 0
For Each Counter In value
Count += 1
Next
'添加新 Stack
Select Case Count
Select Case value.Count
Case 0
'没有按钮,不添加新的
Case 1
'只有一个按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
With Btn
.Opacity = 0
.Margin = New Thickness(0, 0, 5, 0)
@@ -149,22 +141,18 @@
.SnapsToDevicePixels = False
.UseLayoutRounding = False
End With
SetColumn(Btn, 4)
SetColumnSpan(Btn, 4)
SetRowSpan(Btn, 4)
SetColumnSpan(Btn, 10) : SetRowSpan(Btn, 10)
Children.Add(Btn)
ButtonStack = Btn
Next
Case Else
'有复数按钮,使用 StackPanel
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumn(ButtonStack, 4)
SetColumnSpan(ButtonStack, 4)
SetRowSpan(ButtonStack, 4)
SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
@@ -225,6 +213,7 @@
If _Logo.ToLower.StartsWith("http") Then
'网络图片
PathLogo = New Image With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
@@ -235,6 +224,7 @@
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Background = Bitmap,
.RenderTransformOrigin = New Point(0.5, 0.5),
@@ -252,6 +242,7 @@
Else
'矢量图
PathLogo = New Shapes.Path With {
.Tag = Me,
.IsHitTestVisible = LogoClickable, .HorizontalAlignment = HorizontalAlignment.Center, .VerticalAlignment = VerticalAlignment.Center, .Stretch = Stretch.Uniform,
.Data = (New GeometryConverter).ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
@@ -267,7 +258,7 @@
If LogoClickable Then
AddHandler PathLogo.MouseLeave, Sub(sender, e) IsLogoDown = False
AddHandler PathLogo.MouseLeftButtonDown, Sub(sender, e) IsLogoDown = True
AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender, e)
AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender.Tag, e)
End If
End If
'改变行距
@@ -286,6 +277,9 @@
End Property
'图标的点击
''' <summary>
''' 该 Logo 是否可用点击触发事件。需要在 Logo 属性之前设置。
''' </summary>
Public Property LogoClickable As Boolean = False
Private IsLogoDown As Boolean = False
@@ -318,7 +312,8 @@
'添加竖条控件
If IsNothing(RectCheck) Then
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,
.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))}
RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(RectCheck, 4)
@@ -447,7 +442,7 @@
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-1, 0, 0, 0)
End If
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush3", 200))
Anim.Add(AaColor(Me, ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"), 200))
Else
'由有变无
If Not IsNothing(RectCheck) Then
@@ -469,7 +464,7 @@
RectCheck.Opacity = 1
RectCheck.VerticalAlignment = VerticalAlignment.Stretch
End If
SetResourceReference(ForegroundProperty, "ColorBrush3")
SetResourceReference(ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"))
Else
If Not IsNothing(RectCheck) Then
RectCheck.Height = 0
@@ -526,10 +521,6 @@
Log("[Control] 按下复选列表项(" & (Not Checked).ToString & "):" & Title)
SetChecked(Not Checked, True, True)
End Select
'AniStart({
' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent),
' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
'鼠标点击判定
@@ -537,15 +528,12 @@
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseDirectlyOver AndAlso Not Type = CheckType.None Then
IsMouseDown = True
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = False
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False
End If
'AniStart({
' AaScaleTransform(Me, 0.985 - CType(RenderTransform, ScaleTransform).ScaleX, 50,, New AniEaseOutFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = True
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'实现自定义事件
@@ -599,7 +587,11 @@
'有动画
Dim Ani As New List(Of AniData)
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
If ButtonStack IsNot Nothing Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
Math.Max(MinPaddingRight, 5 + Buttons.Count * 25) - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
End If
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
@@ -613,27 +605,39 @@
End If
End If
Else
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.5))
If ButtonStack IsNot Nothing Then
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
MinPaddingRight - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
Ani.Add(AaOpacity(RectBack, -RectBack.Opacity, Time))
If IsScaleAnimationEnabled Then Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.246, 1,,, True)
})
If IsScaleAnimationEnabled Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(Me, 1 - CType(RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.246, 1,,, True)
})
End If
End If
AniStart(Ani, "ListItem Color " & Uuid)
Else
'无动画
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1
If ButtonStack IsNot Nothing Then
ButtonStack.Opacity = 1
ColumnPaddingRight.Width = New GridLength(Math.Max(MinPaddingRight, 5 + Buttons.Count * 25))
End If
'由于鼠标已经移入,所以直接实例化 RectBack
RectBack.Background = ColorBg1
RectBack.Opacity = 1
RectBack.RenderTransform = New ScaleTransform(1, 1)
Me.RenderTransform = New ScaleTransform(1, 1)
Else
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 0
If ButtonStack IsNot Nothing Then
ButtonStack.Opacity = 0
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
End If
Me.RenderTransform = New ScaleTransform(1, 1)
If _RectBack IsNot Nothing Then
If IsScaleAnimationEnabled Then RectBack.RenderTransform = New ScaleTransform(0.75, 0.75)
@@ -647,10 +651,11 @@
Private Sub MyListItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If Checked Then
SetResourceReference(ForegroundProperty, "ColorBrush3")
SetResourceReference(ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"))
Else
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
If EventType = "打开帮助" Then
Try
Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
@@ -46,7 +46,7 @@ Public Class MyLoading
Get
Return _Text
End Get
Set(ByVal value As String)
Set(value As String)
_Text = value
RefreshText()
End Set
@@ -57,7 +57,7 @@ Public Class MyLoading
Get
Return _TextError
End Get
Set(ByVal value As String)
Set(value As String)
_TextError = value
RefreshText()
End Set
@@ -67,29 +67,35 @@ Public Class MyLoading
''' </summary>
Public Property TextErrorInherit As Boolean = True
Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded
If InnerState = MyLoadingState.Error Then
If TextErrorInherit AndAlso State.IsLoader Then
Dim Ex As Exception = CType(State, Object).Error
If Ex Is Nothing Then
LabText.Text = "未知错误"
Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded, _State.ProgressChanged
RunInUi(
Sub()
If InnerState = MyLoadingState.Error Then
If TextErrorInherit AndAlso State.IsLoader Then
Dim Ex As Exception = CType(State, Object).Error
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
End If
Else
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = StrTrim(Ex.Message)
If LabText.Text.Contains("远程主机强迫关闭了一个现有的连接") OrElse LabText.Text.Contains("操作已超时") OrElse LabText.Text.Contains("操作超时") OrElse LabText.Text.Contains("服务器超时") OrElse LabText.Text.Contains("连接超时") Then LabText.Text = "网络环境不佳,请重试或尝试使用 VPN"
LabText.Text = TextError
End If
Else
LabText.Text = TextError
If ShowProgress AndAlso State.IsLoader Then
LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%"
Else
LabText.Text = Text
End If
End If
Else
If ShowProgress AndAlso State.IsLoader Then
LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%"
Else
LabText.Text = Text
End If
End If
End Sub)
End Sub
#End Region
@@ -180,46 +186,7 @@ Public Class MyLoading
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
IsLooping = True
ErrorAnimationWaiting = True
If ShowProgress Then
RefreshText()
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaCode(AddressOf RefreshText, 100), '这是为了省下一个 Timer 线程……
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
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
RefreshText()
End Sub),
AaCode(AddressOf RefreshText, 100),
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
AaCode(AddressOf RefreshText, 600),
AaCode(AddressOf RefreshText, 700),
AaCode(AddressOf RefreshText, 800),
AaOpacity(PathLeft, -1, 100, 70),
AaX(PathLeft, -5, 180, 20, New AniEaseOutFluent),
AaY(PathLeft, -6, 180, 20, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 70),
AaX(PathRight, 5, 180, 20, New AniEaseOutFluent),
AaY(PathRight, -6, 180, 20, New AniEaseOutFluent),
AaCode(Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
Else
AniStart({
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)),
@@ -241,6 +208,8 @@ Public Class MyLoading
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
If ShowProgress Then
End If
End Sub
@@ -291,6 +260,7 @@ Public Interface ILoadingTrigger
ReadOnly Property IsLoader As Boolean
Property LoadingState As MyLoadingState
Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState)
Event ProgressChanged(NewProgress As Double, OldProgress As Double)
End Interface
Public Class MyLoadingStateSimulator
@@ -310,4 +280,5 @@ Public Class MyLoadingStateSimulator
Public ReadOnly Property IsLoader As Boolean = False Implements ILoadingTrigger.IsLoader
Public Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
End Class
@@ -6,6 +6,8 @@
Dim IconControl As Shapes.Path = GetTemplateChild("Icon")
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If
'对父级设置透明度
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
End Sub
'基础
+27 -21
View File
@@ -29,21 +29,28 @@
'逐个进入动画
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, 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))
For Each Element As FrameworkElement In GetAllAnimControls(True)
If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变(#2436)
Element.Opacity = 1
Element.RenderTransform = New TranslateTransform(0, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
Else
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(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))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Id += 1
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
End If
@@ -74,23 +81,22 @@
End Sub
'遍历获取所有需要生成动画的控件
Private Function GetAllAnimControls() As List(Of FrameworkElement)
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(AnimatedControl, AllControls)
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement))
If Element.Visibility = Visibility.Collapsed Then Exit Sub
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 TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is MyListItem Then
CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls)
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls, IgnoreInvisibility)
ElseIf TypeOf Element Is Panel Then
For Each Element2 As FrameworkElement In CType(Element, Panel).Children
GetAllAnimControls(Element2, AllControls)
GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
Next
Else
AllControls.Add(Element)
@@ -2,6 +2,18 @@
Inherits AdornerDecorator
Public PageUuid As Integer = GetUuid()
'“返回顶部” 按钮检测的滚动区域
Public Property PanScroll As MyScrollViewer
Get
Return GetValue(PanScrollProperty)
End Get
Set(value As MyScrollViewer)
SetValue(PanScrollProperty, value)
End Set
End Property
Private Shared ReadOnly PanScrollProperty =
DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing))
'当前状态
Public Enum PageStates
Empty '默认状态,页面全空
@@ -152,6 +164,7 @@
''' </summary>
Public Sub PageOnExit()
If ModeDebug Then Log("[UI] 已触发 PageOnExit")
RaiseEvent PageExit()
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
PageState = PageStates.PageExit
@@ -168,6 +181,7 @@
Case PageStates.PageExit, PageStates.Empty
End Select
End Sub
Public Event PageExit()
''' <summary>
''' 即将切换到其他页面,需要强制完成页面状态清理。
''' 需要立即切换至 Empty。
@@ -4,6 +4,6 @@
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -252,7 +252,7 @@
End If
Catch ex As Exception
Log(ex, "刷新按钮颜色出错")
Log(ex, "刷新单选按钮颜色出错")
End Try
End Sub
@@ -15,12 +15,16 @@
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
End If
PerformVerticalOffsetDelta(-e.Delta)
e.Handled = True
PerformVerticalOffsetDelta(-e.Delta)
'关闭 Tooltip (#2552)
For Each TooltipBorder In Application.ShowingTooltips
AniStart(AaOpacity(TooltipBorder, -1, 100), $"Hide Tooltip {GetUuid()}")
Next
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double)
RealOffset = MathRange(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
End Sub
@@ -1,7 +1,7 @@
Class MySearchBox
Inherits MyCard
Public Event TextChanged(ByVal sender As Object, ByVal e As EventArgs)
Public Event TextChanged(sender As Object, e As EventArgs)
Private Sub MySearchBox_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
TextBox.Focus()
End Sub
@@ -11,7 +11,7 @@
Get
Return TextBox.HintText
End Get
Set(ByVal value As String)
Set(value As String)
TextBox.HintText = value
End Set
End Property
@@ -19,7 +19,7 @@
Get
Return TextBox.Text
End Get
Set(ByVal value As String)
Set(value As String)
TextBox.Text = value
End Set
End Property
@@ -9,7 +9,7 @@
MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrushBg0}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<Grid x:Name="PanMain" MinHeight="16" MaxHeight="16" IsHitTestVisible="False">
<Line Height="4" Name="LineBack" Stroke="{DynamicResource ColorBrushBg0}" Opacity="0.3" StrokeThickness="1" X2="10000" Y1="2" Y2="2" HorizontalAlignment="Right" Width="0" SnapsToDevicePixels="True" Margin="0,0,1,0" />
<Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" />
<Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="2" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" />
<Ellipse HorizontalAlignment="Left" Width="10" Height="10"
Stroke="{Binding BorderBrush, ElementName=PanBack}" StrokeThickness="1.2"
Fill="{DynamicResource ColorBrushBg0}" Name="ShapeDot" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5">
@@ -28,7 +28,7 @@
Set(newValue As Integer)
Try
newValue = MathRange(newValue, 0, MaxValue)
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
'触发 Preview 事件,修改新值
@@ -88,7 +88,7 @@
AniStop("MySlider KeyPopup " & Uuid)
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
@@ -91,7 +91,7 @@
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
@@ -101,7 +101,7 @@
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
+9 -6
View File
@@ -1,10 +1,13 @@
<Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher 2 " AllowsTransparency="True" MinHeight="470" MinWidth="810" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher " AllowsTransparency="True" MinHeight="470" MinWidth="810"
ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None"
ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500"
RenderTransformOrigin="0.5,0.5">
<Window.TaskbarItemInfo>
<TaskbarItemInfo ThumbnailClipMargin="{Binding Margin, ElementName=PanForm}" />
</Window.TaskbarItemInfo>
+272 -193
View File
@@ -10,6 +10,44 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 313 Then 'Release 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6
BugCount += 10
End If
If LastVersion < 311 Then 'Release 2.6.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 27
BugCount += 25
End If
If LastVersion < 308 Then 'Release 2.6.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 31
BugCount += 37
End If
If LastVersion < 302 Then 'Release 2.6.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug"))
BugCount += 1
End If
If LastVersion < 300 Then 'Release 2.6.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 40
BugCount += 34
End If
If LastVersion < 296 Then 'Release 2.6.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureCount += 21
BugCount += 30
End If
If LastVersion < 293 Then 'Release 2.6.1
BugCount += 1
End If
@@ -85,30 +123,68 @@ Public Class FormMain
FeatureCount += 4
BugCount += 4
End If
If LastVersion < 255 Then 'Release 2.2.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
FeatureCount += 5
BugCount += 3
End If
If LastVersion < 253 Then 'Release 2.2.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
FeatureCount += 13
BugCount += 27
End If
If LastVersion < 250 Then 'Release 2.2.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持将 Mod 文件拖入窗口进行安装"))
If LastVersion = 246 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用中文搜索 Mod 的 Bug"))
FeatureCount += 8
BugCount += 33
End If
#Else
'5: FEAT+
'4: IMP+ FEAT*
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 312 Then 'Snapshot 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6
BugCount += 10
End If
If LastVersion < 310 Then 'Snapshot 2.6.12
If LastVersion = 309 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理页面添加启用、禁用单个 Mod 的快捷按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 13
BugCount += 12
End If
If LastVersion < 309 Then 'Snapshot 2.6.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureCount += 15
BugCount += 13
End If
If LastVersion < 307 Then 'Snapshot 2.6.10
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 306 Then 'Snapshot 2.6.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureCount += 9
BugCount += 11
End If
If LastVersion < 305 Then 'Snapshot 2.6.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 20
BugCount += 25
End If
If LastVersion < 303 Then 'Snapshot 2.6.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug"))
BugCount += 1
End If
If LastVersion < 301 Then 'Snapshot 2.6.6
FeatureCount += 4
BugCount += 2
End If
If LastVersion < 299 Then 'Snapshot 2.6.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 18
BugCount += 13
End If
If LastVersion < 298 Then 'Snapshot 2.6.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureCount += 18
BugCount += 19
End If
If LastVersion < 297 Then 'Snapshot 2.6.3
FeatureCount += 12
BugCount += 14
End If
If LastVersion < 294 Then 'Snapshot 2.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
@@ -237,28 +313,6 @@ Public Class FormMain
FeatureCount += 4
BugCount += 4
End If
If LastVersion < 256 Then 'Snapshot 2.2.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
FeatureCount += 5
BugCount += 3
End If
If LastVersion < 254 Then 'Snapshot 2.2.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
FeatureCount += 3
BugCount += 17
End If
If LastVersion < 252 Then 'Snapshot 2.2.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
If LastVersion = 251 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复同时安装 Forge 和 OptiFine 时 OptiFine 无效的 Bug"))
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 251 Then 'Snapshot 2.2.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持将 Mod 文件拖入窗口进行安装"))
FeatureCount += 2
BugCount += 16
End If
#End If
'整理更新日志文本
Dim ContentList As New List(Of String)
@@ -317,6 +371,13 @@ Public Class FormMain
'加载 UI
InitializeComponent()
Opacity = 0
''开启管理员权限下的文件拖拽,但下列代码也没用(#2531)
'If IsAdmin() Then
' Log("[Start] PCL 正以管理员权限运行")
' ChangeWindowMessageFilter(&H233, 1)
' ChangeWindowMessageFilter(&H4A, 1)
' ChangeWindowMessageFilter(&H49, 1)
'End If
'切换到首页
If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
@@ -328,7 +389,7 @@ Public Class FormMain
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
#End If
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会造成性能的下降,若无必要请不要开启!")
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会导致性能下降,若无必要请不要开启!")
'尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
@@ -366,8 +427,14 @@ Public Class FormMain
End If
'加载窗口
ThemeRefreshMain()
Height = ReadReg("WindowHeight", MinHeight + 50)
Width = ReadReg("WindowWidth", MinWidth + 50)
Try
Height = ReadReg("WindowHeight", MinHeight + 50)
Width = ReadReg("WindowWidth", MinWidth + 50)
Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
Height = MinHeight + 50
Width = MinWidth + 50
End Try
Topmost = False
If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
'更改窗口
@@ -389,10 +456,11 @@ Public Class FormMain
End Sub, , True)
}, "Form Show")
'Timer 启动
AniStartRun()
TimerMainStartRun()
AniStart()
TimerMainStart()
'加载池
RunInNewThread(Sub()
'EULA 提示
If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
@@ -402,6 +470,7 @@ Public Class FormMain
EndProgram(False)
End Select
End If
'启动加载器池
Try
JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
Thread.Sleep(200)
@@ -411,6 +480,7 @@ Public Class FormMain
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
End Try
'清理自动更新文件
Try
If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
@@ -420,6 +490,7 @@ Public Class FormMain
Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
End Sub
'Private Declare Function ChangeWindowMessageFilter Lib "user32.dll" (message As Integer, action As Integer) As Boolean
'根据打开次数触发的事件
Private Sub RunCountSub()
Setup.Set("SystemCount", Setup.Get("SystemCount") + 1)
@@ -585,6 +656,7 @@ Public Class FormMain
Process.GetCurrentProcess.Kill()
Else
Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill()
End If
End Sub
Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click
@@ -612,6 +684,7 @@ Public Class FormMain
PanForm.Height = BorderForm.ActualHeight + 0.001
PanMain.Width = PanForm.Width
PanMain.Height = Math.Max(0, PanForm.Height - PanTitle.ActualHeight)
If WindowState = WindowState.Maximized Then WindowState = WindowState.Normal '修复 #1938
End Sub
'最小化
@@ -724,31 +797,32 @@ Public Class FormMain
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Critical)
Exit Sub
End If
If McVersionCurrent Is Nothing Then
Dim TargetVersion = If(PageCurrent = PageType.VersionSetup, PageVersionLeft.Version, McVersionCurrent)
If TargetVersion Is Nothing Then
Hint("请先下载游戏,再设置第三方登录!", HintType.Critical)
Exit Sub
End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'LittleSkin
If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启 LittleSkin 登录?" & vbCrLf &
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启 LittleSkin 登录?" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
End If
Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=McVersionCurrent)
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=TargetVersion)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=TargetVersion)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=TargetVersion)
Else
'第三方 Authlib 服务器
If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启第三方登录?" & vbCrLf &
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启第三方登录?" & vbCrLf &
$"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
End If
Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=McVersionCurrent)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=McVersionCurrent)
Setup.Set("VersionServerAuthName", "", Version:=McVersionCurrent)
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=TargetVersion)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=TargetVersion)
Setup.Set("VersionServerAuthName", "", Version:=TargetVersion)
End If
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionSetup Then
'正在服务器选项页,需要刷新设置项显示
@@ -757,6 +831,11 @@ Public Class FormMain
'正在主页,需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False)
End If
ElseIf Str.StartsWith("file:///") Then
'文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True
FileDrag(New List(Of String) From {FilePath})
End If
Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
@@ -764,107 +843,118 @@ Public Class FormMain
End Try
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
'获取文件并检查
Dim FilePathList As New List(Of String)(CType(e.Data.GetData(DataFormats.FileDrop), Array))
e.Handled = True
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Dim FilePathRaw = e.Data.GetData(DataFormats.FileDrop)
If FilePathRaw Is Nothing Then '#2690
Hint("请将文件解压后再拖入!", HintType.Critical)
Exit Sub
End If
'多文件拖拽
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
Dim Extension As String = File.Split(".").Last.ToLower
If Not {"jar", "litemod", "disabled"}.Contains(Extension) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub
End If
Next
End If
'实际执行事件
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath, LogLevel.Developer)
RunInNewThread(Sub()
Dim Extension As String = FilePath.Split(".").Last.ToLower
'自定义主页
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Exit Sub
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi(Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
End Sub)
Exit Sub
End If
'Mod 安装
If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
'正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
Try
For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
'刷新列表
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
End Try
End If
Exit Sub
End If
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
Exit Sub
End If
'错误报告分析
Try
Log("[System] 尝试进行错误报告分析")
Dim Analyzer As New CrashAnalyzer(GetUuid())
Analyzer.Import(FilePath)
If Analyzer.Prepare() = 0 Then Exit Try
Analyzer.Analyze()
Analyzer.Output(True, New List(Of String))
Exit Sub
Catch ex As Exception
Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
End Try
'未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……")
End Sub, "文件拖拽")
e.Handled = True
FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If
Catch ex As Exception
Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
End Try
End Sub
Private Sub FileDrag(FilePathList As IEnumerable(Of String))
RunInNewThread(
Sub()
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Exit Sub
ElseIf Not File.Exists(FilePathList.First) Then
Hint("拖入的文件不存在:" & FilePathList.First, HintType.Critical)
Exit Sub
End If
'多文件拖拽
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.Split(".").Last.ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub
End If
Next
End If
'自定义主页
Dim Extension As String = FilePath.Split(".").Last.ToLower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Exit Sub
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi(Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Finish)
End Sub)
Exit Sub
End If
'Mod 安装
If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
'正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
Try
For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
'刷新列表
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
End Try
End If
Exit Sub
End If
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
Exit Sub
End If
'错误报告分析
Try
Log("[System] 尝试进行错误报告分析")
Dim Analyzer As New CrashAnalyzer(GetUuid())
Analyzer.Import(FilePath)
If Analyzer.Prepare() = 0 Then Exit Try
Analyzer.Analyze()
Analyzer.Output(True, New List(Of String))
Exit Sub
Catch ex As Exception
Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
End Try
'未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……")
End Sub, "文件拖拽")
End Sub
'接受到 Windows 窗体事件
Public IsSystemTimeChanged As Boolean = False
@@ -896,7 +986,7 @@ Install:
Get
Return _Hidden
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
If _Hidden = value Then Exit Property
_Hidden = value
If value Then
@@ -943,6 +1033,7 @@ Install:
#Region "切换页面"
'页面种类与属性
'注意,这一枚举在 “切换页面” EventType 中调用,应视作公开 API 的一部分
''' <summary>
''' 页面种类。
''' </summary>
@@ -950,43 +1041,43 @@ Install:
''' <summary>
''' 启动。
''' </summary>
Launch
Launch = 0
''' <summary>
''' 下载。
''' </summary>
Download
Download = 1
''' <summary>
''' 联机。
''' </summary>
Link
Link = 2
''' <summary>
''' 设置。
''' </summary>
Setup
Setup = 3
''' <summary>
''' 更多。
''' </summary>
Other
Other = 4
''' <summary>
''' 版本选择。这是一个副页面。
''' </summary>
VersionSelect
VersionSelect = 5
''' <summary>
''' 下载管理。这是一个副页面。
''' </summary>
DownloadManager
DownloadManager = 6
''' <summary>
''' 版本设置。这是一个副页面。
''' </summary>
VersionSetup
VersionSetup = 7
''' <summary>
''' 资源工程详情。这是一个副页面。
''' </summary>
CompDetail
CompDetail = 8
''' <summary>
''' 帮助详情。这是一个副页面。
''' </summary>
HelpDetail
HelpDetail = 9
End Enum
''' <summary>
''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。
@@ -1030,28 +1121,18 @@ Install:
Case PageType.VersionSetup
Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
Case PageType.CompDetail
If Stack.Additional Is Nothing Then
Log("[Control] 资源工程详情页面未提供关键项", LogLevel.Feedback)
Return "未知页面"
Else
Dim Project As CompProject = Stack.Additional
Select Case Project.Type
Case CompType.Mod
Return "Mod 下载 - " & Project.TranslatedName
Case CompType.ModPack
Return "整合包下载 - " & Project.TranslatedName
Case Else 'CompType.ResourcePack
Return "资源包下载 - " & Project.TranslatedName
End Select
End If
Dim Project As CompProject = Stack.Additional(0)
Select Case Project.Type
Case CompType.Mod
Return "Mod 下载 - " & Project.TranslatedName
Case CompType.ModPack
Return "整合包下载 - " & Project.TranslatedName
Case Else 'CompType.ResourcePack
Return "资源包下载 - " & Project.TranslatedName
End Select
Case PageType.HelpDetail
If Stack.Additional Is Nothing Then
Log("[Control] 帮助详情页面未提供关键项", LogLevel.Msgbox)
Return "未知页面"
Else
Dim Entry As HelpEntry = Stack.Additional(0)
Return Entry.Title
End If
Dim Entry As HelpEntry = Stack.Additional(0)
Return Entry.Title
Case Else
Return ""
End Select
@@ -1075,6 +1156,10 @@ Install:
''' </summary>
Public PageCurrent As PageStackData = PageType.Launch
''' <summary>
''' 上一个主页面。
''' </summary>
Public PageLast As PageStackData = PageType.Launch
''' <summary>
''' 当前的子页面。
''' </summary>
Public ReadOnly Property PageCurrentSub As PageSubType
@@ -1252,6 +1337,7 @@ Install:
#End Region
#Region "实际更改页面框架 UI"
PageLast = PageCurrent
PageCurrent = Stack
Select Case Stack.Page
Case PageType.Launch '启动
@@ -1494,17 +1580,10 @@ Install:
Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 700)
End Function
Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
If PanMainRight.Child Is Nothing Then Return Nothing
Dim RightChild = CType(PanMainRight.Child, AdornerDecorator).Child
If RightChild Is Nothing Then
Return Nothing
ElseIf TypeOf RightChild Is MyScrollViewer Then
Return RightChild
ElseIf TypeOf RightChild Is Grid AndAlso TypeOf CType(RightChild, Grid).Children(0) Is MyScrollViewer Then
Return CType(RightChild, Grid).Children(0)
Else
Return Nothing
End If
If PanMainRight.Child Is Nothing OrElse TypeOf PanMainRight.Child IsNot MyPageRight Then Return Nothing
Dim Scroll = CType(PanMainRight.Child, MyPageRight).PanScroll
If Scroll Is Nothing OrElse Scroll.Visibility <> Visibility.Visible Then Return Nothing
Return Scroll
End Function
#End Region
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.8 KiB

After

Width:  |  Height:  |  Size: 3.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

@@ -577,10 +577,10 @@ Public Module ModAnimation
Public Class AniEaseLinear
Inherits AniEase
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1)
Return MathClamp(t, 0, 1)
End Function
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
Return MathRange(t1, 0, 1) - MathRange(t0, 0, 1)
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
End Function
End Class
@@ -595,7 +595,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1) ^ p
Return MathClamp(t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -608,7 +608,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return 1 - MathRange(1 - t, 0, 1) ^ p
Return 1 - MathClamp(1 - t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -636,7 +636,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
End Function
End Class
@@ -650,7 +650,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
End Function
End Class
@@ -694,7 +694,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 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 +708,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = 1 - MathRange(t, 0, 1)
t = 1 - MathClamp(t, 0, 1)
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -766,7 +766,7 @@ Public Module ModAnimation
''' <summary>
''' 开始动画执行。
''' </summary>
Public Sub AniStartRun()
Public Sub AniStart()
'初始化计时器
AniLastTick = GetTimeTick()
AniFPSTimer = AniLastTick
@@ -777,12 +777,12 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathRange(GetTimeTick() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathRange(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -904,7 +904,7 @@ NextAni:
Case AniTypeSub.Y
DeltaTop(Ani.Obj, Delta)
Case AniTypeSub.Opacity
Ani.Obj.Opacity = MathRange(Ani.Obj.Opacity + Delta, 0, 1)
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
Case AniTypeSub.Width
Dim Obj As FrameworkElement = Ani.Obj
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
+60 -47
View File
@@ -1,8 +1,8 @@
Imports System.IO.Compression
Imports System.Management
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports System.Windows.Markup
Imports Newtonsoft.Json
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.2." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.6.13" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.13." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 293 'Release
Public Const VersionCode As Integer = 313 'Release
#Else
Public Const VersionCode As Integer = 294 'Snapshot
Public Const VersionCode As Integer = 312 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -46,7 +46,7 @@ Public Module ModBase
''' <summary>
''' 程序内嵌图片文件夹路径,以“/”结尾。
''' </summary>
Public PathImage As String = "pack://application:,,,/images/"
Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
''' <summary>
''' 当前程序的语言。
''' </summary>
@@ -521,7 +521,6 @@ Public Module ModBase
''' 获取两数间的百分比。小数点精确到 6 位。
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double
Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误
End Function
@@ -535,7 +534,7 @@ Public Module ModBase
''' <summary>
''' 将数值限定在某个范围内。
''' </summary>
Public Function MathRange(value As Double, min As Double, max As Double) As Double
Public Function MathClamp(value As Double, min As Double, max As Double) As Double
Return Math.Max(min, Math.Min(max, value))
End Function
@@ -560,7 +559,7 @@ Public Module ModBase
''' <summary>
''' 重命名一个注册表子键。不可用于包含子键的子键。
''' </summary>
Public Sub RegRename(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String)
Public Sub RenameReg(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String)
If parentKey.GetSubKeyNames().Contains(newSubKeyName) Then parentKey.DeleteSubKeyTree(newSubKeyName, False)
Dim SourceKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(subKeyName)
If IsNothing(SourceKey) Then Exit Sub '没有目标项
@@ -1062,7 +1061,7 @@ Public Module ModBase
''' <summary>
''' 获取文件 MD5,若失败则返回空字符串。
''' </summary>
Public Function GetAuthMD5(FilePath As String) As String
Public Function GetFileMD5(FilePath As String) As String
Dim Retry As Boolean = False
Re:
Try
@@ -1091,7 +1090,7 @@ Re:
''' <summary>
''' 获取文件 SHA256,若失败则返回空字符串。
''' </summary>
Public Function GetAuthSHA256(FilePath As String) As String
Public Function GetFileSHA256(FilePath As String) As String
Dim Retry As Boolean = False
Re:
Try
@@ -1122,7 +1121,7 @@ Re:
''' <summary>
''' 获取文件 SHA1,若失败则返回空字符串。
''' </summary>
Public Function GetAuthSHA1(FilePath As String) As String
Public Function GetFileSHA1(FilePath As String) As String
Dim Retry As Boolean = False
Re:
Try
@@ -1210,11 +1209,11 @@ Re:
If MinSize >= 0 AndAlso MinSize > FileSize Then Return "文件大小应大于 " & MinSize & " B,实际为 " & FileSize & " B"
If Not String.IsNullOrEmpty(Hash) Then
If Hash.Length < 35 Then 'MD5
If Hash.ToLowerInvariant <> GetAuthMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetAuthMD5(LocalPath)
If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
ElseIf Hash.Length = 64 Then 'SHA256
If Hash.ToLowerInvariant <> GetAuthSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetAuthSHA256(LocalPath)
If Hash.ToLowerInvariant <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
Else 'SHA1 (40)
If Hash.ToLowerInvariant <> GetAuthSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetAuthSHA1(LocalPath)
If Hash.ToLowerInvariant <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
End If
End If
If IsJson Then
@@ -1242,23 +1241,7 @@ Re:
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".zip") OrElse CompressFilePath.EndsWith(".jar") OrElse CompressFilePath.EndsWith(".mrpack") Then
'以 zip 方式解压
Using stream As New FileStream(CompressFilePath, FileMode.Open)
Using archive As New ZipArchive(stream, ZipArchiveMode.Read, False, If(Encode, Encoding.GetEncoding("GB18030")))
For Each entry As ZipArchiveEntry In archive.Entries
Dim destinationPath As String = IO.Path.Combine(DestDirectory, entry.FullName)
If destinationPath.EndsWith("\") OrElse destinationPath.EndsWith("/") Then
Directory.CreateDirectory(destinationPath)
Else
If File.Exists(destinationPath) Then File.Delete(destinationPath)
entry.ExtractToFile(destinationPath, True)
End If
Next
End Using
End Using
Return True
ElseIf CompressFilePath.EndsWith(".gz") Then
If CompressFilePath.EndsWith(".gz") Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
@@ -1271,7 +1254,19 @@ Re:
stream.Close()
Return True
Else
Return False
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWith("\") OrElse DestinationPath.EndsWith("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
Return True
End If
Catch ex As Exception
Log(ex, "尝试解压文件失败")
@@ -1301,7 +1296,7 @@ Re:
Next
Temp = Directory.GetDirectories(Path)
For Each str As String In Temp
DeleteDirectory(str)
DeleteDirectory(str, IgnoreIssue)
Next
Try
Directory.Delete(Path, True)
@@ -1329,8 +1324,10 @@ Re:
''' <summary>
''' 遍历文件夹中的所有文件。
''' </summary>
Public Function EnumerateFiles(Directory As String) As List(Of FileInfo)
Return New DirectoryInfo(Directory).EnumerateFiles("*", SearchOption.AllDirectories).ToList
Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
Dim Info As New DirectoryInfo(Directory)
If Not Info.Exists Then Return New List(Of FileInfo)
Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
End Function
#End Region
@@ -1460,15 +1457,15 @@ Re:
ElseIf FileSize < 1024 * 1000 Then
'K 级
Dim RoundResult As String = Math.Round(FileSize / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " K"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " K"
ElseIf FileSize < 1024 * 1024 * 1000 Then
'M 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " M"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " M"
Else
'G 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " G"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " G"
End If
End Function
@@ -1578,19 +1575,19 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;")
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
''' <summary>
''' 搜索字符串中的所有正则匹配项。
''' </summary>
Public Function RegexSearch(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String)
Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String)
Try
RegexSearch = New List(Of String)
Dim RegexSearchRes = New RegularExpressions.Regex(regex, options).Matches(str)
Dim RegexSearchRes = New Regex(regex, options).Matches(str)
If RegexSearchRes Is Nothing Then Return RegexSearch
For Each item As RegularExpressions.Match In RegexSearchRes
For Each item As Match In RegexSearchRes
RegexSearch.Add(item.Value)
Next
Catch ex As Exception
@@ -1601,7 +1598,7 @@ Re:
''' <summary>
''' 获取字符串中的第一个正则匹配项,若无匹配则返回 Nothing。
''' </summary>
Public Function RegexSeek(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As String
Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
Try
Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value
Return If(Result = "", Nothing, Result)
@@ -1613,7 +1610,7 @@ Re:
''' <summary>
''' 检查字符串是否匹配某正则模式。
''' </summary>
Public Function RegexCheck(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As Boolean
Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As Boolean
Try
Return RegularExpressions.Regex.IsMatch(str, regex, options)
Catch ex As Exception
@@ -1624,7 +1621,13 @@ Re:
''' <summary>
''' 进行正则替换,会抛出错误。
''' </summary>
Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As String
Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
End Function
''' <summary>
''' 对每个正则匹配分别进行替换,会抛出错误。
''' </summary>
Public Function RegexReplaceEach(Input As String, Replacement As MatchEvaluator, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
End Function
@@ -1816,7 +1819,7 @@ NextElement:
''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
''' </summary>
Public Function GetTimeNow() As String
Return Date.Now.ToString("HH:mm:ss.fff")
Return Date.Now.ToString("HH':'mm':'ss'.'fff")
End Function
''' <summary>
''' 获取系统运行时间(毫秒),保证为正 Long 且大于 1,但可能突变减小。
@@ -2319,6 +2322,16 @@ Retry:
Return Thread.CurrentThread.ManagedThreadId = UiThreadId
End Function
''' <summary>
''' 检查某个控件是否位于主窗口可视区域内,且控件本身可见。
''' </summary>
<Extension> Public Function IsVisibleInForm(element As FrameworkElement) As Boolean
If Not element.IsVisible Then Return False
Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight))
Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight)
Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
End Function
#End Region
#Region "Debug"
@@ -153,10 +153,14 @@
End Select
End Get
Set(value As Double)
If _Progress = value Then Exit Property
Dim OldValue = _Progress
_Progress = value
RaiseEvent ProgressChanged(value, OldValue)
End Set
End Property
Private _Progress As Double = -1
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
''' <summary>
''' 计算总进度时的权重。它应该为预计时间(秒)。
''' </summary>
@@ -236,12 +240,16 @@
''' </summary>
Public ReadOnly Property IsAborted As Boolean
Get
Return LastRunningThread Is Nothing OrElse
Not ReferenceEquals(Thread.CurrentThread, LastRunningThread) OrElse
State = LoadState.Aborted
Return IsAbortedWithThread(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
End Function
''' <summary>
''' 在输入相同时使用原有结果的超时,单位为毫秒。
''' </summary>
Public ReloadTimeout As Integer = -1
@@ -437,10 +445,6 @@
For Each Loader In Loaders
Loader.Abort()
Next
'从列表删除
SyncLock LoaderTaskbarLock
If LoaderTaskbar.Contains(Me) Then LoaderTaskbar.Remove(Me)
End SyncLock
End Sub)
End Sub
@@ -571,6 +575,7 @@ Restart:
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
End Sub
Public Sub LoaderTaskbarProgressRefresh()
@@ -585,16 +590,13 @@ Restart:
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
Dim RemovedTask As New List(Of LoaderBase)
For i = 0 To LoaderTaskbar.Count - 1
If (IsAllDownloadTaskCompleted OrElse LoaderTaskbar(i).State = LoadState.Aborted) AndAlso LoaderTaskbar(i).Show Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(LoaderTaskbar(i))
RemovedTask.Add(LoaderTaskbar(i))
For Each Task In LoaderTaskbar.ToList()
If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
For Each Task In RemovedTask
LoaderTaskbar.Remove(Task)
Next
End SyncLock
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
@@ -625,13 +627,14 @@ Restart:
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
Total += LoaderTaskbar(i).Progress
For Each Task In LoaderTaskbar.ToList
If Not Task.Show Then Continue For
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathRange(Total / Count, 0, 1)
Return MathClamp(Total / Count, 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
+19 -24
View File
@@ -106,15 +106,15 @@ Retry:
Retry:
Select Case RetryCount
Case 0 '正常尝试
Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept)
Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
Else
Throw RetryException
End If
@@ -148,7 +148,7 @@ Retry:
For i = 1 To 4
Dim th As New Thread(Sub()
Try
RequestResult = NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept)
Catch ex As Exception
FailCount += 1
RequestEx = ex
@@ -182,10 +182,10 @@ RequestFinished:
Loop
Throw New Exception("未知错误")
End Function
Private Function NetGetCodeRequest(Url As String, Encode As Encoding, Timeout As Integer, IsJson As Boolean, Accept As String)
Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "")
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url)
Log("[Net] 获取网络结果:" & Url & ",最大超时 " & Timeout)
Log($"[Net] 获取网络结果:{Url},超时 {Timeout}ms{If(IsJson, ",要求 json", "")}")
Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte)
Try
@@ -269,8 +269,11 @@ RequestFinished:
'下载
Using Client As New WebClient
Try
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
Client.DownloadFile(Url, LocalFile)
Catch ex As Exception
File.Delete(LocalFile)
Throw New WebException("直接下载文件失败(" & Url & ")。", ex)
End Try
End Using
@@ -328,7 +331,7 @@ Retry:
''' <summary>
''' 同时发送多个网络请求并要求返回内容。
''' </summary>
Public Function NetRequestMuity(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing
@@ -1204,7 +1207,7 @@ SourceBreak:
Info.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
(Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
@@ -1276,14 +1279,6 @@ Wrong:
Try
Retry:
SyncLock LockChain
''大小检测
'If DownloadDone <> FileSize AndAlso Not IsUnknownSize Then
' For Each Th As NetThread In Threads
' Log("[Download] " & "File size detail: ")
' Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
' Next
' Throw New Exception("文件大小应为 " & FileSize & " B,实际下载为 " & DownloadDone & " B。")
'End If
If ModeDebug Then Log("[Download] " & LocalName & ":正在合并文件")
'创建文件夹
If File.Exists(LocalPath) Then File.Delete(LocalPath)
@@ -1297,7 +1292,7 @@ Retry:
AddWriter.Write(SmailFileCache.ToArray)
AddWriter.Dispose() : AddWriter = Nothing
MergeFile.Dispose() : MergeFile = Nothing
ElseIf Threads.DownloadDone = DownloadDone Then
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件,直接复制
CopyFile(Threads.Temp, LocalPath)
Else
@@ -1305,7 +1300,7 @@ Retry:
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 Then Continue For
If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
Dim TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(fs.Length))
@@ -1326,9 +1321,9 @@ Retry:
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log("[Download] " & "File size detail of " & Uuid & "# :")
Log("[Download] " & Uuid & "# 的下载线程细节:")
For Each Th As NetThread In Threads
Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone)
Log("[Download] " & Th.Uuid & "#,状态 " & GetStringFromEnum(CType(Th.State, [Enum])) & ",字节范围 " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ",字节剩余 " & Th.DownloadUndone)
Next
Throw New Exception(CheckResult)
End If
@@ -1868,9 +1863,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
@@ -1925,9 +1920,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
+14 -31
View File
@@ -28,7 +28,7 @@ Public Class MyBitmap
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim bitmapData = Bitmap.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)
@@ -54,6 +54,7 @@ Public Class MyBitmap
End Sub
Public Sub New(FilePathOrResourceName As String)
Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
@@ -73,10 +74,10 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, "加载位图失败(" & FilePathOrResourceName & ")")
Log(ex, $"加载位图失败({FilePathOrResourceName})")
Throw
Else
Log(ex, "指定类型有误的位图加载(" & FilePathOrResourceName & ")", LogLevel.Developer)
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try
End If
End Try
@@ -104,45 +105,27 @@ Public Class MyBitmap
End Using
End Sub
''' <summary>
''' 获取旋转的图片,这个方法不会导致原对象改变且会返回一个新的对象。图片长宽必须相等。
''' </summary>
''' <param name="angle">旋转角度(单位为角度)。</param>
Public Function Rotation(angle As Double) As System.Drawing.Bitmap
Dim img As System.Drawing.Image = Me.Pic
Dim bitSize As Single = img.Width
Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize), img.PixelFormat)
bmp.SetResolution(img.HorizontalResolution, img.VerticalResolution)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.NearestNeighbor
g.TranslateTransform(bitSize / 2, bitSize / 2)
g.RotateTransform(angle)
g.TranslateTransform(-bitSize / 2, -bitSize / 2)
g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width))
End Using
Return bmp
End Function
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap
Dim img As System.Drawing.Image = Pic
Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height, img.PixelFormat)
bmp.SetResolution(img.HorizontalResolution, img.VerticalResolution)
Public Function Clip(X As Integer, Y As Integer, Width As Integer, Height As Integer) As MyBitmap
Dim bmp As New System.Drawing.Bitmap(Width, Height, Pic.PixelFormat)
bmp.SetResolution(Pic.HorizontalResolution, Pic.VerticalResolution)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.NearestNeighbor
g.DrawImageUnscaled(img, rect.X, rect.Y)
g.TranslateTransform(-X, -Y)
g.DrawImage(Pic, New System.Drawing.Rectangle(0, 0, Pic.Width, Pic.Height))
End Using
Return bmp
End Function
''' <summary>
''' 获取左右翻转的图片,这个方法不会导致原对象改变。
''' 获取旋转或翻转后的图片,这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function LeftRightFilp() As System.Drawing.Bitmap
Public Function RotateFlip(Type As System.Drawing.RotateFlipType) As MyBitmap
Dim bmp As New System.Drawing.Bitmap(Pic)
bmp.RotateFlip(System.Drawing.RotateFlipType.RotateNoneFlipX)
bmp.SetResolution(Pic.HorizontalResolution, Pic.VerticalResolution)
bmp.RotateFlip(Type)
Return bmp
End Function
@@ -152,7 +135,7 @@ Public Class MyBitmap
Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream = New System.IO.FileStream(FilePath, FileMode.Create)
Using fileStream As New FileStream(FilePath, FileMode.Create)
encoder.Save(fileStream)
End Using
End Sub
@@ -4,15 +4,15 @@
''' <summary>
''' Mod。
''' </summary>
[Mod]
[Mod] = 0
''' <summary>
''' 整合包。
''' </summary>
ModPack
ModPack = 1
''' <summary>
''' 资源包。
''' </summary>
ResourcePack
ResourcePack = 2
End Enum
Public Enum CompModLoaderType
'https://docs.curseforge.com/?http#tocS_ModLoaderType
@@ -20,6 +20,7 @@
Forge = 1
Fabric = 4
Quilt = 5
NeoForge = 6
End Enum
<Flags> Public Enum CompSourceType
CurseForge = 1
@@ -164,7 +165,7 @@
''' <summary>
''' Logo 图片的下载地址。若为 Nothing 则没有。
''' </summary>
Public ReadOnly LogoUrl As String = Nothing
Public LogoUrl As String = Nothing
''' <summary>
''' 游戏大版本列表。例如:18, 16, 15……
''' </summary>
@@ -221,191 +222,249 @@
''' 从工程 Json 中初始化实例。若出错会抛出异常。
''' </summary>
Public Sub New(Data As JObject)
FromCurseForge = Data.ContainsKey("gameId")
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")
'Logo
If Data("logo").Count > 0 Then
If GetPixelSize(1) > 1.25 Then
LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标
Else
LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标
End If
End If
'FileIndexes / GameVersions
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
Where(Function(i) i("gameVersion").ToString.Contains("1."))
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).ToList
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
ElseIf Website.Contains("/modpacks/") Then
Type = CompType.ModPack
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
Type = CompType.ResourcePack
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
'Tags
Tags = New List(Of String)
For Each Category In Data("categories").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("大型")
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
#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
GameVersions = If(CType(Data("versions"), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
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 LogoUrl = Data("logo")("thumbnailUrl")
'FileIndexes / GameVersions
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
Where(Function(i) i("gameVersion").ToString.Contains("1."))
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "mod" : Type = CompType.Mod
Case "modpack" : Type = CompType.ModPack
Case "resourcepack" : Type = CompType.ResourcePack
End Select
'Tags & ModLoaders
Tags = New List(Of String)
ModLoaders = New List(Of CompModLoaderType)
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)
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
ElseIf Website.Contains("/modpacks/") Then
Type = CompType.ModPack
Else
Type = CompType.ResourcePack
End If
'Tags
Tags = New List(Of String)
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪")
Case "game-mechanics" : Tags.Add("游戏机制")
Case "transportation" : Tags.Add("运输")
Case "storage" : Tags.Add("仓储")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "decoration" : Tags.Add("装饰")
Case "mobs" : Tags.Add("生物")
Case "equipment" : Tags.Add("装备")
Case "optimization" : Tags.Add("性能优化")
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
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 "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
Case "combat" : Tags.Add("战斗")
Case "quests" : Tags.Add("任务")
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪")
Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
ModLoaders.Sort()
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("大型")
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
#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.StartsWith("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "mod" : Type = CompType.Mod
Case "modpack" : Type = CompType.ModPack
Case "resourcepack" : Type = CompType.ResourcePack
End Select
'Tags & ModLoaders
Tags = New List(Of String)
ModLoaders = New List(Of CompModLoaderType)
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)
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪")
Case "game-mechanics" : Tags.Add("游戏机制")
Case "transportation" : Tags.Add("运输")
Case "storage" : Tags.Add("仓储")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "decoration" : Tags.Add("装饰")
Case "mobs" : Tags.Add("生物")
Case "equipment" : Tags.Add("装备")
Case "optimization" : Tags.Add("性能优化")
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
Case "combat" : Tags.Add("战斗")
Case "quests" : Tags.Add("任务")
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪")
Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
Tags.Sort()
ModLoaders.Sort()
#End Region
End If
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.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
''' <summary>
''' 将当前工程信息实例化为控件。
''' </summary>
Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCompItem.ClickEventHandler = Nothing) As MyCompItem
Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyCompItem
'获取版本描述
Dim GameVersionDescription As String
If GameVersions Is Nothing OrElse GameVersions.Count = 0 Then
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
GameVersionDescription = "未知"
Else
Dim SpaVersions As New List(Of String)
For i = 0 To GameVersions.Count - 1
Dim IsOld As Boolean = False
For i = 0 To GameVersions.Count - 1 '版本号一定为降序
'获取当前连续的版本号段
Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
For ii = i + 1 To GameVersions.Count - 1
If GameVersions(ii) = EndVersion - 1 Then
EndVersion = GameVersions(ii)
i = ii
Else
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
SpaVersions.Add("1." & EndVersion & "+")
ElseIf EndVersion <= 7 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
@@ -416,75 +475,39 @@
Next
GameVersionDescription = SpaVersions.Join(", ")
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Select Case ModLoaders.Count
Case 0
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
Case 1
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Case 2, 3
If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
ModLoaderDescriptionFull = ModLoaders.Join(" / ")
ModLoaderDescriptionPart = ModLoaders.Join(" / ")
End If
Case Else
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
End Select
'实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me}
'整理 FinalName 与 ExNameList
'检查下列代码时可以参考 #1567 的测试例
Dim FinalName As String
Dim ExNameList As List(Of String)
If TranslatedName = RawName Then
'没有中文翻译
FinalName = TranslatedName.Split(" | ").First.Split(" - ").First.Split("(").First.Split("[").First
ExNameList = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
ExNameList.RemoveAt(0)
If Not ExNameList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版
Not (ExNameList.Count = 1 AndAlso ExNameList.First.ToUpper = ExNameList.First) Then '不是缩写
FinalName = RawName '使用原名
ExNameList.Clear()
End If
Else
'有中文翻译
'尝试将文本分为三段:FinalName (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix
FinalName = TranslatedName.Split(" (").First.Split(" - ").First
Dim Suffix As String = ""
If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last
Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(FinalName, "").Trim("("c, ")"c, " "c)
'中段的额外信息截取
ExNameList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If ExNameList.Count > 1 AndAlso
Not ExNameList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版
Not (ExNameList.Count = 2 AndAlso ExNameList.Last.ToUpper = ExNameList.Last) Then '不是缩写
ExNameList = New List(Of String) From {EnglishName} '使用原名
End If
'添加后缀
If Suffix <> "" Then
ExNameList.Add(Suffix)
ExNameList = ExNameList.Distinct().ToList()
End If
End If
'显示 FinalName 与 ExNameList
NewItem.LabTitle.Text = FinalName
If ExNameList.Count = 0 Then
NoExName:
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
Dim ExName As String = ""
For Each Ex In ExNameList
'去除 “Forge/Fabric” 这一无意义提示
If Ex.Length < 19 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For
'将 “Forge” 等提示改为 “Forge 版”
If (Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")) AndAlso
Not Ex.Contains("版") AndAlso Ex.Length < 19 Then Ex = Ex.Replace("Edition", "").Trim.Capitalize & " 版"
ExName &= " | " & Ex.Trim
Next
If ExName = "" Then GoTo NoExName
NewItem.LabTitleRaw.Text = ExName
NewItem.SubTitle = Title.Value
End If
'Tag
For Each TagText In Tags
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
NewItem.PanTags.Children.Add(NewTag)
Next
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
@@ -495,39 +518,14 @@ NoExName:
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowMcVersionDesc Then
'全部显示
Dim ModLoaderDesc As String = If(ModLoaders.Count > 0 AndAlso ModLoaders.Count < 3 AndAlso
Not (Type = CompType.Mod AndAlso Setup.Get("ToolDownloadIgnoreQuilt") AndAlso ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
ModLoaders.Join(" / ") & " ", "")
Dim VersionDesc As String = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
NewItem.LabVersion.Text = ModLoaderDesc & VersionDesc
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
Select Case ModLoaders.Count
Case 0
NewItem.LabVersion.Text = "未知"
Case 1
NewItem.LabVersion.Text = If(Type = CompType.Mod, "仅 ", "") & ModLoaders(0).ToString
Case 2
If Type = CompType.Mod Then
NewItem.LabVersion.Text =
If(Not (Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
ModLoaders.Join(" / "), "任意")
Else
NewItem.LabVersion.Text = ModLoaders.Join(" / ")
End If
Case 3
If Type = CompType.Mod Then
NewItem.LabVersion.Text = "任意"
Else
NewItem.LabVersion.Text = ModLoaders.Join(" / ")
End If
End Select
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
@@ -540,20 +538,93 @@ NoExName:
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
'其他
If LogoUrl Is Nothing Then
NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
Else
NewItem.Logo = LogoUrl
End If
If OnClick IsNot Nothing Then
AddHandler NewItem.Click, OnClick
NewItem.HasAnimation = True
Else
NewItem.HasAnimation = False
End If
Return NewItem
End Function
Public Function GetControlLogo() As String
If LogoUrl Is Nothing 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 NormalNameList.Count = 0 OrElse SubtitleList.Count = 0 Then GoTo NoSubtitle
'同时包含 NormalName 和 Subtitle
Title = NormalNameList.Join(" - ")
Else
'有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix
Title = TranslatedName.Split(" (").First.Split(" - ").First
Dim Suffix As String = ""
If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last
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.Count > 0 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
'辅助函数
@@ -746,6 +817,10 @@ NoExName:
''' 可供展示的所有工程的列表。
''' </summary>
Public Results As New List(Of CompProject)
''' <summary>
''' 当前的错误信息。如果没有则为 Nothing。
''' </summary>
Public ErrorMessage As String = Nothing
End Class
@@ -755,7 +830,7 @@ NoExName:
''' <summary>
''' 已知工程信息的缓存。
''' </summary>
Private CompProjectCache As New Dictionary(Of String, CompProject)
Public CompProjectCache As New Dictionary(Of String, CompProject)
''' <summary>
''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。
''' </summary>
@@ -872,6 +947,7 @@ Retry:
'启动 CurseForge 线程
Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress()
Dim CurseForgeFailed As Boolean = False
If CurseForgeUrl IsNot Nothing Then
CurseForgeThread = RunInNewThread(
Sub()
@@ -895,12 +971,14 @@ Retry:
Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = 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()
@@ -914,7 +992,10 @@ Retry:
Next
'更新结果
SyncLock ResultsLock
RawResults.AddRange(ProjectList)
For Each Project In ProjectList
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
RawResults.Add(Project)
Next
End SyncLock
Storage.ModrinthOffset += ProjectList.Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
@@ -923,6 +1004,7 @@ Retry:
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
End Try
End Sub, "Modrinth Project Request")
End If
@@ -933,7 +1015,8 @@ Retry:
If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
If Task.IsAborted Then Exit Sub
'确认存在结果
'确保存在结果
Storage.ErrorMessage = Nothing
If RawResults.Count = 0 Then
If [Error] IsNot Nothing Then
Throw [Error]
@@ -948,6 +1031,13 @@ Retry:
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
@@ -969,7 +1059,7 @@ Retry:
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
'加入列表
RealResults.AddRange(RawResults)
Log($"[Comp] 去重后累计新增结果 {RealResults.Count} 个")
Log($"[Comp] 去重、筛选后累计新增结果 {RealResults.Count} 个")
#End Region
@@ -1142,7 +1232,7 @@ Retry:
FileName = Data("fileName")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = "https://media.forgecdn.net/files/" & Id.ToString.Substring(0, 4) & "/" & Id.ToString.Substring(4).TrimStart("0") & "/" & FileName
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)) '对文件名进行编码
DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
@@ -1171,6 +1261,7 @@ Retry:
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"
@@ -1195,13 +1286,13 @@ Retry:
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.StartsWith("1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
'无需处理
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
@@ -1248,11 +1339,11 @@ Retry:
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
@@ -1264,7 +1355,6 @@ Retry:
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
NewItem.PaddingRight = 35
End If
'结束
@@ -1353,7 +1443,7 @@ Retry:
''' <summary>
''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置 Mod 列表。
''' </summary>
Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile), OnClick As MyListItem.ClickEventHandler)
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()
@@ -1367,7 +1457,7 @@ Retry:
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置 Mod 列表
For Each Dep In Deps
Dim Item = CompProjectCache(Dep).ToCompItem(False, False, AddressOf FrmDownloadMod.ProjectClick)
Dim Item = CompProjectCache(Dep).ToCompItem(False, False)
Stack.Children.Add(Item)
Next
'添加结尾间隔
@@ -127,7 +127,7 @@
End Try
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
@@ -137,6 +137,8 @@
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
Else
File.Delete(TargetFile.FullName)
End If
Catch ex As Exception
Log(ex, "导入单个日志文件失败")
@@ -165,37 +167,37 @@
DirectFile = Nothing
Dim TotalFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim FileName As String = GetFileNameFromPath(LogFile.Key)
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
If FileName.StartsWith("hs_err") Then
If MatchName.StartsWith("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
ElseIf FileName.StartsWith("crash-") Then
ElseIf MatchName.StartsWith("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
ElseIf FileName = "latest.log" OrElse FileName = "latest log.txt" OrElse
FileName = "debug.log" OrElse FileName = "debug log.txt" OrElse
FileName = "游戏崩溃前的输出.txt" OrElse FileName = "rawoutput.log" Then
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
MatchName = "debug.log" OrElse MatchName = "debug log.txt" OrElse
MatchName = "游戏崩溃前的输出.txt" OrElse MatchName = "rawoutput.log" Then
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "PCL 启动器日志.txt" OrElse FileName = "log1.txt" Then
ElseIf MatchName = "启动器日志.txt" OrElse MatchName = "PCL2 启动器日志.txt" OrElse MatchName = "PCL 启动器日志.txt" OrElse MatchName = "log1.txt" Then
If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
Else
TargetType = AnalyzeFileType.ExtraLog
End If
ElseIf FileName.EndsWith(".log") OrElse FileName.EndsWith(".txt") Then
ElseIf MatchName.EndsWith(".log") OrElse MatchName.EndsWith(".txt") Then
TargetType = AnalyzeFileType.ExtraLog
Else
Log("[Crash] " & FileName & " 分类为 Ignore")
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If LogFile.Value.Count = 0 Then
Log("[Crash] " & FileName & " 由于内容为空跳过")
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & FileName & " 分类为 " & GetStringFromEnum(TargetType))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType))
End If
Next
@@ -235,6 +237,7 @@
End If
Case AnalyzeFileType.MinecraftLog
LogMc = ""
LogMcDebug = ""
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
@@ -272,11 +275,21 @@
Exit For
End If
Next
'查找 Debug Log
For Each FileName As String In {"debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft Debug 日志")
Exit For
End If
Next
'检查错误
If LogMc = "" Then
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
End If
If LogMcDebug = "" Then LogMcDebug = Nothing
Case AnalyzeFileType.ExtraLog
'全部丢过去
For Each SelectedFile In SelectedFiles
@@ -294,7 +307,7 @@
If ResultCount = 0 Then
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
Else
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
End If
Return ResultCount
@@ -315,7 +328,7 @@
End Function
'3:根据文本分析崩溃原因
Private LogMc As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing
Private LogMc As String = Nothing, LogMcDebug As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing
Private LogAll As String
'可能导致崩溃的原因与附加信息
Private CrashReasons As New Dictionary(Of CrashReason, List(Of String))
@@ -324,6 +337,7 @@
''' </summary>
Private Enum CrashReason
Mod文件被解压
MixinBootstrap缺失
内存不足
使用JDK
显卡不支持OpenGL
@@ -344,9 +358,8 @@
ModMixin失败
Mod加载器报错
Mod初始化失败
崩溃日志堆栈分析发现关键字
崩溃日志堆栈分析发现Mod名称
MC日志堆栈分析发现关键字
堆栈分析发现关键字
堆栈分析发现Mod名称
OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
特定方块导致崩溃
特定实体导致崩溃
@@ -364,56 +377,63 @@
NightConfig的Bug
ShadersMod与Optifine同时安装
Forge安装不完整
Mod需要Java11
Mod缺少前置或MC版本错误
End Enum
''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = (If(LogMc, "") & If(LogHs, "") & If(LogCrash, "")).ToLower
LogAll = (If(LogMc, "") & If(LogMcDebug, "") & If(LogHs, "") & If(LogCrash, ""))
'1. 精准日志匹配 1
'1. 精准日志匹配,中/高优先级
AnalyzeCrit1()
If CrashReasons.Count > 0 Then GoTo Done
AnalyzeCrit2()
If CrashReasons.Count > 0 Then GoTo Done
'2. 堆栈分析
If LogAll.Contains("forge") OrElse LogAll.Contains("fabric") OrElse LogAll.Contains("liteloader") Then
'来源崩溃日志的分析
If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then
Dim Keywords As New List(Of String)
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Dim StackLogs As String = LogCrash.Split("System Details").First
Dim Keywords = AnalyzeStackKeyword(StackLogs)
If Keywords.Count > 0 Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.崩溃日志堆栈分析发现关键字, Keywords)
Else
AppendReason(CrashReason.崩溃日志堆栈分析发现Mod名称, Names)
End If
GoTo Done
End If
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'来自 Minecraft 日志的分析
'Minecraft 日志
If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项")
If Fatals.Count > 0 Then
Dim Keywords As New List(Of String)
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
If Keywords.Count > 0 Then
AppendReason(CrashReason.MC日志堆栈分析发现关键字, Keywords.Distinct.ToList)
GoTo Done
End If
End If
End If
'虚拟机日志
If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Split("Registers:").First.Split("T H R E A D").Last
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'Mod 名称分析
If Keywords.Count > 0 Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.堆栈分析发现关键字, Keywords)
Else
AppendReason(CrashReason.堆栈分析发现Mod名称, Names)
End If
GoTo Done
End If
Else
Log("[Crash] 可能并未安装 Mod,不进行堆栈分析")
End If
'3. 精准日志匹配 2
AnalyzeCrit2()
'3. 精准日志匹配,低优先级
AnalyzeCrit3()
'输出到日志
Done:
@@ -468,11 +488,12 @@ Done:
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>(net.minecraft.resources.ResourceLocation, ") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>(int[], int, net.minecraft.core.Direction, net.minecraft.client.renderer.texture.TextureAtlasSprite, boolean, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.addRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.removeRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'net.minecraft.network.chat.FormattedText net.minecraft.client.gui.Font.ellipsize(net.minecraft.network.chat.FormattedText, int)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'java.lang.String com.mojang.blaze3d.systems.RenderSystem.getBackendDescription") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraftforge.client.gui.overlay.ForgeGui.renderSelectedItemName") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'net.minecraft.network.chat.FormattedText net.minecraft.client.gui.Font.ellipsize") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("java.lang.NoSuchFieldException: ucp") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
@@ -480,6 +501,7 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
@@ -492,7 +514,11 @@ Done:
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
If LogMc.Contains("java.lang.UnsupportedClassVersionError: net/fabricmc/loader/impl/launch/knot/KnotClient : Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.IllegalArgumentException: The requested compatibility level JAVA_11 could not be set. Level is not supported by the active JRE or ASM version") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("Invalid maximum heap size") Then AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
If LogMc.Contains("Could not reserve enough space") Then
If LogMc.Contains("for 1048576KB object heap") Then
AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
@@ -500,32 +526,17 @@ Done:
AppendReason(CrashReason.内存不足)
End If
End If
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复安装
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'Mod 导致的崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback )[^./ ]+(?=.mixins.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^\] ]+(?=\] from phase)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'仅当没有其他分析结果时显示
If CrashReasons.Count = 0 Then
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
'Mod 缺少前置
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
End If
End If
@@ -563,14 +574,45 @@ Done:
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' 进行精准日志匹配。匹配优先级高于堆栈分析的崩溃,但低于上面的。
''' 如果第一步已经找到了原因则不执行该检测。
''' </summary>
Private Sub AnalyzeCrit2()
'游戏日志分析
If LogMc IsNot Nothing Then
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso
LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit3()
'游戏日志分析
If LogMc IsNot Nothing Then
'Mixin 崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
'极短的程序输出
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc)
End If
'Mixin 失败可以导致大量 Mod 实例创建失败
@@ -599,7 +641,7 @@ Done:
'If Not Stack.Contains(".") Then Continue For
For Each IgnoreStack In {
"java", "sun", "javax", "jdk", "oolloo",
"org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"com.electronwill.nightconfig", "it.unimi.dsi",
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
@@ -622,11 +664,12 @@ NextStack:
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
"fastutil", "optifine", "scheduler", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity"
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules",
"fastutil", "optifine", "internal", "platform", "override",
"listeners", "scheduler", "minecraft", "transformers", "universal", "multipart", "minecraftforge", "blockentity"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -643,7 +686,7 @@ NextStack:
End Function
''' <summary>
''' 根据 Mod 关键词与详细信息(崩溃报告第二部分)与,获取实际的 Mod 名称。
''' 根据 Mod 关键词尝试获取实际的 Mod 名称。
''' 若失败则返回 Nothing。
''' </summary>
Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String)
@@ -658,60 +701,95 @@ NextStack:
Next
Keywords = RealKeywords
'获取崩溃报告对应部分
If LogCrash Is Nothing Then Return Nothing
If Not LogCrash.Contains("A detailed walkthrough of the error") Then Return Nothing
Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨")
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 检测到 Fabric Mod 信息格式")
End If
Details = Details.Split("¨").Last
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModName As String In HintLines
Log("[Crash] - " & ModName)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
'从崩溃报告获取 Mod 信息
If LogCrash IsNot Nothing AndAlso LogCrash.Contains("A detailed walkthrough of the error") Then
Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨")
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
ModFileNames = ModFileNames.Distinct.ToList
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Next
Details = Details.Split("¨").Last
Return If(ModFileNames.Count = 0, Nothing, ModFileNames)
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 崩溃报告中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
End If
'从 debug.log 获取 Mod 信息
If LogMcDebug IsNot Nothing Then
'Forge: Found valid mod file YungsBetterStrongholds-1.20-Forge-4.0.1.jar with {betterstrongholds} mods - versions {1.20-Forge-4.0.1}
Dim ModNameLines As List(Of String) = RegexSearch(LogMcDebug, "(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Log("[Crash] Debug 信息中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
If ModString.Contains($"{{{KeyWord}}}") Then HintLines.Add(ModString)
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] Debug 信息中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
Name = RegexSeek(Line, ".*(?= with)")
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
End If
'输出
ModFileNames = ModFileNames.Distinct.ToList
If ModFileNames.Count = 0 Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Next
Return ModFileNames
End If
End Function
''' <summary>
''' 尝试获取 Mod 名称,若失败则返回原关键字。
@@ -791,9 +869,7 @@ NextStack:
If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。"
Else
Return "很抱歉,你的游戏出现了一些问题……" & vbCrLf &
"如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf &
"你也可以查看错误报告,其中可能会有出错的原因。"
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请导出错误报告并发给他人,而不是发送这个窗口的截图。"
End If
End If
@@ -805,7 +881,7 @@ NextStack:
Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
Case CrashReason.内存不足
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是因为电脑内存不足、游戏分配的内存不足,或是配置要求过高。\n\n你可以尝试在 更多 → 百宝箱 中选择 内存优化,然后再启动游戏。\n如果还是不行,请在启动设置中增加为游戏分配的内存,并删除配置要求较高的材质、Mod、光影。\n如果依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Case CrashReason.使用OpenJ9
Results.Add("游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。")
Case CrashReason.使用JDK
@@ -816,19 +892,27 @@ NextStack:
Results.Add("游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。")
Case CrashReason.Mod名称包含特殊字符
Results.Add("由于有 Mod 的名称包含特殊字符,导致游戏崩溃。\n请尝试修改 Mod 文件名,让它只包含英文字母、数字、减号(-)、下划线(_)和小数点,然后再启动游戏。")
Case CrashReason.MixinBootstrap缺失
Results.Add("由于缺失 MixinBootstrap,导致游戏崩溃。\n请尝试安装 MixinBootstrap。若安装后依然崩溃,可以尝试在文件名前添加英文感叹号。")
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
Results.Add("你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。")
Results.Add("你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。")
Else
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
End If
Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Count > 0 Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If
Case CrashReason.崩溃日志堆栈分析发现Mod名称
Case CrashReason.堆栈分析发现Mod名称
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h")
Else
@@ -881,11 +965,13 @@ NextStack:
Case CrashReason.ShadersMod与Optifine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java")
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.Mod需要Java11
Results.Add("你所安装的部分 Mod 似乎需要使用 Java 11 启动。\n请在启动设置的 Java 选择一项中改用 Java 11,然后再启动游戏。\n如果你没有安装 Java 11,你可以从网络中下载、安装一个。")
Case CrashReason.极短的程序输出
Results.Add($"程序返回了以下信息:\n{Additional.First}\n\h")
Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
@@ -898,7 +984,7 @@ NextStack:
End If
Case CrashReason.材质过大或显卡配置不足
Results.Add("你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h")
Case CrashReason.材质过大或显卡配置不足
Case CrashReason.NightConfig的Bug
Results.Add("由于 Night Config 存在问题,导致了游戏崩溃。\n你可以尝试安装 Night Config Fixes 模组,这或许能解决此问题。\h")
Case CrashReason.光影或资源包导致OpenGL1282错误
Results.Add("你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h")
@@ -947,8 +1033,10 @@ NextStack:
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Results.Any(Function(r) r.EndsWith("\h")),
If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。"), "")
If(Not Results.Any(Function(r) r.EndsWith("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
End Function
End Class
@@ -19,14 +19,7 @@
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable Then
'是否跳过
Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
Case 0 '使用全局设置
Case 1 '开启
IsSetupSkip = False
Case 2 '关闭
IsSetupSkip = True
End Select
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
End If
@@ -52,7 +45,7 @@
If IndexUrl = "" Then
Return Nothing
Else
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl, False), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
End If
End Function
@@ -72,17 +65,7 @@
#End Region
#Region "下载资源文件"
Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
Case 0
'使用全局设置
Case 1
'开启
IsSetupSkip = False
Case 2
'关闭
IsSetupSkip = True
End Select
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
Dim LoadersAssets As New List(Of LoaderBase)
@@ -472,7 +455,7 @@
''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -610,7 +593,7 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -642,7 +625,7 @@
Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
0, DateTimeKind.Utc) '以 UTC 时间作为标准
Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy/MM/dd HH:mm") '时区与格式转换
Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm") '时区与格式转换
'分类与 MD5 获取
Dim MD5 As String, Category As String
If VersionCode.Contains("classifier-installer""") Then
@@ -723,7 +706,7 @@
'基础信息获取
Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name}
Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy/MM/dd HH:mm")
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
'添加项
Versions.Add(Entry)
Next
@@ -816,7 +799,7 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("http://dl.liteloader.com/versions/versions.json", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True)
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -829,7 +812,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
.JsonToken = RealEntry
})
Next
@@ -858,7 +841,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
.JsonToken = RealEntry
})
Next
@@ -960,34 +943,27 @@
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {MojangBase.Replace("https://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/assets").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/assets").Replace("https://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
MojangBase,
MojangBase.Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
}
End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String()
Return {MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"),
MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"),
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/maven").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/maven").Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"),
MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/libraries").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/libraries").Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"),
MojangBase,
MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String()
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
If IsStatic Then
Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
}
Else
Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
}
End If
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net").Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
}
End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 4
Public JavaListCacheVersion As Integer = 5
''' <summary>
''' 目前所有可用的 Java。
@@ -111,8 +111,9 @@
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
If Output = "" Then Throw New Exception("尝试运行该 Java 失败")
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
Do While VersionString.Split(".").Count < 4
@@ -122,6 +123,7 @@
VersionString = "1." & VersionString
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)
@@ -129,8 +131,12 @@
End If
Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New Exception("分析详细信息失败,获取的版本为 " & Version.ToString)
'无论如何不允许使用 JRE 16,它完全是炸的,安 OptiFine、Forge 和启动 MC 都会炸
If IsJre AndAlso VersionCode = 16 Then Throw New Exception("由于 JRE 16 对 Minecraft 的兼容性很差,因此不再允许使用")
'基于 #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)
@@ -182,7 +188,8 @@
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
JavaSearchLoader.Start(0)
Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java")
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java:")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}"))
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
@@ -201,7 +208,9 @@
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 Then JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
If PathMcFolder.Split("\").Count > 3 Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
@@ -209,6 +218,15 @@
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
'检查特定的 Java
If TargetJavaList.Count > 0 Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java:")
For Each Java In TargetJavaList
Log($"[Java] - {Java}")
Next
End If
#Region "添加用户指定的 Java,储存到 UserJava 中"
Dim UserJava As JavaEntry = Nothing
@@ -217,13 +235,9 @@
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
'确保版本独立设置中指定的 Java 在 Java 列表中(#978)
If Not JavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log("版本独立设置中指定的 Java 不在主 Java 列表中,此设置已重置", LogLevel.Debug)
Exit Try
End If
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
@@ -235,10 +249,13 @@
If UserJava Is Nothing 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)
Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
End If
@@ -250,12 +267,6 @@
#End Region
'检查特定的 Java
If TargetJavaList.Count > 0 Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定的 Java")
End If
RetryGet:
'等待进行中的搜索结束
If JavaSearchLoader.State <> LoadState.Finished AndAlso JavaSearchLoader.State <> LoadState.Waiting Then JavaSearchLoader.WaitForExit()
@@ -298,8 +309,9 @@ RetryGet:
'指定的 Java 不可用,弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString)
Log($"[Java] 目前实际可用的 Java 列表:")
For Each Java In AllowedJavaList
Log($"[Java] 实际可用的 Java:{Java.ToString}")
Log($"[Java] - {Java}")
Next
Dim Requirement As String = ""
Dim ShowRevision As Boolean = False
@@ -316,9 +328,9 @@ RetryGet:
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 Setup.Get("LaunchAdvanceJava") Then
If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then
'直接跳过弹窗
Hint("设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", HintType.Critical)
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf &
@@ -344,10 +356,12 @@ ExitUserJavaCheck:
'优先使用特定目录下的 Java
For Each Java In AllowedJavaList
'如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例
If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
Log("[Java] 优先使用特定的 Java:" & Java.ToString)
Log("[Java] 优先使用特定路径下的 Java:" & Java.ToString)
GoTo UserPass
End If
Next
@@ -355,6 +369,10 @@ UserPass:
'对适合的 Java 进行排序
AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序:")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
Next
'检查选定的 Java,若测试失败则尝试进行搜索
Dim SelectedJava = AllowedJavaList.First
@@ -364,14 +382,14 @@ UserPass:
Throw
Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso TypeOf (ex.InnerException) Is ThreadInterruptedException Then Throw ex.InnerException
Log(ex, "找到的 Java 已无法使用,尝试进行搜索")
Log(ex, "最终选定的 Java 已无法使用,尝试进行搜索")
AllowedJavaList = New List(Of JavaEntry)
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
End Try
'返回
Log("[Java] 选定的 Java:" & SelectedJava.ToString)
Log("[Java] 最终选定的 Java:" & AllowedJavaList.First.ToString)
Return SelectedJava
Catch ex As ThreadInterruptedException
@@ -442,7 +460,7 @@ NoUserJava:
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 31, 30, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
'5. 最次级版本号更接近 51
@@ -522,10 +540,10 @@ NoUserJava:
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Continue For
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
@@ -585,10 +603,11 @@ NoUserJava:
Dim CheckThread As New Thread(Sub()
Try
Entry.Check()
Log("[Java] " & Entry.ToString)
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)
@@ -645,7 +664,7 @@ Wait:
SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse
SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse
SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse
SearchEntry.Contains("software") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("soft") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse
SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse
SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse
@@ -661,7 +680,8 @@ Wait:
SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse
SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse
SearchEntry.Contains("version") OrElse SearchEntry.Contains("baka") OrElse SearchEntry.Contains("pcl") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127D64EC6") OrElse '官启文件夹
SearchEntry.Contains("zulu") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127d64ec6") OrElse '官启文件夹
SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名
SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then
JavaSearchFolder(FolderInfo, Results, Source)
@@ -680,18 +700,17 @@ Wait:
''' <summary>
''' 提示 Java 缺失,并弹窗确认是否自动下载。返回玩家选择是否下载。
''' 支持下载 Java 8、14、17,输入其他 VersionCode 会要求玩家自行下载。
''' </summary>
Public Function JavaDownloadConfirm(VersionCode As String) As Boolean
If VersionCode = 8 OrElse VersionCode = 14 OrElse VersionCode = 17 Then
Return MyMsgBox($"PCL 未找到 Java {VersionCode},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 Java {VersionCode},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
Else
MyMsgBox($"PCL 未找到 Java {VersionCode}。" & vbCrLf &
$"请自行搜索并安装 Java {VersionCode},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean
If ForcedManualDownload Then
MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
$"请自行搜索并安装 {VersionDescription},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
"未找到 Java")
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
End If
End Function
@@ -435,13 +435,7 @@ NextInner:
Case McLoginType.Ms
Loader = McLoginMsLoader
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
'使用 HiPer 内网验证
Loader = McLoginHiperLoader
Else
'默认的离线验证
Loader = McLoginLegacyLoader
End If
Loader = McLoginLegacyLoader
Case McLoginType.Nide
Loader = McLoginNideLoader
Case McLoginType.Auth
@@ -462,7 +456,6 @@ NextInner:
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginHiperLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login HiPer", AddressOf McLoginHiperStart) With {.ReloadTimeout = 60000}
'主加载函数,返回所有需要的登录信息
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
@@ -615,45 +608,6 @@ LoginFinish:
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
End Sub
Private Sub McLoginHiperStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
Dim Input As McLoginLegacy = Data.Input
McLaunchLog("登录方式:联机离线(" & Input.UserName & ")")
Data.Progress = 0.05
'尝试登录
Try
McLaunchLog("登录开始(Login, HiPer)")
Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:="http://hiperauth.tech/api/yggdrasil-hiper/authserver/authenticate",
Method:="POST",
Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" &
McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName) & """,""requestUser"":true}",
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
Data.Output.AccessToken = LoginJson("accessToken").ToString
Data.Output.ClientToken = LoginJson("clientToken").ToString
Data.Output.Name = LoginJson("selectedProfile")("name").ToString
Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
Data.Output.Type = "Auth"
McLaunchLog("登录成功(Login, HiPer)")
'保存启动记录
Dim Names As New List(Of String)
If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(Input.UserName)
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Dim ThrowEx As Exception = ex
If AllMessage.Contains("403") Then
ThrowEx = New Exception("登录尝试过于频繁,导致被系统暂时屏蔽。请不要操作,等待 10 分钟后再试。", ex)
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
ThrowEx = New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好,或选择其他登录方式!")
End If
McLaunchLog("登录失败:" & GetExceptionSummary(ThrowEx))
Throw ThrowEx
End Try
End Sub
'Server 登录:三种验证方式的请求
Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -664,11 +618,13 @@ LoginFinish:
Dim Uuid As String = Setup.Get("Cache" & Data.Input.Token & "Uuid")
Dim Name As String = Setup.Get("Cache" & Data.Input.Token & "Name")
'发送登录请求
Dim RequestData As New JObject(
New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True))
NetRequestRetry(
Url:=Data.Input.BaseUrl & "/validate",
Method:="POST",
Data:="{""accessToken"":""" & AccessToken & """,""clientToken"":""" & ClientToken & """,""requestUser"":true}",
ContentType:="application/json; charset=utf-8") '没有返回值的
Url:=Data.Input.BaseUrl & "/validate",
Method:="POST",
Data:=RequestData.ToString(0),
ContentType:="application/json; charset=utf-8") '没有返回值的
'将登录结果输出
Data.Output.AccessToken = AccessToken
Data.Output.ClientToken = ClientToken
@@ -712,11 +668,16 @@ LoginFinish:
Try
Dim NeedRefresh As Boolean = False
McLaunchLog("登录开始(Login, " & Data.Input.Token & ")")
Dim RequestData As New JObject(
New JProperty("agent", New JObject(New JProperty("name", "Minecraft"), New JProperty("version", 1))),
New JProperty("username", Data.Input.UserName),
New JProperty("password", Data.Input.Password),
New JProperty("requestUser", True))
Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST",
Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" & Data.Input.Password & """,""requestUser"":true}",
ContentType:="application/json; charset=utf-8"))
Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST",
Data:=RequestData.ToString(0),
ContentType:="application/json; charset=utf-8"))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Critical)
@@ -881,7 +842,7 @@ SystemBrowser:
End If
Dim Result As String
Try
Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1)
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2)
Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
@@ -908,7 +869,7 @@ SystemBrowser:
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestMuity("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
@@ -930,10 +891,10 @@ SystemBrowser:
}"
Dim Result As String
Try
Result = NetRequestMuity("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
If ex.Message.Contains("2148916233") Then
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 XBox 账户。" & vbCrLf &
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 Xbox 账户。" & vbCrLf &
"如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then
OpenWebsite("https://www.minecraft.net/")
End If
@@ -964,10 +925,10 @@ SystemBrowser:
Private Function MsLoginStep5(Tokens As String()) As String
McLaunchLog("开始微软登录步骤 5")
Dim Request As String = "{""identityToken"": ""XBL3.0 x=" & Tokens(1) & ";" & Tokens(0) & """}"
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
Dim Result As String
Try
Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Result = NetRequestMulty("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
@@ -991,7 +952,7 @@ SystemBrowser:
Dim Result As String
Try
Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
@@ -1000,8 +961,8 @@ SystemBrowser:
ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 6 步汇报 404")
RunInNewThread(Sub()
Select Case MyMsgBox("你可能没有在 Minecraft 官网创建档案,XBox Game Pass 已到期,或者还没有购买 Minecraft。" & vbCrLf &
"如果你确认拥有 Minecraft,请在官网上创建档案后再试。", "登录失败", "创建档案", "购买 Minecraft", "取消")
Select Case MyMsgBox("你可能没有创建 Minecraft 玩家档案、Xbox Game Pass 已到期,或者还没有购买 Minecraft。" & vbCrLf &
"请先使用官方启动器登录一次,之后即可使用 PCL 登录。", "登录失败", "创建档案", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
@@ -1115,11 +1076,14 @@ SystemBrowser:
'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine Then
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<1.7:至多 Java 8(Java 9 - 10 未测试)
'<1.7:至多 Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
'1.8 - 1.11:必须恰好 Java 8(Java 9 - 10 未测试)
'1.8 - 1.11:必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain = 12 Then
'1.12:最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
End If
@@ -1128,24 +1092,21 @@ SystemBrowser:
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2:必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
'<1.12,Forge 14.23.5.2855 及更低:Java 8
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<=1.12:Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
'1.13 - 1.14,Forge 28.2.23 及更低:Java 8 - 10
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then
'1.13 - 1.14:Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 15 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then
'1.15:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
'1.16.X,Forge 34.X ~ 36.2.25:最高 Java 8u320
'1.16,Forge 34.X ~ 36.2.25:最高 Java 8u320
MaxVer = New Version(1, 8, 0, 320)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18+:若安装了 OptiFine,最高 Java 18
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18:若安装了 OptiFine,最高 Java 18
MaxVer = New Version(1, 18, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 19 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.19+:最高 Java 19
MaxVer = New Version(1, 19, 999, 999)
End If
End If
@@ -1179,17 +1140,27 @@ SystemBrowser:
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 16, 0, 0) Then
If MinVer >= New Version(1, 9, 0, 0) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7
ElseIf MinVer > New Version(1, 8, 0, 52) Then
'缺少 Java 8 较新版(统一通行证)
If Not JavaDownloadConfirm("Java 7") Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101"
JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True)
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) Then
JavaCode = "8u101"
JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True)
Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
Else
JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If
If Not JavaDownloadConfirm(JavaCode) Then Throw New Exception("$$")
'开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode)
@@ -1200,6 +1171,7 @@ SystemBrowser:
Loop
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
@@ -1347,7 +1319,7 @@ SystemBrowser:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'添加 MainClass
@@ -1414,7 +1386,7 @@ NextVersion:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1740,6 +1712,15 @@ NextVersion:
'更新 options.txt
Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt"
If Not File.Exists(SetupFileAddress) Then
'Yosbr Mod 兼容(#2385):https://www.curseforge.com/minecraft/mc-mods/yosbr
Dim YosbrFileAddress As String = McVersionCurrent.PathIndie & "config\yosbr\options.txt"
If File.Exists(YosbrFileAddress) Then
McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
SetupFileAddress = YosbrFileAddress
WriteIni(SetupFileAddress, "lang", "none") '忽略默认语言
End If
End If
Try
'语言
'1.0- :没有语言选项
@@ -1760,11 +1741,11 @@ NextVersion:
WriteIni(SetupFileAddress, "lang", RequiredLang)
McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
End If
'如果是初次设置,一并修改 forceUnicodeFont
If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves")) Then
WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
McLaunchLog("已开启 forceUnicodeFont")
End If
''如果是初次设置,一并修改 forceUnicodeFont
'If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves")) Then
' WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
' McLaunchLog("已开启 forceUnicodeFont")
'End If
'窗口
Select Case Setup.Get("LaunchArgumentWindowType")
Case 0 '全屏
@@ -1830,11 +1811,15 @@ NextVersion:
Else
PackFormat = 12
End If
Case 20, 99 '99 是快照版
PackFormat = 15
Case Else
PackFormat = 16
'https://minecraft.fandom.com/zh/wiki/数据包#数据包版本
Case 20
If McVersionCurrent.Version.McCodeSub <= 1 Then
PackFormat = 15
Else
PackFormat = 17
End If
Case Else '快照版是 99
PackFormat = 17
'https://zh.minecraft.wiki/w/数据包#数据包版本
End Select
McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
'准备文件
@@ -1844,7 +1829,7 @@ NextVersion:
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
Skin = Skin.Clip(New System.Drawing.Rectangle(0, 0, 64, 32))
Skin = Skin.Clip(0, 0, 64, 32)
End If
Skin.Save(Path & "PCL\CustomSkin_Cliped.png")
'构建压缩文件
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
@@ -1,4 +1,6 @@
Public Module ModModpack
Imports System.IO.Compression
Public Module ModModpack
'触发整合包安装的外部接口
''' <summary>
@@ -14,13 +16,13 @@
''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As Compression.ZipArchive = Nothing
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
Try
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
'从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
@@ -109,7 +111,7 @@
'整合包缓存清理
Private IsInstallCacheCleared As Boolean = False
Private IsInstallCacheClearing As Boolean = False
Private Sub UnpackFiles(InstallTemp As String, FileAddress As String)
Private Sub UnpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase)
'清理缓存文件夹
If Not IsInstallCacheCleared Then
IsInstallCacheCleared = True
@@ -135,9 +137,8 @@
Try
Retry:
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
Directory.CreateDirectory(InstallTemp)
DeleteDirectory(InstallTemp)
Compression.ZipFile.ExtractToDirectory(FileAddress, InstallTemp, Encode)
ExtractFile(FileAddress, InstallTemp, Encode)
Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then
@@ -146,6 +147,7 @@ Retry:
End If
If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000)
If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Exit Sub
RetryCount += 1
GoTo Retry
Else
@@ -215,13 +217,15 @@ Retry:
If OverrideHome <> "" Then
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
If Directory.Exists(OverridePath) Then
CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName)
Log($"[ModPack] 整合包 override 复制:{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
Log($"[ModPack] 整合包中未找到 override 文件夹:{OverridePath}")
End If
Task.Progress = 0.9
'开启版本隔离
@@ -230,54 +234,67 @@ Retry:
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End If
'获取 Mod 列表
Dim ModFileList As New List(Of Integer)
Dim ModList As New List(Of Integer)
Dim ModOptionalList As New List(Of Integer)
For Each ModEntry In If(Json("files"), {})
If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
Hint("某项 Mod 缺少必要信息,已跳过:" & ModEntry.ToString)
Continue For
End If
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then Continue For
ModFileList.Add(ModEntry("fileID"))
ModList.Add(ModEntry("fileID"))
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
Next
If ModFileList.Count > 0 Then
If ModList.Count > 0 Then
'获取 Mod 下载信息
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项
If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
Dim FileList As New Dictionary(Of Integer, NetFile)
For Each ModJson In Task.Input
Dim Id As Integer = ModJson("id").ToObject(Of Integer)
'跳过重复的 Mod(疑似 CurseForge Bug)
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
'根据 modules 判断是资源包还是 Mod
If FileList.ContainsKey(Id) Then Continue For
'可选 Mod 提示
If ModOptionalList.Contains(Id) Then
If MyMsgBox("是否要下载整合包中的可选文件 " & ModJson("displayName").ToString & "?",
"下载可选文件", "是", "否") = 2 Then
Continue For
End If
End If
'建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断是资源包还是 Mod
Dim IsResourcePack As Boolean
If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
IsResourcePack = Not ModuleNames.Contains("META-INF") AndAlso ModuleNames.Contains("pack.mcmeta")
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWith(".jar")) '文件后缀不是 .jar
Else
IsResourcePack = False
End If
'实际的添加
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
FileList.Add(ModJson("id"),
File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
Task.Progress += 1 / (1 + ModFileList.Count)
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
'下载 Mod 文件
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
End If
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
@@ -333,7 +350,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
@@ -388,7 +405,7 @@ Retry:
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
@@ -420,7 +437,7 @@ Retry:
End Select
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString).ToArray,
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString)))
Next
@@ -431,6 +448,7 @@ Retry:
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
@@ -486,7 +504,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
@@ -514,7 +532,7 @@ Retry:
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
@@ -533,6 +551,7 @@ Retry:
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim InstallExpectTime As Double = 0
@@ -584,7 +603,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
@@ -607,12 +626,13 @@ Retry:
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
'解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
@@ -622,14 +642,52 @@ Retry:
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni(SetupFile, "VersionArgumentIndie", 1)
'读取 MMC 设置文件(#2655)
Try
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MMCSetupFile) Then
'将其中的等号替换为冒号,以符合 ini 文件格式
WriteFile(MMCSetupFile, ReadFile(MMCSetupFile).Replace("=", ":"))
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
Replace("$INST_JAVA", "{java}javaw.exe").
Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
Log("[ModPack] 迁移 MultiMC 版本独立设置:启动前执行命令:" & PreLaunchCommand)
End If
End If
If ReadIni(MMCSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MMCSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置:自动进入服务器:" & ServerAddress)
End If
If ReadIni(MMCSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置:忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MMCSetupFile, "iconKey", "")
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If
End If
Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)")
End Try
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
Select Case If(Component("uid"), "").ToString
Case "org.lwjgl"
@@ -640,6 +698,9 @@ Retry:
Request.ForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
End Select
Next
'构造加载器
@@ -676,7 +737,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
@@ -704,7 +765,7 @@ Retry:
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
@@ -729,8 +790,13 @@ Retry:
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
End If
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
@@ -770,7 +836,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
@@ -790,7 +856,7 @@ Retry:
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
'解压
Hint("正在解压压缩包……")
UnpackFiles(TargetFolder, FileAddress)
UnpackFiles(TargetFolder, FileAddress, Nothing)
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder, NewName, False)
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish)
@@ -116,7 +116,7 @@
Get
Return _State
End Get
Set(ByVal value As MinecraftState)
Set(value As MinecraftState)
If _State = value Then Exit Property
_State = value
WatcherStateChanged()
@@ -272,7 +272,7 @@
If Not MinecraftWindowName.StartsWith("FML") Then
'已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle
WatcherLog("Minecraft 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")")
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
@@ -282,6 +282,7 @@
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
@@ -29,15 +29,15 @@
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Foreground="{DynamicResource ColorBrush1}" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,0,0">
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="1,0,3,0.5"
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,0.5"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
IsHitTestVisible="True" SnapsToDevicePixels="False" UseLayoutRounding="False"
ToolTipService.InitialShowDelay="100" ToolTipService.BetweenShowDelay="100"
@@ -1,8 +1,9 @@
Public Class MyCompItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
#Region "Logo"
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
@@ -19,9 +20,9 @@
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -44,43 +45,116 @@
End Try
End Set
End Property
Private Sub LogoLoader(Address As String)
Dim Retry As Boolean = False
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
NetDownload(_Logo, Address & DownloadEnd)
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd)
Dim LoadError As Exception = Nothing
RunInUiWait(Sub()
Try
'在地址更换时取消加载
If Not Address = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(Address & DownloadEnd)
Catch ex As Exception
Log(ex, "读取资源工程图标失败(" & Address & ")")
File.Delete(Address & DownloadEnd)
LoadError = ex
End Try
End Sub)
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(Address) Then
File.Delete(Address & DownloadEnd)
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(Address & DownloadEnd, Address)
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retry Then
Retry = True
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Public Property Title As String
Get
Return LabTitle.Text
End Get
Set(value As String)
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
#End Region
#Region "点击"
@@ -94,11 +168,43 @@ RetryStart:
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
End If
End Sub
Private Sub ProjectClick(sender As MyCompItem, e As EventArgs) Handles Me.Click
'记录当前展开的卡片标题(#2712)
Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseOver Then IsMouseDown = True
If IsMouseOver AndAlso CanInteraction Then IsMouseDown = True
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
@@ -139,9 +245,12 @@ RetryStart:
#End Region
Private StateLast As String
Public HasAnimation As Boolean = True
''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' </summary>
Public CanInteraction As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
If Not HasAnimation Then Exit Sub
If Not CanInteraction Then Exit Sub
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
@@ -188,20 +297,4 @@ RetryStart:
End If
End Sub
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
End Class
@@ -0,0 +1,43 @@
<Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
<ColumnDefinition Width="7" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="4" x:Name="ColumnPaddingRight" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="17" />
<RowDefinition Height="18" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid>
@@ -0,0 +1,453 @@
Imports System.Windows.Forms
Public Class MyLocalModItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
End Try
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Private _Title As String
Public Property Title As String
Get
Return _Title
End Get
Set(value As String)
Dim RawValue = value
Select Case Entry.State
Case McMod.McModState.Fine
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavaliable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
_Title = RawValue
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
'相关联的 Mod
Public Property Entry As McMod
Get
Return Tag
End Get
Set(value As McMod)
Tag = value
End Set
End Property
#End Region
#Region "点击与勾选"
'触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
Log("[Control] 按下本地 Mod 列表项:" & LabTitle.Text)
End If
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If Not IsMouseDirectlyOver Then Exit Sub
IsMouseDown = True
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'勾选状态
Public Event Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs)
Private _Checked As Boolean = False
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
Try
'触发属性值修改
Dim ChangedEventArgs As New RouteEventArgs(False)
Dim RawValue = _Checked
If value = _Checked Then Exit Property
_Checked = value
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Property
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(False)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Property
End If
'更改动画
If IsVisibleInForm() Then
Dim Anim As New List(Of AniData)
If Checked Then
'由无变有
Dim Delta = 32 - RectCheck.ActualHeight
Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak)))
Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"), 200))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(LabTitle.TextDecorations Is Nothing, "ColorBrush1", "ColorBrushGray4"), 120))
End If
AniStart(Anim, "MyLocalModItem Checked " & Uuid)
Else
'不在窗口上时直接设置
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Set
End Property
#End Region
#Region "后加载内容"
'右下角状态指示图标
Private ImgState As Image
'指向背景
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(3),
.RenderTransform = New ScaleTransform(0.8, 0.8),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
'按钮
Public ButtonHandler As Action(Of MyLocalModItem, EventArgs)
Public ButtonStack As FrameworkElement
Private _Buttons As IEnumerable(Of MyIconButton)
Public Property Buttons As IEnumerable(Of MyIconButton)
Get
Return _Buttons
End Get
Set(value As IEnumerable(Of MyIconButton))
_Buttons = value
'移除原 Stack
If ButtonStack IsNot Nothing Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
If value.Count = 0 Then Exit Property
'添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
End Set
End Property
'勾选条
Private _RectCheck As Border
Public ReadOnly Property RectCheck As Border
Get
If _RectCheck Is Nothing Then
_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(-3, 6, 0, 6), New Thickness(-3, 0, 0, 0))}
_RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(_RectCheck, 10)
Children.Add(_RectCheck)
End If
Return _RectCheck
End Get
End Property
#End Region
Public Sub Refresh()
RunInUi(
Sub()
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable
NewDescription = GetFileNameFromPath(Entry.Path)
End Select
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误,无法获取信息"
End If
Description = NewDescription
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
End If
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavaliable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
'按钮虚拟化检测
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
'触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData)
'ButtonStack
If ButtonStack IsNot Nothing Then
If IsMouseOver Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
Else
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
End If
'RectBack
If IsMouseOver OrElse Checked Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub
End Class
+15 -9
View File
@@ -13,21 +13,19 @@
Case "打开网页"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
If Not Data(0).Contains("://") OrElse Data(0).ToLower.StartsWith("file") Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
End If
Hint("正在打开网页,请稍候……")
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
@@ -39,13 +37,14 @@
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏"
If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
End If
@@ -54,6 +53,7 @@
Case "刷新主页"
FrmLaunchRight.ForceRefresh()
If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
Case "刷新帮助"
PageOtherLeft.RefreshHelp()
@@ -65,15 +65,21 @@
RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
Case "清理垃圾"
PageOtherTest.RubbishClear()
RunInThread(Sub() PageOtherTest.RubbishClear())
Case "弹出窗口"
MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
Case "切换页面"
FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
Case "导入整合包"
RunInThread(Sub() ModpackInstall())
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的协议。", "事件执行失败")
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
+24 -23
View File
@@ -5,7 +5,7 @@
''' <summary>
''' 接下来要播放的音乐文件路径。未初始化时为 Nothing。
''' </summary>
Public MusicToplayList As List(Of String) = Nothing
Public MusicWaitingList As List(Of String) = Nothing
''' <summary>
''' 全部音乐文件路径。未初始化时为 Nothing。
''' </summary>
@@ -22,20 +22,19 @@
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In My.Computer.FileSystem.GetFiles(Path & "PCL\Musics\", FileIO.SearchOption.SearchAllSubDirectories, "*.*")
For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Extend As String = File.Split(".").Last.ToLower
If Not (Extend = "ini" OrElse Extend = "jpg" OrElse Extend = "txt" OrElse Extend = "cfg" OrElse Extend = "png") Then
MusicAllList.Add(File)
End If
Dim Ext As String = File.Extension.ToLower
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName)
Next
End If
'打乱顺序播放
MusicToplayList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicToplayList.Count = 0 AndAlso MusicToplayList(0) = IgnoreFirst Then
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicWaitingList.Count = 0 AndAlso MusicWaitingList(0) = IgnoreFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicToplayList.RemoveAt(0)
MusicToplayList.Add(IgnoreFirst)
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -46,12 +45,11 @@
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing Then MusicListInit(False)
If MusicAllList.Count = 0 Then Throw New Exception("在没有音乐时尝试获取音乐路径")
If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 OrElse MusicWaitingList.Count = 0 Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicToplayList(0)
MusicToplayList.RemoveAt(0)
If MusicToplayList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
End Function
#End Region
@@ -106,7 +104,8 @@
Case MusicStates.Play
MusicPause()
Case Else
Hint("音乐目前为停止状态!", HintType.Critical)
Log("[Music] 音乐目前为停止状态,已强制尝试开始播放", LogLevel.Debug)
MusicRefreshPlay(False)
End Select
End If
End Sub
@@ -212,15 +211,15 @@
''' 继续音乐播放,返回是否成功切换了状态。
''' </summary>
Public Function MusicResume() As Boolean
If MusicState = MusicStates.Pause Then
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Return False
Else
RunInThread(Sub()
MusicNAudio.Play()
MusicRefreshUI()
Log("[Music] 已恢复播放")
End Sub)
Return True
Else
Return False
End If
End Function
@@ -267,6 +266,7 @@
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
@@ -274,10 +274,11 @@
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
Log(ex, "播放音乐失败(" & MusicCurrent & ")", LogLevel.Developer)
If MusicAllList.Count > 1 Then
Thread.Sleep(1000)
MusicStartPlay(DequeueNextMusicAddress)
Thread.Sleep(1000)
If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If
Finally
If CurrentWave IsNot Nothing Then CurrentWave.Dispose()
@@ -25,7 +25,7 @@ Public Class CookieWebClient
''' </summary>
Public Timeout As Integer = 600000
Protected Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest
Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
Dim r As WebRequest = MyBase.GetWebRequest(address)
Dim request = TryCast(r, HttpWebRequest)
@@ -37,19 +37,19 @@ Public Class CookieWebClient
Return r
End Function
Protected Overrides Function GetWebResponse(ByVal request As WebRequest, ByVal result As IAsyncResult) As WebResponse
Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request, result)
ReadCookies(response)
Return response
End Function
Protected Overrides Function GetWebResponse(ByVal request As WebRequest) As WebResponse
Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request)
ReadCookies(response)
Return response
End Function
Private Sub ReadCookies(ByVal r As WebResponse)
Private Sub ReadCookies(r As WebResponse)
Dim response = TryCast(r, HttpWebResponse)
If response IsNot Nothing Then
Dim cookies As CookieCollection = response.Cookies
@@ -12,7 +12,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("Minecraft 启动器 (制作:龙腾猫跃)")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher 2")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2023. All Rights Reserved.")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2024. All Rights Reserved.")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.2.0")>
<Assembly: AssemblyFileVersion("2.6.2.0")>
<Assembly: AssemblyVersion("2.6.13.0")>
<Assembly: AssemblyFileVersion("2.6.13.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -181,22 +181,22 @@ Public Module ModDownloadLib
Dim Logo As String
Select Case Entry("type")
Case "release"
Logo = "pack://application:,,,/images/Blocks/Grass.png"
Logo = PathImage & "Blocks/Grass.png"
Case "snapshot"
Logo = "pack://application:,,,/images/Blocks/CommandBlock.png"
Logo = PathImage & "Blocks/CommandBlock.png"
Case "special"
Logo = "pack://application:,,,/images/Blocks/GoldBlock.png"
Logo = PathImage & "Blocks/GoldBlock.png"
Case Else
Logo = "pack://application:,,,/images/Blocks/CobbleStone.png"
Logo = PathImage & "Blocks/CobbleStone.png"
End Select
'建立控件
Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60}
Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry}
If Entry("lore") Is Nothing Then
NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
Else
NewItem.Info = Entry("lore").ToString
End If
If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL 特别提供] " & NewItem.Info
If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL 特供下载] " & NewItem.Info
AddHandler NewItem.Click, OnClick
'建立菜单
If IsSaveOnly Then
@@ -299,8 +299,8 @@ Public Module ModDownloadLib
WikiName = "Java版Infdev_20100618"
ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then
WikiName = "Java版Classic_0.30(生存模式)"
ElseIf Id = "c0.31" Then
WikiName = "Java版Indev_0.31(2010年1月30日)"
ElseIf Id.StartsWith("c0.31") Then
WikiName = "Java版Indev_0.31_20100130"
ElseIf Id.StartsWith("c") Then
WikiName = "Java版" & Id.Replace("c", "Classic_")
ElseIf Id.StartsWith("rd-") Then
@@ -309,7 +309,7 @@ Public Module ModDownloadLib
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
Exit Sub
End If
OpenWebsite("https://minecraft.fandom.com/zh/wiki/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
End Sub
#End Region
@@ -382,11 +382,11 @@ Public Module ModDownloadLib
Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback)
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean))
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
'选择 Java
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
If Not JavaDownloadConfirm(17) Then Throw New Exception("由于未找到 Java,已取消安装。")
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载
Dim JavaLoader = JavaFixLoaders(17)
JavaLoader.Start(17, IsForceRestart:=True)
@@ -399,7 +399,12 @@ Public Module ModDownloadLib
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ -jar """ & ExtractJavaWrapper() & """ optifine.Installer"
Dim Arguments As String
If UseJavaWrapper Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer"
End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -489,7 +494,7 @@ Public Module ModDownloadLib
''' <summary>
''' 获取下载某个 OptiFine 版本的加载器列表。
''' </summary>
Private Function McDownloadOptiFineLoader(DownloadInfo As DlOptiFineListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
Private Function McDownloadOptiFineLoader(DownloadInfo As DlOptiFineListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
'参数初始化
McFolder = If(McFolder, PathMcFolder)
@@ -504,67 +509,66 @@ Public Module ModDownloadLib
'获取下载地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 OptiFine 主文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit)
End If
Task.Progress = 0.1
Dim Sources As New List(Of String)
'BMCLAPI 源
If DownloadInfo.IsPreview Then
Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else
Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
End If
'官方源
Dim PageData As String
Try
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0))
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
End Try
Task.Progress = 0.9
'OptiFine 中文镜像源
Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile)
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))}
End Sub) With {.ProgressWeight = 8})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit)
End If
Task.Progress = 0.1
Dim Sources As New List(Of String)
'BMCLAPI 源
If DownloadInfo.IsPreview Then
Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else
Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
End If
'官方源
Dim PageData As String
Try
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html")
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0))
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
End Try
'OptiFine 中文镜像源
Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile)
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))}
End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If Not IsCustomFolder Then Exit Sub
SyncLock VanillaSyncLock
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If Not IsCustomFolder Then Exit Sub
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar",
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装(新旧方式均需要原版 Jar 和 Json)
If IsNewVersion Then
@@ -586,7 +590,19 @@ Public Module ModDownloadLib
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06
'进行安装
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task)
Dim UseJavaWrapper As Boolean = True
Retry:
Try
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper)
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 OptiFine 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
Throw New Exception("运行 OptiFine 安装器失败", ex)
End If
End Try
Task.Progress = 0.96
'复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json")
@@ -596,7 +612,7 @@ Public Module ModDownloadLib
File.Delete(Target)
DeleteDirectory(BaseMcFolderHome)
Catch ex As Exception
Throw New Exception("安装新版 OptiFine 版本失败", ex)
Throw New Exception("安装 OptiFine(方式 A)失败", ex)
End Try
End Sub) With {.ProgressWeight = 8})
Else
@@ -616,8 +632,8 @@ Public Module ModDownloadLib
Dim Json As String = "{
""id"": """ & Id & """,
""inheritsFrom"": """ & DownloadInfo.Inherit & """,
""time"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy-MM-dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""releaseTime"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy-MM-dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""time"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""releaseTime"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""type"": ""release"",
""libraries"": [
{""name"": ""optifine:OptiFine:" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & """},
@@ -645,7 +661,7 @@ Public Module ModDownloadLib
End If
WriteFile(VersionFolder & Id & ".json", Json)
Catch ex As Exception
Throw New Exception("安装旧版 OptiFine 版本失败", ex)
Throw New Exception("安装 OptiFine(方式 B)失败", ex)
End Try
End Sub) With {.ProgressWeight = 1})
End If
@@ -702,11 +718,11 @@ Public Module ModDownloadLib
Public Function OptiFineDownloadListItem(Entry As DlOptiFineListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion)),
.Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
.Logo = PathImage & "Blocks/GrassPath.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -828,17 +844,17 @@ Public Module ModDownloadLib
'老版本
Select Case DownloadInfo.Inherit
Case "1.7.10"
Address.Add("http://dl.liteloader.com/redist/1.7.10/liteloader-installer-1.7.10-04.jar")
Address.Add("https://dl.liteloader.com/redist/1.7.10/liteloader-installer-1.7.10-04.jar")
Case "1.7.2"
Address.Add("http://dl.liteloader.com/redist/1.7.2/liteloader-installer-1.7.2-04.jar")
Address.Add("https://dl.liteloader.com/redist/1.7.2/liteloader-installer-1.7.2-04.jar")
Case "1.6.4"
Address.Add("http://dl.liteloader.com/redist/1.6.4/liteloader-installer-1.6.4-01.jar")
Address.Add("https://dl.liteloader.com/redist/1.6.4/liteloader-installer-1.6.4-01.jar")
Case "1.6.2"
Address.Add("http://dl.liteloader.com/redist/1.6.2/liteloader-installer-1.6.2-04.jar")
Address.Add("https://dl.liteloader.com/redist/1.6.2/liteloader-installer-1.6.2-04.jar")
Case "1.5.2"
'Address.AddRange({"https://download.mcbbs.net/maven/com/mumfrey/liteloader/1.5.2/liteloader-1.5.2.jar",
' "https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/1.5.2/liteloader-1.5.2.jar"})
Address.Add("http://dl.liteloader.com/redist/1.5.2/liteloader-installer-1.5.2-01.jar")
Address.Add("https://dl.liteloader.com/redist/1.5.2/liteloader-installer-1.5.2-01.jar")
Case Else
Throw New NotSupportedException("未知的 Minecraft 版本(" & DownloadInfo.Inherit & ")")
End Select
@@ -884,42 +900,41 @@ Public Module ModDownloadLib
'启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then
Loaders.Add(New LoaderTask(Of String, String)(
"启动 LiteLoader 依赖版本下载",
Sub()
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit)
End Sub) With {.ProgressWeight = 0.2, .Show = False, .Block = False})
Loaders.Add(New LoaderTask(Of String, String)("启动 LiteLoader 依赖版本下载",
Sub()
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit)
End Sub) With {.ProgressWeight = 0.2, .Show = False, .Block = False})
End If
'安装
Loaders.Add(New LoaderTask(Of String, String)("安装 LiteLoader",
Sub(Task As LoaderTask(Of String, String))
Try
'新建版本文件夹
Directory.CreateDirectory(VersionFolder)
'构造版本 Json
Dim VersionJson As New JObject
VersionJson.Add("id", VersionName)
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
CType(VersionJson("libraries"), JContainer).Add(GetJson("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""http://dl.liteloader.com/versions/""}"))
VersionJson.Add("mainClass", "net.minecraft.launchwrapper.Launch")
VersionJson.Add("minimumLauncherVersion", 18)
VersionJson.Add("inheritsFrom", DownloadInfo.Inherit)
VersionJson.Add("jar", DownloadInfo.Inherit)
'输出 Json 文件
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("安装新 LiteLoader 版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1})
Sub(Task As LoaderTask(Of String, String))
Try
'新建版本文件夹
Directory.CreateDirectory(VersionFolder)
'构造版本 Json
Dim VersionJson As New JObject
VersionJson.Add("id", VersionName)
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
CType(VersionJson("libraries"), JContainer).Add(GetJson("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""https://dl.liteloader.com/versions/""}"))
VersionJson.Add("mainClass", "net.minecraft.launchwrapper.Launch")
VersionJson.Add("minimumLauncherVersion", 18)
VersionJson.Add("inheritsFrom", DownloadInfo.Inherit)
VersionJson.Add("jar", DownloadInfo.Inherit)
'输出 Json 文件
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("安装新 LiteLoader 版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1})
'下载支持库
If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 LiteLoader 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 LiteLoader 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 6})
End If
@@ -933,9 +948,9 @@ Public Module ModDownloadLib
Public Function LiteLoaderDownloadListItem(Entry As DlLiteLoaderListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 30,
.Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.IsPreview, "测试版", "稳定版") & If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime),
.Logo = "pack://application:,,,/images/Blocks/Egg.png"
.Logo = PathImage & "Blocks/Egg.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -949,10 +964,8 @@ Public Module ModDownloadLib
End Function
Private Sub LiteLoaderSaveContMenuBuild(sender As MyListItem, e As EventArgs)
If sender.Tag.IsLegacy Then
sender.PaddingRight = 0
sender.Buttons = {}
Else
sender.PaddingRight = 30
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender}
ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnList, 30)
@@ -968,10 +981,8 @@ Public Module ModDownloadLib
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, AddressOf LiteLoaderSave_Click
If sender.Tag.IsLegacy Then
sender.PaddingRight = 30
sender.Buttons = {BtnSave}
Else
sender.PaddingRight = 60
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender}
ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnList, 30)
@@ -987,7 +998,7 @@ Public Module ModDownloadLib
Else
Version = sender.Tag.Tag
End If
OpenWebsite("http://jenkins.liteloader.com/view/" & Version.Inherit)
OpenWebsite("https://jenkins.liteloader.com/view/" & Version.Inherit)
End Sub
Public Sub LiteLoaderSave_Click(sender As Object, e As RoutedEventArgs)
'ListItem 与小按钮都会调用这个方法
@@ -1091,7 +1102,7 @@ Public Module ModDownloadLib
Files.Add(New NetFile({
"https://download.mcbbs.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
"https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
}, Target, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash)))
Task.Output = Files
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -1110,11 +1121,11 @@ Public Module ModDownloadLib
End Try
End Sub
Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String)
Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean)
'选择 Java
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
If Not JavaDownloadConfirm(17) Then Throw New Exception("由于未找到 Java,已取消安装。")
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载
Dim JavaLoader = JavaFixLoaders(17)
JavaLoader.Start(17, IsForceRestart:=True)
@@ -1127,7 +1138,12 @@ Public Module ModDownloadLib
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -cp """ & PathTemp & "Cache\forge_installer.jar;" & Target & """ -jar """ & ExtractJavaWrapper() & """ com.bangbang93.ForgeInstaller """ & McFolder
Dim Arguments As String
If UseJavaWrapper Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -1259,7 +1275,7 @@ Public Module ModDownloadLib
''' <summary>
''' 获取下载某个 Forge 版本的加载器列表。
''' </summary>
Private Function McDownloadForgeLoader(Version As String, Inherit As String, Optional DownloadInfo As DlForgeVersionEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
Private Function McDownloadForgeLoader(Version As String, Inherit As String, Optional DownloadInfo As DlForgeVersionEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
'参数初始化
McFolder = If(McFolder, PathMcFolder)
@@ -1305,7 +1321,7 @@ Public Module ModDownloadLib
'添加主文件
Dim Files As New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))}
Task.Output = Files
@@ -1332,18 +1348,20 @@ Public Module ModDownloadLib
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件
Task.Progress = 0.4
Log("[Download] 需要 Mappings 下载信息,开始获取原版 Json 文件")
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt]
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings.txt")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
Log("[Download] 需要下载 Mappings:" & Address)
End If
Task.Progress = 0.8
'去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") Then
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
End If
@@ -1386,13 +1404,13 @@ Public Module ModDownloadLib
'拷贝原版文件
If Not IsCustomFolder Then Exit Sub
SyncLock VanillaSyncLock
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
End SyncLock
#End Region
@@ -1403,9 +1421,8 @@ Public Module ModDownloadLib
Try
Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress)
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(Info As DirectoryInfo) As String
Return Info.FullName
End Function).ToList()
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
Select(Function(i) i.FullName).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
@@ -1415,18 +1432,32 @@ Public Module ModDownloadLib
'释放 launcher_installer.json
McFolderLauncherProfilesJsonCreate(McFolder)
Task.Progress = 0.05
'释放 Forge 注入器
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
Task.Progress = 0.06
'运行注入器
ForgeInjector(InstallerAddress, Task, McFolder)
Task.Progress = 0.97
'运行 Forge 安装器
Dim UseJavaWrapper As Boolean = True
Retry:
Try
'释放 Forge 注入器
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
Task.Progress = 0.06
'运行注入器
ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
Task.Progress = 0.97
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 Forge 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
Throw New Exception("运行 Forge 安装器失败", ex)
End If
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.SkipWhile(Function(Info As DirectoryInfo) As Boolean
Return OldList.Contains(Info.FullName)
End Function).ToList()
If DeltaList.Count > 1 Then '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
DeltaList = New List(Of DirectoryInfo) From {DeltaList.Where(Function(l) l.Name.Contains("forge")).First}
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
End If
If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
@@ -1470,7 +1501,7 @@ Public Module ModDownloadLib
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
ZipFile.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
Else
@@ -1546,11 +1577,11 @@ Public Module ModDownloadLib
Public Function ForgeDownloadListItem(Entry As DlForgeVersionEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.Version, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Title = Entry.Version, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.ReleaseTime = "",
If(ModeDebug, "种类:" & Entry.Category & If(Entry.Branch Is Nothing, "", ",开发分支:" & Entry.Branch), ""),
"发布于 " & Entry.ReleaseTime & If(ModeDebug, ",种类:" & Entry.Category & If(Entry.Branch Is Nothing, "", ",开发分支:" & Entry.Branch), "")),
.Logo = "pack://application:,,,/images/Blocks/Anvil.png"
.Logo = PathImage & "Blocks/Anvil.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -1592,7 +1623,7 @@ Public Module ModDownloadLib
Else
Version = sender.Parent.Parent.Tag
End If
OpenWebsite("http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Version.Inherit & "-" & Version.Version & "/forge-" & Version.Inherit & "-" & Version.Version & "-changelog.txt")
OpenWebsite("https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Version.Inherit & "-" & Version.Version & "/forge-" & Version.Inherit & "-" & Version.Version & "-changelog.txt")
End Sub
Public Sub ForgeSave_Click(sender As Object, e As RoutedEventArgs)
Dim Version As DlForgeVersionEntry
@@ -1753,9 +1784,9 @@ Public Module ModDownloadLib
Public Function FabricDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
.Logo = PathImage & "Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -1764,9 +1795,9 @@ Public Module ModDownloadLib
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -1775,9 +1806,9 @@ Public Module ModDownloadLib
Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/OptiFabric.png"
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/OptiFabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -1797,6 +1828,10 @@ Public Module ModDownloadLib
''' 必填。安装目标版本名称。
''' </summary>
Public TargetVersionName As String
''' <summary>
''' 必填。安装目标文件夹。
''' </summary>
Public TargetVersionFolder As String
''' <summary>
''' 必填。欲下载的 Minecraft 的版本名。
@@ -1909,7 +1944,7 @@ Public Module ModDownloadLib
Dim Loader As New LoaderCombo(Of String)(Request.TargetVersionName & " 安装", SubLoaders) With {.OnStateChanged = AddressOf McInstallState}
'启动
Loader.Start(PathMcFolder & "versions\" & Request.TargetVersionName & "\")
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
@@ -1950,9 +1985,9 @@ Public Module ModDownloadLib
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.Split("_HD_U").Last '#735
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.Split("_HD_U_").Last '#735
Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", ""),
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ToLower.Contains("pre"),
.NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion,
@@ -2009,28 +2044,29 @@ Public Module ModDownloadLib
If OptiFineAsMod Then
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineSaveLoader(Request.OptiFineEntry, OptiFineFolder & Request.OptiFineEntry.NameFile)) With {.Show = False, .ProgressWeight = 16, .Block = Request.ForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
Else
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 24, .Block = Request.ForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 24, .Block = Request.ForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If
End If
'Forge
If Request.ForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgeLoader(Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgeLoader(Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If
'LiteLoader
If Request.LiteLoaderEntry IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 LiteLoader " & Request.MinecraftName, McDownloadLiteLoaderLoader(Request.LiteLoaderEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 1, .Block = Request.FabricVersion Is Nothing})
End If
'Fabric Loader
'Fabric
If Request.FabricVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Fabric " & Request.FabricVersion, McDownloadFabricLoader(Request.FabricVersion, Request.MinecraftName, TempMcFolder, False)) With {.Show = False, .ProgressWeight = 2, .Block = True})
End If
'合并安装
LoaderList.Add(New LoaderTask(Of String, String)("安装游戏", Sub(Task As LoaderTask(Of String, String))
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods")
End Sub) With {.ProgressWeight = 2, .Block = True})
LoaderList.Add(New LoaderTask(Of String, String)("安装游戏",
Sub(Task As LoaderTask(Of String, String))
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods")
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Not DontFixLibraries AndAlso
(Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Split(".")(0) >= 20) OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
@@ -2175,7 +2211,7 @@ Public Module ModDownloadLib
OutputJson.Merge(FabricJson)
End If
'修改
If RealArguments IsNot Nothing Then OutputJson("minecraftArguments") = RealArguments
If RealArguments IsNot Nothing AndAlso RealArguments.Replace(" ", "") <> "" Then OutputJson("minecraftArguments") = RealArguments
OutputJson.Remove("_comment_")
OutputJson.Remove("inheritsFrom")
OutputJson.Remove("jar")
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
@@ -55,9 +55,8 @@
Next
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean
Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date)
End Function)
Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next
'清空当前
PanMain.Children.Clear()
@@ -65,11 +64,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
<Grid.RowDefinitions>
@@ -1,6 +1,5 @@
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
Private Project As CompProject
#Region "加载器"
@@ -9,9 +8,19 @@
'初始化加载器信息
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Project = FrmMain.PageCurrent.Additional
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Sub PageDownloadCompDetail_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
'Initialized 只会执行一次
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State
@@ -39,23 +48,8 @@
End Sub
End Class
Private Sub Load_OnFinish()
'获取目标版本与 Mod 加载器
Dim TargetVersion As String = ""
Select Case Project.Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
Dim TargetLoader = CompModLoaderType.Any
If Project.Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
End If
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"目标版本:{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
$"所选版本:{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
'初始化字典
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName))
Dict.Add("未知版本", New List(Of CompFile))
@@ -67,10 +61,10 @@
TargetCard = "未知版本"
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
TargetCard = "快照版本"
ElseIf GameVersion.Split(".").Count >= 2 Then
TargetCard = GameVersion
ElseIf GameVersion.StartsWith("1.0") Then
TargetCard = "远古版本"
Else
TargetCard = "未知版本"
TargetCard = GameVersion
End If
'实际进行添加
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
@@ -102,7 +96,9 @@
NewCard.SwapControl = NewStack
PanMain.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TargetCardName Then
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
Else
NewCard.IsSwaped = True
@@ -128,7 +124,7 @@
Private IsFirstInit As Boolean = True
Public Sub Init() Handles Me.PageEnter
AniControlEnabled += 1
Project = FrmMain.PageCurrent.Additional
Project = FrmMain.PageCurrent.Additional(0)
PanBack.ScrollToHome()
'重启加载器
@@ -142,6 +138,7 @@
'放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem)
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadFabric"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadFabric"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Fabric 简介" x:Name="CardTip">
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadForge"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Forge 简介" x:Name="CardTip">
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadInstall"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadInstall"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,10,25,25">
@@ -26,7 +26,7 @@
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<local:MyListItem Grid.Column="0" x:Name="ItemSelect" IsHitTestVisible="False" Margin="-7,0,0,0" Height="42" PaddingRight="15" SnapsToDevicePixels="True" Type="None" />
<local:MyListItem Grid.Column="0" x:Name="ItemSelect" IsHitTestVisible="False" Margin="-7,0,0,0" Height="42" SnapsToDevicePixels="True" Type="None" />
<local:MyButton Grid.Column="1" HorizontalAlignment="Right" ColorType="Highlight" Text="开始安装" Margin="0,2,0,0" x:Name="BtnSelectStart" MinWidth="140" Padding="13,0" Height="35" VerticalAlignment="Center" />
</Grid>
<Grid Margin="0,0,0,5">
@@ -549,11 +549,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 15, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -571,10 +571,23 @@
NewCard.IsSwaped = True
PanMinecraft.Children.Add(NewCard)
Next
'自动选择版本
If McVersionWaitingForSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本:" & McVersionWaitingForSelect)
For Each Version As JObject In Versions
If Version("id").ToString <> McVersionWaitingForSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub()
End Sub, False)
MinecraftSelected(Item, Nothing)
Next
Catch ex As Exception
Log(ex, "可视化安装版本列表出错", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 当 MC 版本列表加载完时,立即自动选择的版本。用于外部调用。
''' </summary>
Public Shared McVersionWaitingForSelect As String = Nothing
#End Region
@@ -584,7 +597,7 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFineGetError() As String
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容
If SelectedForge IsNot Nothing AndAlso
@@ -687,7 +700,7 @@
''' </summary>
Private Function LoadLiteLoaderGetError() As String
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "没有可用版本"
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadLiteLoader.State, Object).Error.Message
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Return Nothing
@@ -832,10 +845,10 @@
''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadFabricGetError() As String
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message
For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite") Then
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
Return Nothing
@@ -895,7 +908,7 @@
Public Shared Function IsSuitableFabricApi(DisplayName As String, MinecraftVersion As String) As Boolean
Try
If DisplayName Is Nothing OrElse MinecraftVersion Is Nothing Then Return False
DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.ToLower
DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").ToLower
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a)
@@ -932,11 +945,16 @@
''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadFabricApiGetError() As String
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabricApi.State, Object).Error.Message
If DlFabricApiLoader.Output Is Nothing Then
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return "正在获取版本列表……"
End If
For Each Version In DlFabricApiLoader.Output
If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Return Nothing
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return Nothing
Next
Return "没有可用版本"
End Function
@@ -1019,14 +1037,21 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return "正在获取版本列表……"
End If
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Return Nothing
If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135#
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return Nothing '通过检查
Next
Return "没有可用版本"
End Function
@@ -1101,6 +1126,7 @@
'提交安装申请
Dim Request As New McInstallRequest With {
.TargetVersionName = TextSelectName.Text,
.TargetVersionFolder = $"{PathMcFolder}versions\{TextSelectName.Text}\",
.MinecraftJson = SelectedMinecraftJsonUrl,
.MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine,
@@ -5,7 +5,7 @@
<StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -13,10 +13,10 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
LogoScale="1.02" Logo="M292.693 787.627c0 30.72-24.746 55.466-55.466 55.466s-55.467-24.746-55.467-55.466 24.747-55.467 55.467-55.467c30.72-0.853 55.466 24.747 55.466 55.467z M1000.96 241.493c-2.56-5.973-4.267-11.946-6.827-17.92-0.853-6.826-4.266-12.8-8.533-17.92-7.68-9.386-18.773-15.36-31.573-15.36-6.827 0-13.654 1.707-19.627 5.12l-15.36 15.36-17.067 17.067-21.333 21.333L749.227 381.44c-14.507 14.507-38.4 14.507-52.907 0l-54.613-54.613c-14.507-14.507-14.507-38.4 0-52.907l132.266-132.267 14.507-14.506 20.48-20.48 16.213-16.214c3.414-5.973 5.12-11.946 5.12-19.626 0-12.8-5.973-24.747-16.213-32.427-5.973-4.267-11.947-6.827-18.773-7.68-5.12-2.56-10.24-4.267-16.214-5.973-36.693-12.8-76.8-19.627-117.76-19.627-7.68 0-14.506 0-22.186 0.853-188.587 11.947-337.92 168.107-337.92 360.96 0 16.214 0.853 32.427 3.413 48.64L56.32 663.04c-73.387 74.24-73.387 193.707 0 267.093l33.28 33.28c73.387 73.387 193.707 73.387 267.093 0l240.64-241.493c21.334 4.267 42.667 5.973 64 5.973 190.294 0 346.454-146.773 360.107-333.653 0.853-8.533 0.853-17.92 0.853-27.307 0.854-44.373-6.826-86.186-21.333-125.44zM658.773 639.147c-28.16 0-54.613-4.267-79.36-11.094-4.266 7.68-10.24 14.507-16.213 21.334l-258.56 258.56c-43.52 43.52-115.2 43.52-158.72 0l-29.013-29.014c-43.52-44.373-43.52-115.2 0-158.72l212.48-212.48 46.08-46.08c5.973-5.973 12.8-11.093 19.626-15.36-8.533-26.453-12.8-54.613-12.8-83.626v-1.707c0-152.747 123.734-275.627 276.48-275.627 18.774 0 37.547 1.707 55.467 5.974L597.333 207.36c-52.053 52.053-52.053 137.387 0 189.44l29.867 29.867c52.053 52.053 137.387 52.053 189.44 0L930.987 312.32c2.56 16.213 4.266 33.28 4.266 50.347 0 152.746-123.733 276.48-276.48 276.48z" />
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
LogoScale="0.98" Logo="M989.7 510.8l-202.3-101c-10.8-5.4-17.7-16.5-17.7-28.6V172.7c0-26.7-16.6-50.6-41.6-59.9L550.5 46.3c-24.2-9-50.8-9-74.9 0.1l-176.9 66.8c-24.9 9.4-41.4 33.2-41.4 59.9v207.1c0 12.1-6.9 23.2-17.7 28.6l-204 101.9C13.9 521.6 0.1 543.8 0.2 568.1l0.5 226c0 23.2 12.6 44.5 32.9 55.8l223.8 124.6 1.2 0.7c18.9 10.5 41.9 10.4 60.8-0.2l2-1.1L497 873.2c9.9-5.7 22.1-5.6 32 0.1l176.7 102.5c18.9 10.7 42 10.8 61 0.3l3-1.7L992.4 851c20.4-11.3 33-32.8 33-56l-0.3-226.9c0-24.3-13.7-46.5-35.4-57.3zM321 192l115.3 46.1c27 10.8 44.7 36.9 44.7 66v163c0 5.9-6.2 9.8-11.6 7.2L339 409.5c-10.9-5.4-17.7-16.5-17.8-28.6L321 192z m-63.7 703.4L82.5 809.6c-10.9-5.4-17.9-16.5-17.9-28.7l-0.4-189.5L217.9 668c24.1 12 39.4 36.7 39.4 63.6v163.8z m64-274.3c-20.1 10.1-43.7 10-63.8 0l-0.2-0.1-149.1-75 149.1-74.4 16.8-8.4c9.2-4.6 20-4.5 29.1 0.3l18.1 9.4 129.8 64.3c5.8 2.9 6 11.1 0.2 14.2l-130 69.7z m141.9 203.8l-141.8 70.6-0.8-163.6c-0.1-27 15.1-51.8 39.2-63.9l108.8-54.5c5.3-2.7 11.6 1.2 11.6 7.1l0.8 175.6c0 12.1-6.9 23.2-17.8 28.7zM385 144l128-48 128 48-103 38.6c-16.1 6-33.8 6-49.9 0L385 144z m320 48l0.6 187.8c0 12.2-6.8 23.3-17.7 28.7l-131.4 65.7c-5.3 2.7-11.6-1.2-11.6-7.2V304.1c0-29.1 17.7-55.2 44.7-66L705 192z m0.7 710.3l-143.8-77.2c-10.4-5.6-16.9-16.4-16.9-28.2v-176c0-5.9 6.3-9.8 11.6-7.2l109.3 54.6c24 12 39.2 36.5 39.3 63.4l0.5 170.6z m-2-280.5l-129.2-70.5c-5.7-3.1-5.5-11.3 0.3-14.2l131-65.3 16.1-8.5c9.1-4.8 19.9-4.9 29.1-0.3l18.7 9.3L916.9 546l-146.2 76.4c-21.1 11-46.2 10.8-67-0.6z m66 279.4l-0.6-169.1c-0.1-27 15.1-51.7 39.3-63.8L961 592v188.7c0 11.9-6.6 22.7-17 28.3l-174.3 92.2z">
<!--Logo="M469.333333 213.333333V128a42.666667 42.666667 0 1 1 85.333334 0v85.333333h127.829333C847.722667 213.333333 981.333333 347.029333 981.333333 512.149333v319.936A106.496 106.496 0 0 1 874.730667 938.666667h-85.461334c-48.661333 0-107.221333-29.290667-136.469333-68.266667l-64-85.333333c-6.144-8.170667-23.957333-17.066667-34.24-17.066667h-85.12c-10.282667 0-28.096 8.896-34.24 17.066667l-64 85.333333c-29.226667 38.976-87.808 68.266667-136.469333 68.266667H149.269333A106.496 106.496 0 0 1 42.666667 832.085333V512.149333C42.666667 347.029333 176.277333 213.333333 341.504 213.333333H469.333333z m213.162667 85.333334H341.504A213.333333 213.333333 0 0 0 128 512.149333v319.936c0 11.818667 9.450667 21.248 21.269333 21.248h85.461334c21.802667 0 55.082667-16.64 68.202666-34.133333l64-85.333333c22.272-29.696 65.408-51.2 102.506667-51.2h85.12c37.098667 0 80.213333 21.504 102.506667 51.2l64 85.333333c13.12 17.493333 46.4 34.133333 68.202666 34.133333h85.461334a21.162667 21.162667 0 0 0 21.269333-21.248V512.149333A213.333333 213.333333 0 0 0 682.496 298.666667zM362.666667 469.333333h42.666666a42.666667 42.666667 0 1 1 0 85.333334h-42.666666v42.666666a42.666667 42.666667 0 1 1-85.333334 0v-42.666666h-42.666666a42.666667 42.666667 0 1 1 0-85.333334h42.666666v-42.666666a42.666667 42.666667 0 1 1 85.333334 0v42.666666z m341.333333-21.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m0 213.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m-106.666667-106.666666a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z m213.333334 0a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z">-->
<local:MyListItem.Buttons>
@@ -25,7 +25,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine"
<local:MyListItem x:Name="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine"
LogoScale="1.00" Logo="M439.667 538.133l-323.311-174.763c-6.554-3.641-13.836-5.098-20.389-5.098-23.301 0-45.147 20.389-45.147 48.788v341.516c0 35.681 18.205 67.721 48.060 83.741l323.311 174.763c6.554 3.641 13.836 5.825 20.389 5.825 23.301 0 45.147-21.117 45.147-49.516v-341.516c0-34.953-18.205-67.721-48.060-83.741zM414.909 920.427l-281.805-152.189c-4.369-2.913-9.467-9.467-9.467-19.661v-298.553l281.805 152.189c5.825 3.641 9.467 11.651 9.467 19.661v298.553zM952.304 358.274c-6.554 0-13.836 1.456-20.389 5.098l-323.311 175.491c-29.855 16.020-48.060 48.788-48.060 84.468v340.059c0 28.399 21.845 49.516 45.147 49.516 6.554 0 13.836-1.456 20.389-5.098l323.311-175.491c29.127-16.020 48.060-48.060 48.060-83.741v-341.516c0-28.399-21.845-48.788-45.147-48.788zM924.634 747.849c0 10.194-5.098 17.476-9.467 19.661l-281.805 152.917v-297.097c0-10.194 5.098-17.476 9.467-19.661l281.805-153.646v297.825zM902.060 283.272c15.292-8.010 22.574-21.845 21.117-34.953 1.456-13.836-5.825-26.943-21.117-34.953l-329.136-171.85c-14.563-8.010-31.312-11.651-48.788-11.651 0 0 0 0 0 0 0 0 0 0 0 0s-34.224 3.641-49.516 11.651l-329.865 171.122c-15.292 8.010-21.845 21.845-21.117 35.681-0.729 13.107 5.825 26.943 21.117 34.953l329.136 171.122c14.563 8.010 32.039 11.651 49.516 11.651 0 0 0 0 0.729 0 0 0 0 0 0.729 0s34.224-3.641 49.516-11.651l327.68-171.122zM523.407 393.227c-5.825 0-11.651-1.456-16.020-3.641l-272.338-141.266 272.338-141.995c4.369-2.185 10.194-3.641 16.748-3.641 5.825 0 11.651 1.456 16.020 3.641l272.338 141.995-273.067 141.266c-3.641 2.185-9.467 3.641-16.020 3.641z">
<!--Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z">-->
<local:MyListItem.Buttons>
@@ -34,7 +34,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge"
<local:MyListItem x:Name="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge"
LogoScale="1.00" Logo="M402.807089 481.189274c-12.040221-6.991228-27.412326-2.797719-34.397415 9.242502l-8.387018 14.512529c-6.987135 12.035104-2.793626 27.40721 9.246595 34.392298 12.040221 6.985088 27.408233 2.797719 34.393321-9.242502l8.387018-14.511505C418.930301 503.437997 414.842193 488.063845 402.807089 481.189274L402.807089 481.189274zM495.028467 919.955342 59.056024 919.955342c-18.485003 0-33.532721 15.046694-33.532721 33.536814 0 18.485003 15.046694 33.532721 33.532721 33.532721l435.972443 0c18.49012 0 33.537837-15.046694 33.537837-33.532721C528.566304 935.002037 513.518586 919.955342 495.028467 919.955342L495.028467 919.955342zM997.431901 660.155295 590.482469 446.039729l90.935082-157.474544c18.485003-32.031531 7.520277-73.090669-24.51023-91.581812L395.496589 46.070268c-32.031531-18.485003-73.094762-7.520277-91.579765 24.51023L18.74697 564.277644c-18.485003 32.031531-7.521301 73.089645 24.51023 91.579765l261.408685 150.907988c32.031531 18.491143 73.095785 7.526417 91.581812-24.505114l91.364871-158.330028 392.332527 239.48128c16.016789 9.247618 36.544311 3.76372 45.792952-12.249999l83.838454-145.219429C1019.033895 689.930435 1013.444597 669.39882 997.431901 660.155295L997.431901 660.155295zM355.078041 719.704552c-9.242502 16.012695-29.774117 21.497617-45.787836 12.251022L105.923448 614.57826c-16.016789-9.242502-21.497617-29.774117-12.255115-45.787836l251.522524-435.653171c9.246595-16.012695 29.774117-21.497617 45.792952-12.249999l203.25624 117.376291c16.018835 9.242502 21.497617 29.774117 12.255115 45.786813L355.078041 719.704552 355.078041 719.704552zM884.568391 788.601712 522.115382 564.492538l33.537837-58.048067L934.875147 701.539844 884.568391 788.601712 884.568391 788.601712zM520.184403 277.8174c-12.040221-6.987135-27.41335-2.792603-34.399461 9.246595l-75.456552 130.702807c-6.985088 12.040221-2.791579 27.412326 9.242502 34.397415 12.040221 6.987135 27.412326 2.791579 34.397415-9.242502l75.458599-130.706901C536.307615 300.174594 532.219507 284.807604 520.184403 277.8174L520.184403 277.8174zM520.184403 277.8174">
<!--Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">-->
<local:MyListItem.Buttons>
@@ -43,7 +43,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -51,7 +51,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -60,7 +60,7 @@
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -68,7 +68,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -99,11 +99,13 @@
Case FormMain.PageSubType.DownloadMod
PageDownloadMod.Storage = New CompProjectStorage
PageDownloadMod.Page = 0
CompProjectCache.Clear()
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
PageDownloadPack.Page = 0
CompProjectCache.Clear()
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="LiteLoader 简介" x:Name="CardTip">
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索 Mod" Margin="0,0,0,15" x:Name="PanAlways">
@@ -33,6 +33,10 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.18.2" />
@@ -53,6 +57,7 @@
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320">
@@ -95,6 +100,7 @@
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
@@ -32,9 +32,7 @@
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing,
Loader.Input.ModLoader = CompModLoaderType.Any, AddressOf ProjectClick))
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader = CompModLoaderType.Any))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -48,6 +46,13 @@
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -68,12 +73,6 @@
End Select
End Sub
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
@@ -114,13 +113,18 @@
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
'版本选择
Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged
'#3067:当下拉菜单展开时,程序会被 WPF 挂起,因而无法更新 Grid 布局,所以必须延迟到下拉菜单收起后才能更新
Private Sub TextSearchVersion_TextChanged() Handles TextSearchVersion.TextChanged
If Not TextSearchVersion.IsDropDownOpen Then UpdateSearchLoaderVisibility()
End Sub
Private Sub UpdateSearchLoaderVisibility() Handles TextSearchVersion.DropDownClosed
If TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w") Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadOptiFine"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadOptiFine"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip">
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索整合包" Margin="0,0,0,15" x:Name="PanAlways">
@@ -32,6 +32,10 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.18.2" />
@@ -65,7 +69,7 @@
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB"
ToolTip="该整合包由 FTB 官方发布" ToolTipService.InitialShowDelay="150" ToolTipService.Placement="Right" ToolTipService.VerticalOffset="-1" ToolTipService.HorizontalOffset="-40" />
ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
@@ -85,6 +89,7 @@
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
@@ -31,8 +31,7 @@
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True, AddressOf ProjectClick))
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -46,6 +45,13 @@
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -66,12 +72,6 @@
End Select
End Sub
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
@@ -116,6 +116,7 @@
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
@@ -5,7 +5,7 @@
'皮肤储存
Private _Address As String
Public Property Address() As String
Public Property Address As String
Get
Return _Address
End Get
@@ -76,12 +76,19 @@
''' </summary>
Public Sub Load()
Try
Address = Loader.Output
'检查文件存在
If Address = "" Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
Address = Loader.Output
If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
If Not Address.StartsWith(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
'加载
Dim Image As New MyBitmap(Address)
Dim Image As MyBitmap
Try
Image = New MyBitmap(Address)
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏:{Address}", LogLevel.Hint)
File.Delete(Address)
Exit Sub
End Try
ImgBack.Tag = Address
'大小检查
Dim Scale As Integer = Image.Pic.Width / 64
@@ -97,7 +104,7 @@
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso '或是头部颜色和透明区均不一样
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2) <> Image.Pic.GetPixel(Scale * 41, Scale * 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 40, Scale * 8, Scale * 8, Scale * 8))
ImgFore.Source = Image.Clip(Scale * 40, Scale * 8, Scale * 8, Scale * 8)
Else
ImgFore.Source = Nothing
End If
@@ -105,7 +112,7 @@
ImgFore.Source = Nothing
End If
'脸层
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 8, Scale * 8, Scale * 8, Scale * 8))
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功:" & Loader.Name)
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", LogLevel.Hint)
@@ -138,26 +145,27 @@
'由于 Abort 不是实时的,暂时不会释放文件,会导致删除报错,故只能取消执行
Hint("有正在获取中的皮肤,请稍后再试!", HintType.Info)
Else
RunInThread(Sub()
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
IniClearCache(PathTemp & "Cache\Uuid\Mojang.ini")
'刷新控件
For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs})
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
Hint("已刷新头像!", HintType.Finish)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
IniClearCache(PathTemp & "Cache\Uuid\Mojang.ini")
'刷新控件
For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs})
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
Hint("已刷新头像!", HintType.Finish)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
End Try
End Sub)
End If
End Sub
''' <summary>
@@ -165,21 +173,22 @@
''' </summary>
''' <param name="SkinAddress">新的正版皮肤完整地址。</param>
Public Shared Sub ReloadCache(SkinAddress As String)
RunInThread(Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress))
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
'完成提示
Hint("更改皮肤成功!", HintType.Finish)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
End Try
End Sub)
RunInThread(
Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress))
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
'完成提示
Hint("更改皮肤成功!", HintType.Finish)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
End Try
End Sub)
End Sub
'披风
@@ -209,57 +218,60 @@
Hint("正在获取披风列表,请稍候……")
IsChanging = True
'开始实际获取
RunInNewThread(Sub()
Try
RunInNewThread(
Sub()
Try
Retry:
'获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风
Dim SelId As Integer? = Nothing
RunInUiWait(Sub()
Try
Dim CapeNames As New Dictionary(Of String, String) From {
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"},
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
SelectionControl.Add(New MyRadioBox With {.Text = CapeName})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Exit Sub
'发送请求
Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, "DELETE", "PUT"),
If(SelId = 0, "", "{""capeId"": """ & SkinData("capes")(SelId - 1)("id").ToString & """}"),
"application/json", Headers:=New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage"), HintType.Critical)
Exit Sub
Else
Hint("更改披风成功!", HintType.Finish)
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
Finally
IsChanging = False
End Try
End Sub, "Cape Change")
'获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风
Dim SelId As Integer? = Nothing
RunInUiWait(
Sub()
Try
Dim CapeNames As New Dictionary(Of String, String) From {
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"},
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
SelectionControl.Add(New MyRadioBox With {.Text = CapeName})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Exit Sub
'发送请求
Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, "DELETE", "PUT"),
If(SelId = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelId - 1)("id"))).ToString(0)),
"application/json", Headers:=New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage"), HintType.Critical)
Exit Sub
Else
Hint("更改披风成功!", HintType.Finish)
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
Finally
IsChanging = False
End Try
End Sub, "Cape Change")
End Sub
End Class
@@ -79,7 +79,45 @@
''' 切换至启动中页面。
''' </summary>
Public Sub PageChangeToLaunching()
LaunchingPreload()
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
Case McLoginType.Ms
LabLaunchingMethod.Text = "正版登录"
Case McLoginType.Nide
LabLaunchingMethod.Text = "统一通行证"
Case McLoginType.Auth
LabLaunchingMethod.Text = "Authlib-Injector"
End Select
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Opacity = 0.6
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownload.Text = "0 B/s"
LabLaunchingDownload.Opacity = 0
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Opacity = 0
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
ProgressLaunchingFinished.Width = New GridLength(0, GridUnitType.Star)
ProgressLaunchingUnfinished.Width = New GridLength(1, GridUnitType.Star)
PanLaunchingHint.Opacity = 0
PanLaunchingHint.Visibility = Visibility.Collapsed
PanLaunchingInfo.Width = Double.NaN '重置宽度改变动画
McLaunchProcess = Nothing
McLaunchWatcher = Nothing
'获取 “你知道吗” 提示
LabLaunchingHint.Text = PageOtherTest.GetRandomHint()
'初始化其他页面
PanInput.IsHitTestVisible = False
PanLaunching.IsHitTestVisible = False
LoadLaunching.State.LoadingState = MyLoading.MyLoadingState.Run
@@ -356,7 +394,7 @@ Finish:
Select Case Type
Case 0
If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text, "")}
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")}
ElseIf Setup.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""}
Else
@@ -526,11 +564,13 @@ Finish:
'版本选择按钮
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
If McLaunchLoader.State = LoadState.Loading Then Exit Sub
FrmMain.PageChange(FormMain.PageType.VersionSelect)
End Sub
'启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled Then Exit Sub
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled OrElse
(FrmMain.PageRight IsNot Nothing AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentStay AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentEnter) Then Exit Sub
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!")
@@ -625,61 +665,13 @@ ExitRefresh:
End Try
End If
End Sub
'更多按钮
'版本设置按钮
Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click
If McLaunchLoader.State = LoadState.Loading Then Exit Sub
McVersionCurrent.Load()
PageVersionLeft.Version = McVersionCurrent
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
End Sub
'刷新 UI
Public Sub LaunchingPreload()
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
Case McLoginType.Ms
LabLaunchingMethod.Text = "正版登录"
Case McLoginType.Nide
LabLaunchingMethod.Text = "统一通行证"
Case McLoginType.Auth
LabLaunchingMethod.Text = "Authlib-Injector"
End Select
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Opacity = 0.6
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownload.Text = "0 B/s"
LabLaunchingDownload.Opacity = 0
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Opacity = 0
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
ProgressLaunchingFinished.Width = New GridLength(0, GridUnitType.Star)
ProgressLaunchingUnfinished.Width = New GridLength(1, GridUnitType.Star)
PanLaunchingHint.Opacity = 0
PanLaunchingHint.Visibility = Visibility.Collapsed
PanLaunchingInfo.Width = Double.NaN '重置宽度改变动画
McLaunchProcess = Nothing
McLaunchWatcher = Nothing
'获取 “你知道吗” 提示
Dim Hint As String = PageOtherTest.GetRandomHint()
Try
Dim RawHints = ReadFile(Path & "PCL\hints.txt").Split(vbCrLf.ToCharArray).Where(Function(s) Not String.IsNullOrWhiteSpace(s)).ToList
If RawHints.Count > 0 Then Hint = RandomOne(RawHints)
Catch ex As Exception
Log(ex, "获取自定义 你知道吗 提示失败", LogLevel.Hint)
End Try
LabLaunchingHint.Text = Hint
End Sub
Private ShowProgress As Double = 0
''' <summary>
''' 每 0.2s 执行一次,刷新启动的数据 UI 显示。
''' </summary>
@@ -763,6 +755,7 @@ ExitRefresh:
Log(ex, "刷新启动信息失败", LogLevel.Feedback)
End Try
End Sub
Private ShowProgress As Double = 0
'尺寸改变动画
Private IsWidthAnimating As Boolean = False
Private ActualUsedWidth As Double
@@ -1,18 +1,20 @@
<local:MyPageRight x:Class="PageLaunchRight"
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"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d">
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"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"> <!-- 不知道为啥只有这个文件不能在 XAML 设置 PanScroll -->
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<StackPanel x:Name="PanCustom">
</StackPanel>
<local:MyCard Margin="0,0,0,15" Title="快照版提示" x:Name="PanHint">
<StackPanel Margin="25,40,23,12">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" />
<TextBlock x:Name="LabHint2" TextWrapping="Wrap" Margin="0,0,0,2" />
<local:MyIconButton LogoScale="1.1" 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"
Height="20" Margin="10" HorizontalAlignment="Right" VerticalAlignment="Top"
x:Name="BtnHintClose" />
<StackPanel Margin="25,38,23,15">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
<TextBlock x:Name="LabHint2" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="启动日志" x:Name="PanLog">
@@ -2,101 +2,220 @@
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
PanScroll = PanBack '不知道为啥不能在 XAML 设置
PanLog.Visibility = If(ModeDebug, Visibility.Visible, Visibility.Collapsed)
'刷新主页
If ShouldRefresh Then
ShouldRefresh = False
RefreshCustom()
End If
'快照版提示
#If BETA Then
PanHint.Visibility = Visibility.Collapsed
#Else
PanHint.Title = "快照版提示"
PanHint.Visibility = If(ThemeCheckGold(), Visibility.Collapsed, Visibility.Visible)
LabHint1.Text = "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!如果发现了 Bug,可以在 更多 → 反馈 中提交!"
LabHint2.Text = "你可以通过赞助¥23.33 档位换取解锁码来隐藏这个提示。"
LabHint1.Text = "快照版包含尚未正式发布的测试功能,仅用于赞助者本人尝鲜。请不要发给其他人或者用来制作整合包哦!"
LabHint2.Text = $"若已累积赞助¥23.33,在爱发电私信发送 {vbLQ}解锁码{vbRQ} 即可永久隐藏此提示。"
#End If
End Sub
Private LatestFileContent As String = ""
Private LatestFileLink As String = Nothing
Private IsRefreshing As Boolean = False
Public ShouldRefresh As Boolean = True
'暂时关闭快照版提示
#If Not BETA Then
Private Sub BtnHintClose_Click(sender As Object, e As EventArgs) Handles BtnHintClose.Click
AniDispose(PanHint, True)
End Sub
#End If
#Region "自定义主页"
''' <summary>
''' 刷新自定义的主页。返回是否成功。
''' 刷新自定义主页。
''' </summary>
Private Sub RefreshCustom()
If IsRefreshing Then
ShouldRefresh = True
Exit Sub
End If
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub
Private Sub RefreshReal()
Dim Content As String = ""
Dim Url As String
Select Case Setup.Get("UiCustomType")
Case 1
'加载本地文件
Log("[Page] 主页自定义数据来源:本地文件")
Content = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Case 2
Url = Setup.Get("UiCustomNet")
Download:
'加载联网文件
If String.IsNullOrWhiteSpace(Url) Then Exit Select
If Url = Setup.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then
'缓存可用
Log("[Page] 主页自定义数据来源:联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml")
'后台更新缓存
OnlineLoader.Start(Url)
Else
'缓存不可用
Log("[Page] 主页自定义数据来源:联网全新下载")
Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent("")) '在加载结束前清空页面
Setup.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(Url) '下载完成后将会再次触发更新
Exit Sub
End If
Case 3
Select Case Setup.Get("UiCustomPreset")
Case 0 '你知道吗
Log("[Page] 主页预设:你知道吗")
Content = "
<local:MyCard Title=""你知道吗?"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{hint}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
<local:MyIconButton Height=""22"" Width=""22"" Margin=""9"" VerticalAlignment=""Top"" HorizontalAlignment=""Right""
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 1 '回声洞
Log("[Page] 主页预设:回声洞")
Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{cave}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
<local:MyIconButton Height=""22"" Width=""22"" Margin=""9"" VerticalAlignment=""Top"" HorizontalAlignment=""Right""
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 2 '新闻
Log("[Page] 主页预设:Minecraft 新闻")
Url = "http://pcl.mcnews.thestack.top"
GoTo Download
Case 3 '简单主页
Log("[Page] 主页预设:简单主页")
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4 '历史上的今天
Log("[Page] 主页预设:历史上的今天")
Url = "https://pclnews.52chye.cn/custom.xaml"
GoTo Download
End Select
End Select
RunInUi(Sub() LoadContent(Content))
End Sub
Private RefreshLock As New Object
'联网获取自定义主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Try
IsRefreshing = True
PanCustom.Children.Clear()
RunInNewThread(Sub()
Dim FileContent As String = ""
Select Case Setup.Get("UiCustomType")
Case 0
'啥也不干
Case 1
'加载本地文件
FileContent = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Log("[System] 尝试从本地文件读取主页自定义数据(" & FileContent.Length & ")")
Case 2
'加载联网文件
Try
Dim Link As String = Setup.Get("UiCustomNet")
If Link = LatestFileLink Then
FileContent = LatestFileContent
Log("[System] 尝试缓存加载主页自定义数据(" & FileContent.Length & ")")
ElseIf Not String.IsNullOrWhiteSpace(Link) Then
Log("[System] 开始从网络读取主页自定义数据(" & Link & ")")
FileContent = NetGetCodeByRequestRetry(Link)
Log("[System] 尝试从网络读取主页自定义数据(" & FileContent.Length & ")")
End If
LatestFileLink = Link
LatestFileContent = FileContent
Catch ex As Exception
Log(ex, "获取 PCL 主页自定义信息失败", LogLevel.Msgbox)
LatestFileLink = ""
End Try
End Select
If FileContent = "" Then
IsRefreshing = False
Exit Sub
End If
FileContent = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & FileContent & "</StackPanel>"
FileContent = FileContent.Replace("{path}", Path)
RunInUi(Sub()
Try
Log("[System] 加载主页自定义数据")
PanCustom.Children.Add(GetObjectFromXML(FileContent))
IsRefreshing = False
Catch ex As Exception
IsRefreshing = False
Log("[System] 自定义信息内容:" & vbCrLf & FileContent)
If MyMsgBox(ex.Message, "加载自定义主页失败", "重试", "取消") = 1 Then
LatestFileLink = Nothing
LatestFileContent = ""
RefreshCustom()
End If
End Try
End Sub)
End Sub, "主页自定义刷新")
'获取版本校验地址
Dim VersionAddress As String
If Task.Input.Contains(".xaml") Then
VersionAddress = Task.Input.Replace(".xaml", ".xaml.ini")
Else
VersionAddress = Task.Input.Split("?").First
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version"
If Task.Input.Contains("?") Then VersionAddress += Task.Input.Split("?").Last
End If
'校验版本
Dim Version As String = ""
Dim NeedDownload As Boolean = True
Try
Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000)
If Version.Length > 100 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
NeedDownload = False
Else
Log($"[Page] 需要下载联网自定义主页,当前版本:{Version},检查源:{VersionAddress}")
End If
Catch exx As Exception
Log(exx, $"联网获取自定义主页版本失败", LogLevel.Developer)
Log($"[Page] 无法检查联网自定义主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
If NeedDownload Then
Dim FileContent As String = NetGetCodeByRequestRetry(Task.Input)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Task.Input}")
Setup.Set("CacheSavedPageUrl", Task.Input)
Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
End If
'要求刷新
Refresh()
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
IsRefreshing = False
If Setup.Get("CacheSavedPageVersion") = "" Then
Log(ex, $"联网下载自定义主页失败({Task.Input})", LogLevel.Msgbox)
Else
Log(ex, $"联网下载自定义主页失败({Task.Input})")
End If
Task.Input = ""
End Try
End Sub
Public Sub ForceRefresh(Optional ShowHint As Boolean = True)
ShouldRefresh = True
LatestFileContent = ""
LatestFileLink = Nothing
If ShowHint Then Hint("已刷新主页!", HintType.Finish)
FrmMain.PageChange(FormMain.PageType.Launch)
Init()
''' <summary>
''' 立即强制刷新自定义主页。
''' 必须在 UI 线程调用。
''' </summary>
Public Sub ForceRefresh()
Log("[Page] 要求强制刷新自定义主页")
ClearCache()
'实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
PanBack.ScrollToHome()
Refresh()
Else
FrmMain.PageChange(FormMain.PageType.Launch)
End If
End Sub
''' <summary>
''' 清空自定义主页缓存信息。
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = ""
Setup.Set("CacheSavedPageUrl", "")
Setup.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空自定义主页缓存")
End Sub
''' <summary>
''' 从文本内容中加载自定义主页。
''' 必须在 UI 线程调用。
''' </summary>
Private Sub LoadContent(Content As String)
SyncLock LoadContentLock
'如果加载目标内容一致则不加载
Dim Hash = Content.GetHashCode()
If Hash = LoadedContentHash Then Exit Sub
LoadedContentHash = Hash
'实际加载内容
PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化:清空自定义主页 UI,来源为空")
Return
End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI,最终内容长度:{Content.Count}")
Try
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
Log("[Page] 加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.Message}", "加载自定义主页失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁
End If
End Try
End SyncLock
Return
Refresh:
ForceRefresh()
End Sub
Private LoadedContentHash As Integer = -1
Private LoadContentLock As New Object
#End Region
End Class
@@ -17,7 +17,7 @@ Public Class PageLoginLegacy
Public Sub Reload(KeepInput As Boolean)
If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text
Dim Input As String = ComboName.Text.Trim
ComboName.ItemsSource = If(Setup.Get("LoginLegacyName") = "", Nothing, Setup.Get("LoginLegacyName").ToString.Split("¨"))
ComboName.Text = Input
Else
@@ -26,7 +26,7 @@ Public Class PageLoginLegacy
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0)
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0).Trim
End If
End If
IsReloaded = True
@@ -50,17 +50,14 @@ Public Class PageLoginLegacy
Return IsVaild(GetLoginData())
End Function
Private Sub ComboName_PreviewKeyDown(sender As Object, e As Input.KeyEventArgs) Handles ComboName.PreviewKeyDown
If e.Key = Key.Space Then
Dim Index = CType(ComboName.Template.FindName("PART_EditableTextBox", ComboName), MyTextBox).CaretIndex
If Index = ComboName.Text.Length OrElse Index = 0 Then e.Handled = True
End If
End Sub
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If ComboName.Text.EndsWith(" ") Then
ComboName.Text = ComboName.Text.Trim()
SendKeys.SendWait("{END}")
ElseIf ComboName.Text.StartsWith(" ") Then
ComboName.Text = ComboName.Text.Trim()
SendKeys.SendWait("{HOME}")
End If
If Setup.Get("LaunchSkinType") = 0 Then
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
End If
If Setup.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
End Sub
Private Sub Skin_Click() Handles Skin.Click
@@ -29,7 +29,7 @@
</Grid.ColumnDefinitions>
<local:MyTextButton Text="» 购买正版" EventType="打开网页" EventData="https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"
Grid.Column="0" />
<local:MyTextButton Text="» 老账号迁移" x:Name="BtnMigration"
<local:MyTextButton Text="» 前往官网" EventType="打开网页" EventData="https://www.minecraft.net/zh-hans"
Grid.Column="2" />
</Grid>
</Grid>
@@ -101,10 +101,5 @@
End Try
End Sub, "Ms Login")
End Sub
'账号迁移入口
Private Sub BtnMigration_Click(sender As Object, e As EventArgs) Handles BtnMigration.Click
MyMsgBox("在迁移过程中,你可能需要设置你的档案信息,此时请注意让年龄大于 18 岁,否则可能导致无法登录!", "迁移提示", "继续", ForceWait:=True)
OpenWebsite("https://www.minecraft.net/zh-hans/account-security")
End Sub
End Class
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkFeedback"
d:DesignWidth="800" d:DesignHeight="800">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkFeedback"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<local:MyCard Title="关于" Margin="0,0,0,15">
@@ -14,23 +14,23 @@
Margin="0,0,0,6" />
<local:MyListItem Title="速聚官网" Info="打开速聚的官方网站"
Type="Clickable" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="授权协议书" Info="查看速聚与 PCL 间的授权协议书"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/0l3NVXYzeXhb903R"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="用户协议与隐私政策" Info="查看速聚的用户协议与隐私政策文档"
Type="Clickable" EventType="打开网页" EventData="https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkxMTMyODk3Mg==&amp;action=getalbum&amp;album_id=2585385685407514625&amp;scene=173&amp;from_msgid=2247483720&amp;from_itemidx=1&amp;count=3&amp;nolastread=1#wechat_redirect"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
Logo="pack://application:,,,/images/Blocks/Grass.png" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="发送反馈" Margin="0,0,0,15">
<StackPanel Margin="20,40,18,18">
<local:MyListItem Title="联机反馈与交流" Info="加入联机模块官方 QQ 群反馈联机异常,或询问联机功能的使用方式"
Type="Clickable" PaddingRight="20" Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png"
Type="Clickable" Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png"
EventType="打开网页" EventData="https://shimo.im/docs/KrkEVXz1K0frowAJ#anchor-7qQG" />
<local:MyListItem Title="违法违规举报" Info="投诉、举报联机使用者的各类违法违规行为"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW#anchor-7x6P"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png" />
Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png" />
</StackPanel>
</local:MyCard>
</StackPanel>
@@ -17,6 +17,7 @@
Private IsLoad As Boolean = False
Private Sub OnLoaded() Handles Me.Loaded
FormMain.EndProgramForce(Result.Aborted)
If IsLoad Then Exit Sub
IsLoad = True
'启动监视线程
@@ -196,7 +197,7 @@ Reopen:
GoTo FinishHiperFileCheck
End If
Log("[Hiper] hiper.exe 的所需 SHA1:" & ChecksumHiper)
If ChecksumHiper = GetAuthSHA1(PathHiper & "HiPer 联机模块.exe") Then
If ChecksumHiper = GetFileSHA1(PathHiper & "HiPer 联机模块.exe") Then
Log("[Hiper] hiper.exe 文件校验通过,无需重新下载")
GoTo FinishHiperFileCheck
End If
@@ -232,7 +233,7 @@ FinishHiperFileCheck:
GoTo FinishWintunFileCheck
End If
Log("[Hiper] wintun.dll 的所需 SHA1:" & ChecksumWintun)
If ChecksumWintun = GetAuthSHA1(PathHiper & "wintun.dll") Then
If ChecksumWintun = GetFileSHA1(PathHiper & "wintun.dll") Then
Log("[Hiper] wintun.dll 文件校验通过,无需重新下载")
GoTo FinishWintunFileCheck
End If
@@ -268,7 +269,7 @@ FinishWintunFileCheck:
GoTo FinishMcbFileCheck
End If
Log("[Hiper] mcb.exe 的所需 SHA1:" & ChecksumMcb)
If ChecksumMcb = GetAuthSHA1(PathHiper & "MCB 联机模块.exe") Then
If ChecksumMcb = GetFileSHA1(PathHiper & "MCB 联机模块.exe") Then
Log("[Hiper] mcb.exe 文件校验通过,无需重新下载")
GoTo FinishMcbFileCheck
End If
@@ -1,10 +1,10 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:System="clr-namespace:System;assembly=mscorlib"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkIoi"
d:DesignWidth="800" d:DesignHeight="800">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:System="clr-namespace:System;assembly=mscorlib"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageLinkIoi"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25,10">
@@ -11,6 +11,7 @@ Public Class PageLinkIoi
'页面初始化
Private IsLoad As Boolean = False
Private Sub MeLoaded() Handles Me.Loaded
FormMain.EndProgramForce(Result.Aborted)
'重复加载部分
PanBack.ScrollToHome()
@@ -132,7 +133,7 @@ StartDownload:
Log("[IOI] 解压联机模块以完成下载")
If File.Exists(PathTemp & "ioi.exe") Then File.Delete(PathTemp & "ioi.exe")
If File.Exists(PathIoi) Then File.Delete(PathIoi)
Compression.ZipFile.ExtractToDirectory(PathTemp & "联机模块.zip", PathTemp)
ExtractFile(PathTemp & "联机模块.zip", PathTemp)
File.Delete(PathTemp & "联机模块.zip")
CopyFile(PathTemp & "ioi.exe", PathIoi)
File.Delete(PathTemp & "ioi.exe")
@@ -850,7 +851,6 @@ Done:
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
.Title = DisplayName, .Height = 42, .Tag = Me, .Type = MyListItem.CheckType.None,
.PaddingRight = 60,
.Logo = "pack://application:,,,/images/Blocks/Grass.png"}
'绑定图标按钮
Dim BtnRefresh As New MyIconButton With {.Logo = Logo.IconButtonRefresh, .LogoScale = 0.85, .ToolTip = "刷新", .Tag = Me}
@@ -940,7 +940,7 @@ Done:
End Function
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
.Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me, .PaddingRight = If(IsOwner, 60, 0),
.Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me,
.Type = If(IsOwner, MyListItem.CheckType.None, MyListItem.CheckType.Clickable),
.Logo = "pack://application:,,,/images/Blocks/" & If(IsOwner, "GrassPath", "Grass") & ".png"}
If IsOwner Then
@@ -7,7 +7,7 @@
mc:Ignorable="d" AnimatedControl="{Binding ElementName=PanItem}" MinWidth="150">
<StackPanel Orientation="Vertical" x:Name="PanItem" Margin="0,12,0,0">
<TextBlock Text="联机方式" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemHiper" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="HiPer"
<local:MyListItem x:Name="ItemHiper" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="HiPer"
LogoScale="0.85" Logo="M554.496 170.496c141.312 0 256 114.688 256 256s-114.688 256-256 256H402.432c-22.016-1.536-39.424-19.968-39.424-42.496a42.391 42.391 0 0 1 42.496-42.496h149.504c94.208 0 170.496-76.288 170.496-170.496S648.704 256 554.496 256h-256C204.288 256 128 332.288 128 426.496c0 38.4 12.8 73.728 33.792 102.4 5.632 7.168 8.704 15.872 8.704 25.6A42.391 42.391 0 0 1 128 596.992c-11.264 0-20.992-4.096-28.672-11.264l-0.512 0.512c-35.328-44.032-56.32-99.328-56.32-159.744 0-141.312 114.688-256 256-256h256z m64 192h3.072c22.016 1.536 39.424 19.968 39.424 42.496a42.391 42.391 0 0 1-42.496 42.496H469.504c-94.208 0-170.496 76.288-170.496 170.496S375.296 788.48 469.504 788.48h256C819.712 788.48 896 712.192 896 617.984c0-38.4-12.8-73.728-33.792-102.4-5.632-7.168-8.704-15.872-8.704-25.6A42.391 42.391 0 0 1 896 447.488c11.264 0 20.992 4.096 28.672 11.264l0.512-0.512c35.328 44.032 56.32 99.328 56.32 159.744 0 141.312-114.688 256-256 256h-256c-141.312 0-256-114.688-256-256s114.688-256 256-256h148.992z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -17,7 +17,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemIoi" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="2" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="IOI"
<local:MyListItem x:Name="ItemIoi" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="IOI"
LogoScale="0.85" Logo="M554.496 170.496c141.312 0 256 114.688 256 256s-114.688 256-256 256H402.432c-22.016-1.536-39.424-19.968-39.424-42.496a42.391 42.391 0 0 1 42.496-42.496h149.504c94.208 0 170.496-76.288 170.496-170.496S648.704 256 554.496 256h-256C204.288 256 128 332.288 128 426.496c0 38.4 12.8 73.728 33.792 102.4 5.632 7.168 8.704 15.872 8.704 25.6A42.391 42.391 0 0 1 128 596.992c-11.264 0-20.992-4.096-28.672-11.264l-0.512 0.512c-35.328-44.032-56.32-99.328-56.32-159.744 0-141.312 114.688-256 256-256h256z m64 192h3.072c22.016 1.536 39.424 19.968 39.424 42.496a42.391 42.391 0 0 1-42.496 42.496H469.504c-94.208 0-170.496 76.288-170.496 170.496S375.296 788.48 469.504 788.48h256C819.712 788.48 896 712.192 896 617.984c0-38.4-12.8-73.728-33.792-102.4-5.632-7.168-8.704-15.872-8.704-25.6A42.391 42.391 0 0 1 896 447.488c11.264 0 20.992 4.096 28.672 11.264l0.512-0.512c35.328 44.032 56.32 99.328 56.32 159.744 0 141.312-114.688 256-256 256h-256c-141.312 0-256-114.688-256-256s114.688-256 256-256h148.992z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -28,17 +28,17 @@
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="更多选项" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemSetup" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="设置"
<local:MyListItem x:Name="ItemSetup" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="设置"
LogoScale="0.85" 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:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="5" ToolTip="初始化设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="5" ToolTip="初始化设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemHelp" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="5" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="常见问题"
<local:MyListItem x:Name="ItemHelp" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="常见问题"
LogoScale="0.97" Logo="M520.6 620.3c-11.3-0.6-20.1-4-26.9-10.5-6.6-6.3-8.1-11-10.1-20.8-1.9-9.5-1.5-16.7-1-24.9l0.3-5.3c0.5-9.9 3.5-19.6 8.8-28.1 5.7-9 12.5-17.2 20.8-25.1 8.6-8 17.7-15.7 27-22.9 9.4-7.2 18.7-14.8 27.7-22.7 9-7.9 16.2-15.8 22.1-24.3 6.2-9 9.3-18.8 9.3-29.4 1.2-20.3-6.5-37.7-22.8-51.3-16-13.3-37.4-20-63.5-20-13.7 0-26.3 3.3-37.4 10-10.9 6.5-20.2 14.5-27.7 23.8-7.5 9.2-13.5 19-17.9 29.2-4.5 10.6-6.7 19.4-6.7 26.8 0 9.2-3.3 16-10.1 20.8-6.9 4.8-14.6 7.3-22.8 7.3h-1.3c-9-0.3-17-3.3-24.6-9.2-7.3-5.6-11.1-14.6-11.6-27.5-0.6-11.5 1.9-26.1 7.2-43.5 5.4-17.4 14.8-34.4 28.1-50.5 13.4-16.3 31.2-30.4 52.8-41.8 21.6-11.4 49.2-17.2 81.9-17.2 26.4 0 49.6 3.9 69.1 11.7 19.4 7.7 35.4 18.2 47.5 31.1l1.6 1.7c11.8 12.6 20.3 21.7 29.4 44.4 11.6 28.9 7.1 52.1 5.5 58.5-5.8 22.6-12.6 37.7-22.7 50.4-11.7 14.6-24.9 28.2-39.2 40.4-14 11.7-39.2 33.3-39.2 33.3-13.3 11.4-19.4 22.1-18.6 32.9V587c0.5 8.7-2.4 16.1-8.8 22.8-6.2 6.4-14.8 10-26.2 10.5zM519 766.1c-13 0-23.6-4.2-32.2-12.9-8.7-8.7-13-19-13-31.4 0-12.9 4.2-23.5 12.9-32.2 8.7-8.7 19.2-12.9 32.2-12.9 13 0 23.5 4.2 32.2 12.9s12.9 19.2 12.9 32.2c0 12.4-4.2 22.7-12.9 31.4-8.6 8.6-19.2 12.9-32.1 12.9z M515 928.3c-228.1 0-413.7-185.6-413.7-413.7S286.9 100.9 515 100.9s413.7 185.6 413.7 413.7c0.1 228.1-185.5 413.7-413.7 413.7z m0-747.4c-184 0-333.7 149.7-333.7 333.7S331 848.3 515 848.3s333.7-149.7 333.7-333.7S699 180.9 515 180.9z" />
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="6" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="关于与反馈"
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="关于与反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
</StackPanel>
</local:MyPageLeft>
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageOtherHelp"
d:DesignWidth="800" d:DesignHeight="800">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageOtherHelp"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer Visibility="Collapsed" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
@@ -1,10 +1,10 @@
<local:MyPageRight x:Class="PageOtherHelpDetail"
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"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d">
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"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanCustom" Margin="25,25,25,10">
<StackPanel.Resources>
@@ -14,7 +14,7 @@
If String.IsNullOrEmpty(Entry.XamlContent) Then Throw New Exception("帮助 xaml 文件为空")
Me.Entry = Entry
PanCustom.Children.Clear()
FileContent = FileContent.Replace("{path}", Path)
FileContent = HelpArgumentReplace(FileContent)
PanCustom.Children.Add(GetObjectFromXML(FileContent))
Return True
Catch ex As Exception
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<local:MyListItem x:Name="ItemHelp" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="帮助"
<local:MyListItem x:Name="ItemHelp" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="帮助"
LogoScale="0.97" Logo="M520.6 620.3c-11.3-0.6-20.1-4-26.9-10.5-6.6-6.3-8.1-11-10.1-20.8-1.9-9.5-1.5-16.7-1-24.9l0.3-5.3c0.5-9.9 3.5-19.6 8.8-28.1 5.7-9 12.5-17.2 20.8-25.1 8.6-8 17.7-15.7 27-22.9 9.4-7.2 18.7-14.8 27.7-22.7 9-7.9 16.2-15.8 22.1-24.3 6.2-9 9.3-18.8 9.3-29.4 1.2-20.3-6.5-37.7-22.8-51.3-16-13.3-37.4-20-63.5-20-13.7 0-26.3 3.3-37.4 10-10.9 6.5-20.2 14.5-27.7 23.8-7.5 9.2-13.5 19-17.9 29.2-4.5 10.6-6.7 19.4-6.7 26.8 0 9.2-3.3 16-10.1 20.8-6.9 4.8-14.6 7.3-22.8 7.3h-1.3c-9-0.3-17-3.3-24.6-9.2-7.3-5.6-11.1-14.6-11.6-27.5-0.6-11.5 1.9-26.1 7.2-43.5 5.4-17.4 14.8-34.4 28.1-50.5 13.4-16.3 31.2-30.4 52.8-41.8 21.6-11.4 49.2-17.2 81.9-17.2 26.4 0 49.6 3.9 69.1 11.7 19.4 7.7 35.4 18.2 47.5 31.1l1.6 1.7c11.8 12.6 20.3 21.7 29.4 44.4 11.6 28.9 7.1 52.1 5.5 58.5-5.8 22.6-12.6 37.7-22.7 50.4-11.7 14.6-24.9 28.2-39.2 40.4-14 11.7-39.2 33.3-39.2 33.3-13.3 11.4-19.4 22.1-18.6 32.9V587c0.5 8.7-2.4 16.1-8.8 22.8-6.2 6.4-14.8 10-26.2 10.5zM519 766.1c-13 0-23.6-4.2-32.2-12.9-8.7-8.7-13-19-13-31.4 0-12.9 4.2-23.5 12.9-32.2 8.7-8.7 19.2-12.9 32.2-12.9 13 0 23.5 4.2 32.2 12.9s12.9 19.2 12.9 32.2c0 12.4-4.2 22.7-12.9 31.4-8.6 8.6-19.2 12.9-32.1 12.9z M515 928.3c-228.1 0-413.7-185.6-413.7-413.7S286.9 100.9 515 100.9s413.7 185.6 413.7 413.7c0.1 228.1-185.5 413.7-413.7 413.7z m0-747.4c-184 0-333.7 149.7-333.7 333.7S331 848.3 515 848.3s333.7-149.7 333.7-333.7S699 180.9 515 180.9z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -11,13 +11,13 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemAbout" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="28" Height="36" VerticalAlignment="Top" Title="关于与鸣谢"
<local:MyListItem x:Name="ItemAbout" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="关于与鸣谢"
LogoScale="0.98" Logo="M149.883623 873.911618c47.094581 47.094581 101.765247 83.95121 162.783444 109.75085 63.065787 26.618676 130.226755 40.337532 199.230553 40.337532 69.003799 0 136.164767-13.514097 199.230554-40.337532 61.018196-25.79964 115.688862-62.656269 162.783444-109.75085s83.95121-101.765247 109.75085-162.783444c26.618676-63.065787 40.337532-130.226755 40.337532-199.230554 0-69.003799-13.514097-136.164767-40.337532-199.230553-25.79964-61.018196-62.656269-115.688862-109.75085-162.783444-46.889822-46.889822-101.765247-83.95121-162.783444-109.75085C648.062388 13.514097 580.90142 0 511.89762 0s-136.164767 13.514097-199.230553 40.337532c-61.018196 25.79964-115.688862 62.656269-162.783444 109.75085s-83.95121 101.765247-109.75085 162.783444C13.514097 375.732853 0 442.893821 0 511.89762s13.514097 136.164767 40.337532 199.230554c25.594881 61.018196 62.656269 115.688862 109.546091 162.783444zM97.670066 511.89762c0-228.511098 185.921216-414.227554 414.227554-414.227554 228.511098 0 414.227554 185.921216 414.227555 414.227554S740.408718 926.125175 511.89762 926.125175c-228.511098 0-414.227554-185.716457-414.227554-414.227555z M539.130574 244.277544c-8.190362-4.709458-17.609278-7.371326-27.232954-7.371325-9.623675 0-19.042591 2.457109-27.232953 7.371325-16.790242 9.623675-27.232953 27.847231-27.232953 47.299341 0 30.09958 24.366327 54.465907 54.465906 54.465906 30.09958 0 54.465907-24.366327 54.465907-54.465906 0-19.45211-10.442711-37.470906-27.232953-47.299341zM566.363527 732.218356v-284.615077c0-30.09958-24.366327-54.465907-54.465907-54.465906-30.09958 0-54.465907 24.366327-54.465906 54.465906v284.615077c0 30.09958 24.366327 54.465907 54.465906 54.465907 30.09958 0 54.465907-24.366327 54.465907-54.465907z" />
<local:MyListItem x:Name="ItemTest" IsScaleAnimationEnabled="False" Tag="2" PaddingRight="35" Type="RadioBox" Height="36" VerticalAlignment="Top" Title="百宝箱"
<local:MyListItem x:Name="ItemTest" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Type="RadioBox" Height="36" VerticalAlignment="Top" Title="百宝箱"
LogoScale="0.97" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z" />
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="Clickable" Tag="3" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="Clickable" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="Clickable" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="Clickable" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
LogoScale="0.92" Logo="M979 1024H45c-24.9 0-45-20.1-45-45s20.1-45 45-45h934c24.9 0 45 20.1 45 45s-20.1 45-45 45zM135 887C60.6 887 0 826.4 0 752V334c0-74.4 60.6-135 135-135s135 60.6 135 135v418c0 74.4-60.6 135-135 135z m0-598c-24.8 0-45 20.2-45 45v418c0 24.8 20.2 45 45 45s45-20.2 45-45V334c0-24.8-20.2-45-45-45zM512 887c-74.4 0-135-60.6-135-135V532c0-74.4 60.6-135 135-135s135 60.6 135 135v220c0 74.4-60.6 135-135 135z m0-400c-24.8 0-45 20.2-45 45v220c0 24.8 20.2 45 45 45s45-20.2 45-45V532c0-24.8-20.2-45-45-45zM889 887c-74.4 0-135-60.6-135-135V135C754 60.6 814.6 0 889 0s135 60.6 135 135v617c0 74.4-60.6 135-135 135z m0-797c-24.8 0-45 20.2-45 45v617c0 24.8 20.2 45 45 45s45-20.2 45-45V135c0-24.8-20.2-45-45-45z" />
</StackPanel>
</local:MyPageLeft>
@@ -71,7 +71,7 @@
CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click))
CType(ContMenu.FindName("Refresh"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Refresh_Click))
'构建框架与图表按钮
Dim NewItem As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.RadioBox, .PaddingRight = 30, .Title = Folder.Name, .Info = Folder.Path, .Height = 40, .ContextMenu = ContMenu, .Tag = Folder}
Dim NewItem As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.RadioBox, .MinPaddingRight = 30, .Title = Folder.Name, .Info = Folder.Path, .Height = 40, .ContextMenu = ContMenu, .Tag = Folder}
AddHandler NewItem.Changed, AddressOf FrmSelectLeft.Folder_Change
Dim NewIconButton As New MyIconButton With {.Logo = Logo.IconButtonSetup, .LogoScale = 1.1}
AddHandler NewIconButton.Click, Sub(sender, e)
@@ -259,6 +259,7 @@
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
Setup.Set("LaunchFolderSelect", "$.minecraft\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
Hint("新建 .minecraft 文件夹成功!", HintType.Finish)
End If
McFolderListLoader.Start(IsForceRestart:=True)
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSelectRight"
d:DesignWidth="800" d:DesignHeight="800">
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSelectRight"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<Grid x:Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
@@ -111,7 +111,7 @@
End Try
End Sub
Public Shared Function McVersionListItem(Version As McVersion) As MyListItem
Dim NewItem As New MyListItem With {.Title = Version.Name, .Info = Version.Info, .Height = 42, .Tag = Version, .PaddingRight = 78, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
Dim NewItem As New MyListItem With {.Title = Version.Name, .Info = Version.Info, .Height = 42, .Tag = Version, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable}
Try
If Version.Logo.EndsWith("PCL\Logo.png") Then
NewItem.Logo = Version.Path & "PCL\Logo.png" '修复老版本中,存储的自定义 Logo 使用完整路径,导致移动后无法加载的 Bug
@@ -219,11 +219,12 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True)
Case 1
IniClearCache(Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Version.Path)
Hint("版本 " & Version.Name & " 已永久删除!", HintType.Finish)
Else
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除到回收站!", HintType.Finish)
End If
Case 2
@@ -251,6 +252,8 @@
'同时出现在当前卡片与收藏夹
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Version.Name & " 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & Version.Name & " 失败", LogLevel.Msgbox)
End Try
@@ -1,10 +1,10 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageSetupLaunch"
d:DesignWidth="800" d:DesignHeight="800">
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"
xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageSetupLaunch"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤">
@@ -127,7 +127,7 @@
<local:MyComboBoxItem Content="全屏" />
<local:MyComboBoxItem Content="默认大小" IsSelected="True" ToolTip="以 854×480 的默认窗口大小启动 Minecraft" />
<local:MyComboBoxItem Content="与启动器窗口大小一致" />
<local:MyComboBoxItem Content="自定义大小" ToolTip="注意:Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" />
<local:MyComboBoxItem Content="自定义大小" ToolTip="注意:Forge 1.12 存在 Bug,会导致高度设定无效" />
<local:MyComboBoxItem Content="最大化" />
<local:MyComboBoxItem Content="保持游戏默认" />
</local:MyComboBox>
@@ -165,7 +165,7 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="游戏内存">
<StackPanel Margin="25,40,25,15">
<local:MyHint x:Name="LabRamWarn" CanClose="False" Text="32 位 Java 最多只能分配 1 GB 内存,建议安装 64 位 Java!" IsWarn="True" Margin="0,0,0,12" />
<local:MyHint x:Name="LabRamWarn" Text="32 位 Java 最多只能分配 1 GB 内存,建议安装 64 位 Java!" IsWarn="True" Margin="0,0,0,12" />
<Grid Margin="0,0,0,3">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
@@ -213,7 +213,7 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="高级设置" IsSwaped="True" CanSwap="True">
<local:MyCard Margin="0,0,0,15" Title="高级启动选项" IsSwaped="True" CanSwap="True">
<Grid Margin="25,40,25,15">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
@@ -240,9 +240,9 @@
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<StackPanel Margin="0,12,0,4" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
<local:MyCheckBox Text="忽略 Java 兼容性警告" x:Name="CheckAdvanceJava" Tag="LaunchAdvanceJava" Margin="0,0,60,0"
ToolTip="如果在设置中手动选择了与当前版本不兼容的 Java,则自动跳过兼容性警告弹窗,强制使用手动选择的 Java。" />
ToolTip="警告:强烈推荐在版本设置中关闭特定版本的警告,而不是在这里关闭所有版本的警告!&#xa;如果在设置中手动选择了与当前版本不兼容的 Java,则自动跳过兼容性警告弹窗,强制使用手动选择的 Java。" />
<local:MyCheckBox Text="关闭文件校验" x:Name="CheckAdvanceAssets" Tag="LaunchAdvanceAssets"
ToolTip="完全不更改 assets;不校验 libraries、第三方登录库与版本主 jar 文件是否被修改。&#xa;如果你没有修改相关文件,请勿勾选此项。&#xa;强烈推荐在版本设置中关闭特定版本的校验,而不是在这里关闭所有版本的校验。" />
ToolTip="警告:强烈推荐在版本设置中关闭特定版本的校验,而不是在这里关闭所有版本的校验!&#xa;完全不更改 assets;不校验 libraries、第三方登录库与版本主 jar 文件是否被修改。&#xa;如果你没有修改相关文件,请勿勾选此项。" />
</StackPanel>
</Grid>
</local:MyCard>
@@ -196,7 +196,7 @@
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable)
Dim RamUsed As Double = RamTotal - RamAvailable
Dim RamEmpty As Double = Math.Round(MathRange(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
@@ -433,7 +433,7 @@ PreFin:
Try
For Each Java In Sort(JavaList.Clone(), Function(l, r) l.VersionCode < r.VersionCode)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
ToolTipService.SetHorizontalOffset(ListItem, 0)
ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem)
'判断人为选中
If SelectedBySetup = "" Then Continue For
@@ -4,34 +4,34 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="PageSetupLeft"
d:DesignWidth="152" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" x:Name="PanItem">
<local:MyListItem x:Name="ItemLaunch" IsScaleAnimationEnabled="False" Checked="True" Tag="0" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="游戏" Type="RadioBox"
<local:MyListItem x:Name="ItemLaunch" IsScaleAnimationEnabled="False" Checked="True" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="游戏" Type="RadioBox"
LogoScale="1" Logo="M924.009688 527.92367C875.975633 601.905321 808.729835 663.317138 733.564477 712.920073 726.302532 832.878385 665.670459 944.569541 567.084624 1015.075229 558.826862 1020.965578 549.065982 1024 539.239339 1024 533.048367 1024 526.829211 1022.806899 520.929468 1020.373725 505.663413 1014.023046 494.709431 1000.278899 491.966239 983.941872 484.67611 940.755376 465.361028 892.899817 436.876917 844.546349 404.954422 853.283229 373.980771 860.385468 344.970569 865.420917 342.227376 865.92822 339.484183 866.144294 336.75978 866.144294 324.142972 866.144294 311.920734 861.174606 302.855046 852.061945L172.807046 721.685138C161.768514 710.637211 156.789431 694.863853 159.466862 679.466275 164.502312 650.390312 171.576367 619.341505 180.27567 587.362642 132.100697 558.822165 84.376661 539.450716 41.302899 532.151193 25.00345 529.370422 11.287486 518.41644 4.98378 503.103413-1.319927 487.809174 0.662312 470.316624 10.254092 456.826128 80.581284 357.958459 191.971817 297.185468 311.591927 289.857761 361.053945 214.495119 422.31545 147.061431 496.081028 98.895853 636.030826 7.54378 802.350972 0 974.730569 0 1001.223046 0 1022.680073 21.494606 1022.680073 48.034055 1022.680073 213.997211 1015.061138 387.72022 924.009688 527.92367ZM558.122275 918.528C601.506055 876.187009 631.784514 822.328367 645.81989 763.744294 602.680367 785.86833 558.563817 804.553982 515.067303 819.989138 533.358385 853.161101 548.023193 886.267303 558.122275 918.528ZM106.566459 465.807266C138.705028 475.915743 171.717284 490.627523 204.804697 508.937394 220.192881 465.337541 238.803376 421.117651 260.871046 377.865394 202.493651 391.947743 148.822899 422.282569 106.566459 465.807266ZM548.398972 179.444257C395.794789 279.09167 294.681835 493.94378 258.522422 671.678239L352.749211 766.121101C530.00455 729.877138 744.283596 628.510532 843.667963 475.474202 912.557798 369.39156 924.742459 236.562789 926.527413 96.387523 786.699743 98.172477 654.227963 110.385321 548.398972 179.444257ZM687.071119 416.617688C642.93578 416.617688 607.161541 380.74011 607.161541 336.492037 607.161541 292.234569 642.93578 256.37578 687.071119 256.37578 731.206459 256.37578 766.971303 292.234569 766.971303 336.492037 766.971303 380.74011 731.206459 416.617688 687.071119 416.617688ZM67.222312 858.008661C77.171083 825.118532 107.646826 801.171963 143.702899 801.171963 187.838239 801.171963 223.603083 837.040147 223.603083 881.297615 223.603083 917.438239 199.722275 948.017321 166.926092 957.975486L52.46356 992.763303C50.998018 993.204844 49.438532 993.458495 47.813284 993.458495 38.973064 993.458495 31.823853 986.290495 31.823853 977.431486 31.823853 975.806239 32.058716 974.237358 32.519046 972.771817L67.222312 858.008661Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="0" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="0" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemUI" IsScaleAnimationEnabled="False" Tag="1" PaddingRight="38" Height="36" VerticalAlignment="Top" Title="个性化" Logo="M10.5 24h-7c-1.4 0-2.5-1.14-2.5-2.5v-11.64c-.662-.473-1-1.201-1-1.941 0-.376.089-.75.289-1.129 1.065-1.898 2.153-3.783 3.265-5.654.462-.737 1.211-1.136 2.045-1.136.635 0 .972.204 1.445.479.662.386 9 5.352 12.512 7.441.087.052 3.366 1.988 3.449 2.045.663.49.995 1.197.995 1.934 0 .375-.092.745-.295 1.13-1.064 1.899-2.153 3.784-3.265 5.655-.577.92-1.615 1.29-2.496 1.088-.392.234-5.826 3.75-6.252 3.968-.413.212-.762.26-1.192.26m-7.5-10.763v8.263c0 .274.221.5.5.5h4.588c-1.72-2.906-3.417-5.827-5.088-8.763m1.606-1.238c.053.092 5.681 9.797 5.726 9.859.108.139.299.181.455.098.164-.092 5.081-3.251 5.081-3.251-.639-.377-8.144-4.851-11.262-6.706m.659-9.829c-.913 1.456-3.199 5.525-3.235 5.61-.07.171-.008.366.149.464.201.12 16.023 9.547 16.177 9.571.151.022.297-.045.377-.174.942-1.584 3.206-5.55 3.232-5.601.069-.172.007-.367-.15-.465-.201-.12-15.983-9.499-16.09-9.546-.18-.074-.365-.002-.46.141m1.557 2.695c1.104 0 2 .897 2 2 0 1.104-.896 2-2 2s-2-.896-2-2c0-1.103.896-2 2-2" Type="RadioBox">
<local:MyListItem x:Name="ItemUI" IsScaleAnimationEnabled="False" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="个性化" Logo="M10.5 24h-7c-1.4 0-2.5-1.14-2.5-2.5v-11.64c-.662-.473-1-1.201-1-1.941 0-.376.089-.75.289-1.129 1.065-1.898 2.153-3.783 3.265-5.654.462-.737 1.211-1.136 2.045-1.136.635 0 .972.204 1.445.479.662.386 9 5.352 12.512 7.441.087.052 3.366 1.988 3.449 2.045.663.49.995 1.197.995 1.934 0 .375-.092.745-.295 1.13-1.064 1.899-2.153 3.784-3.265 5.655-.577.92-1.615 1.29-2.496 1.088-.392.234-5.826 3.75-6.252 3.968-.413.212-.762.26-1.192.26m-7.5-10.763v8.263c0 .274.221.5.5.5h4.588c-1.72-2.906-3.417-5.827-5.088-8.763m1.606-1.238c.053.092 5.681 9.797 5.726 9.859.108.139.299.181.455.098.164-.092 5.081-3.251 5.081-3.251-.639-.377-8.144-4.851-11.262-6.706m.659-9.829c-.913 1.456-3.199 5.525-3.235 5.61-.07.171-.008.366.149.464.201.12 16.023 9.547 16.177 9.571.151.022.297-.045.377-.174.942-1.584 3.206-5.55 3.232-5.601.069-.172.007-.367-.15-.465-.201-.12-15.983-9.499-16.09-9.546-.18-.074-.365-.002-.46.141m1.557 2.695c1.104 0 2 .897 2 2 0 1.104-.896 2-2 2s-2-.896-2-2c0-1.103.896-2 2-2" Type="RadioBox">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="1" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="1" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemSystem" IsScaleAnimationEnabled="False" Tag="2" PaddingRight="38" Height="36" VerticalAlignment="Top" Title="启动器" Type="RadioBox"
<local:MyListItem x:Name="ItemSystem" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="启动器" Type="RadioBox"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="2" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="2" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLink" IsScaleAnimationEnabled="False" Tag="3" PaddingRight="38" Height="36" VerticalAlignment="Top" Title="联机" Type="RadioBox"
<local:MyListItem x:Name="ItemLink" IsScaleAnimationEnabled="False" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="联机" Type="RadioBox"
LogoScale="0.75" 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:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="3" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="3" ToolTip="初始化本页设置" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSetupLink"
d:DesignWidth="800" d:DesignHeight="800">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSetupLink"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard Margin="0,15" Title="HiPer">
@@ -1,10 +1,10 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:sys="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageSetupSystem"
d:DesignWidth="800" d:DesignHeight="800">
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"
xmlns:sys="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageSetupSystem"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
@@ -52,9 +52,9 @@
<local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" />
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器需求(忽略 Quilt)" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="当 Mod 支持 Forge、Fabric 但不支持 Quilt 时,不显示它的 Mod 加载器需求。&#xa;例如,关闭时 JEI 会显示需要 Forge / Fabric 1.8+,开启后 JEI 仅显示需要 1.8+。" />
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -74,7 +74,7 @@
<local:MyCheckBox Text="正式版更新提示" Grid.Column="1" x:Name="CheckUpdateRelease" Tag="ToolUpdateRelease" ToolTip="在 Minecraft 正式版更新时弹窗提示" />
<local:MyCheckBox Text="测试版更新提示" Grid.Column="2" Height="22" x:Name="CheckUpdateSnapshot" Tag="ToolUpdateSnapshot" ToolTip="在 Minecraft 测试版(快照、预发布版)更新时弹窗提示" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="游戏语言" Margin="0,0,25,0" />
<local:MyCheckBox Text="默认设置为中文" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="5" x:Name="CheckHelpChinese" Tag="ToolHelpChinese" />
<local:MyCheckBox Text="自动设置为中文" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="5" x:Name="CheckHelpChinese" Tag="ToolHelpChinese" />
</Grid>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="系统">
@@ -187,6 +187,7 @@
End Try
FrmSpeedRight.PanMain.Children.Insert(0, Card)
RightCards.Add(Loader.Name, Card)
Log($"[Watcher] 新建下载管理卡片:{Loader.Name}")
'添加取消按钮
Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .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", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top}
Card.Children.Add(Cancel)
@@ -194,6 +195,7 @@
AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort())
End Sub
'如果已经失败,再刷新一次,修改成失败的控件
@@ -217,6 +219,7 @@
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
End Sub)
End If
End Sub
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSpeedRight"
d:DesignWidth="800" d:DesignHeight="800">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSpeedRight"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<!--<local:MyCard Title="UI 的示例下载任务">
@@ -3,17 +3,17 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<local:MyListItem x:Name="ItemOverall" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="概览"
<local:MyListItem x:Name="ItemOverall" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="概览"
Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z" />
<local:MyListItem x:Name="ItemSetup" IsScaleAnimationEnabled="False" Tag="1" PaddingRight="38" Height="36" VerticalAlignment="Top" Title="设置" Type="RadioBox"
<local:MyListItem x:Name="ItemSetup" IsScaleAnimationEnabled="False" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="设置" Type="RadioBox"
LogoScale="1.02" Logo="M292.693 787.627c0 30.72-24.746 55.466-55.466 55.466s-55.467-24.746-55.467-55.466 24.747-55.467 55.467-55.467c30.72-0.853 55.466 24.747 55.466 55.467z M1000.96 241.493c-2.56-5.973-4.267-11.946-6.827-17.92-0.853-6.826-4.266-12.8-8.533-17.92-7.68-9.386-18.773-15.36-31.573-15.36-6.827 0-13.654 1.707-19.627 5.12l-15.36 15.36-17.067 17.067-21.333 21.333L749.227 381.44c-14.507 14.507-38.4 14.507-52.907 0l-54.613-54.613c-14.507-14.507-14.507-38.4 0-52.907l132.266-132.267 14.507-14.506 20.48-20.48 16.213-16.214c3.414-5.973 5.12-11.946 5.12-19.626 0-12.8-5.973-24.747-16.213-32.427-5.973-4.267-11.947-6.827-18.773-7.68-5.12-2.56-10.24-4.267-16.214-5.973-36.693-12.8-76.8-19.627-117.76-19.627-7.68 0-14.506 0-22.186 0.853-188.587 11.947-337.92 168.107-337.92 360.96 0 16.214 0.853 32.427 3.413 48.64L56.32 663.04c-73.387 74.24-73.387 193.707 0 267.093l33.28 33.28c73.387 73.387 193.707 73.387 267.093 0l240.64-241.493c21.334 4.267 42.667 5.973 64 5.973 190.294 0 346.454-146.773 360.107-333.653 0.853-8.533 0.853-17.92 0.853-27.307 0.854-44.373-6.826-86.186-21.333-125.44zM658.773 639.147c-28.16 0-54.613-4.267-79.36-11.094-4.266 7.68-10.24 14.507-16.213 21.334l-258.56 258.56c-43.52 43.52-115.2 43.52-158.72 0l-29.013-29.014c-43.52-44.373-43.52-115.2 0-158.72l212.48-212.48 46.08-46.08c5.973-5.973 12.8-11.093 19.626-15.36-8.533-26.453-12.8-54.613-12.8-83.626v-1.707c0-152.747 123.734-275.627 276.48-275.627 18.774 0 37.547 1.707 55.467 5.974L597.333 207.36c-52.053 52.053-52.053 137.387 0 189.44l29.867 29.867c52.053 52.053 137.387 52.053 189.44 0L930.987 312.32c2.56 16.213 4.266 33.28 4.266 50.347 0 152.746-123.733 276.48-276.48 276.48z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="1" ToolTip="初始化" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M835.072 184.32l-77.824 81.92c-64.512-66.56-153.6-106.496-251.904-106.496-195.584 0-355.328 159.744-355.328 354.304 0 195.584 159.744 354.304 355.328 354.304 147.456 0 304.128-80.896 337.92-245.76 3.072-15.36-9.216-23.552-21.504-23.552l-72.704 0c-15.36 0-28.672 14.336-29.696 24.576 0 2.048 0 3.072-1.024 3.072-32.768 96.256-107.52 119.808-212.992 119.808-128 0-232.448-104.448-232.448-232.448s104.448-231.424 232.448-231.424c64.512 0 121.856 26.624 165.888 69.632l-101.376 100.352c-1.024 0-1.024 1.024-2.048 1.024-20.48 22.528-12.288 37.888 11.264 37.888l256 0c22.528 0 36.864-15.36 36.864-37.888L871.936 193.536C870.912 174.08 857.6 166.912 835.072 184.32z" LogoScale="0.9" />
<local:MyIconButton Tag="1" ToolTip="初始化" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Reset" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemMod" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="2" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod 管理"
<local:MyListItem x:Name="ItemMod" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod 管理"
Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z" >
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -21,7 +21,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemModDisabled" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="3" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod 管理"
<local:MyListItem x:Name="ItemModDisabled" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod 管理"
Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z" />
</StackPanel>
</local:MyPageLeft>
Loaded 100 of 114 files, more files were not shown because too many files have changed in this diff. Show more