Compare commits

...
193 Commits
Author SHA1 Message Date
龙腾猫跃 3f8e64450a 编译修复 2024-10-16 03:34:19 +08:00
龙腾猫跃 c5ae532fd5 2.8.9 2024-10-16 03:24:00 +08:00
龙腾猫跃 fb1caf0c8f Merge pull request #4810 from tangge233/Server
新功能:原版服务端下载功能
2024-10-15 17:16:08 +08:00
龙腾猫跃 2ad1a6bae2 Merge pull request #4868 from tangge233/WebP
MyImage 控件
2024-10-14 03:51:47 +08:00
龙腾猫跃 6de59a7f5b Update MyImage.vb 2024-10-14 03:51:13 +08:00
tangge233and龙腾猫跃 8d266c8a0b chore: apply suggestions
Co-Authored-By: 龙腾猫跃 <[email protected]>
2024-10-13 22:43:31 +08:00
tangge233 e1d58151cf chore: add summary tip 2024-10-13 21:39:33 +08:00
tangge233 7ba082c3f2 chore: apply suggestions 2024-10-13 21:33:10 +08:00
tangge233 494e4f6516 Merge branch 'Hex-Dragon:main' into WebP 2024-10-13 10:35:08 +08:00
tangge233 0a9d115fd5 Merge branch 'Hex-Dragon:main' into Server 2024-10-13 10:34:58 +08:00
Hex Dragon Bot 106be2fbaf Merge pull request #4506 from SALTWOOD/main
通过检测 NTFS 8.3 文件名修复 #4505
2024-10-13 04:41:47 +08:00
龙腾猫跃 ac9011a323 修改标签 2024-10-13 04:28:38 +08:00
tangge233 50112b70bd chore: Try Catch 2024-10-09 00:24:47 +08:00
tangge233 71d915f3ef feat: UseCache 选项和异步加载图片 2024-10-09 00:14:05 +08:00
tangge233 e6c1b192ce Revert MyBitmap.vb 2024-10-08 23:30:45 +08:00
tangge233 788f7c9a96 fix: 不使用磁盘缓存 2024-10-03 13:49:54 +08:00
tangge233 e782d0ed2d fix: apply suggestions 2024-10-02 17:22:20 +08:00
tangge233 a6aa7847c0 feat: 修改实现方式 2024-10-02 12:07:42 +08:00
tangge233 805a0e1544 fix: 测试忘记删了 2024-10-01 23:17:12 +08:00
tangge233 94476384bd feat: MyImage 控件 2024-10-01 23:12:40 +08:00
tangge233 b1c01873b7 Merge branch 'Hex-Dragon:main' into Server 2024-10-01 21:25:52 +08:00
龙腾猫跃 76bf3c40d0 2.8.8 2024-10-01 03:39:04 +08:00
龙腾猫跃 d48ab143be 添加主页预设反馈入口 2024-10-01 02:19:52 +08:00
龙腾猫跃 fad37c9b46 正式版 2.8.7 2024-09-28 17:58:43 +08:00
tangge233 ddb6ef9426 Merge branch 'Hex-Dragon:main' into Server 2024-09-24 19:09:44 +08:00
龙腾猫跃 b5c9736918 2.8.7 2024-09-24 17:04:14 +08:00
龙腾猫跃 30bc43bdb5 Merge pull request #4228 from allMagicNB/main
让工作流编译支持替换 client_id 和 x-api-key
2024-09-24 13:11:29 +08:00
龙腾猫跃 2dfa810431 Merge branch 'main' into main 2024-09-24 13:11:20 +08:00
allMagic 8e0368180c 更新 build.yml 2024-09-24 05:40:12 +08:00
tangge233 c9fb9b9eea feat: 下载器 2024-09-23 22:23:22 +08:00
tangge233 d2620297ca feat: 原版服务端下载功能 2024-09-23 21:23:36 +08:00
龙腾猫跃 778e5636ce Merge pull request #4779 from Pigeon0v0/fix-3868
Fix #3868
2024-09-22 15:37:34 +08:00
Pigeon0v0 cc46b29ba6 Fix #3868 2024-09-22 11:02:30 +08:00
龙腾猫跃 49fe40662f Merge pull request #3940 from Pigeon0v0/auth
微软登录设备代码流
2024-09-22 01:53:04 +08:00
龙腾猫跃 1aaf37f815 Merge pull request #4743 from tangge233/webp
新功能:支持加载 WebP 格式图片的资源图标
2024-09-19 20:24:56 +08:00
龙腾猫跃 3606a834c0 Merge pull request #4709 from OLDRedstone/main
修复因未使用模组列表搜索并尝试移除搜索结果导致的异常#4691
2024-09-19 18:14:27 +08:00
tangge233 08faaf1f46 feat: 支持转换 webp 图片 2024-09-16 16:48:43 +08:00
OLDREDSTONE 7afd002b85 Fix #4691 2024-09-10 14:14:32 +08:00
龙腾猫跃 4f69e9e2d2 2.8.6 正式版 2024-09-05 18:07:00 +08:00
龙腾猫跃 140b7effca 2.8.6 2024-09-05 05:55:55 +08:00
allMagic e51f6f0a66 Update .github/workflows/build.yml 2024-09-03 20:02:17 +08:00
allMagic b30ad60d99 Update Plain Craft Launcher 2/Modules/Base/ModBase.vb 2024-09-03 19:56:54 +08:00
allMagic 5bf3ce0105 Update Plain Craft Launcher 2/Application.xaml.vb 2024-08-31 18:26:47 +08:00
allMagic ae503a6945 更新 build.yml 2024-08-31 18:16:08 +08:00
allMagic dff5b4730e Merge branch 'main' into main 2024-08-31 18:05:50 +08:00
allMagic 4d28be2610 更新 ModBase.vb 2024-08-31 17:55:06 +08:00
allMagic 58ad193581 更新 Application.xaml.vb 2024-08-31 17:54:43 +08:00
allMagic 9fb45610bf 更新 Application.xaml.vb 2024-08-31 17:48:53 +08:00
allMagic 0d47b82c71 + CommitHash 2024-08-31 17:02:16 +08:00
龙腾猫跃 007b51b314 2.8.5 2024-08-31 02:39:45 +08:00
龙腾猫跃 a74b2d55c7 添加对复刻赞助功能的限制 2024-08-31 02:25:50 +08:00
龙腾猫跃 1d946cb675 Merge pull request #4498 from JingHai-Lingyun/issue3519
LittleSkin 登陆失败时使用 Json 返回的错误数据中的建议
2024-08-31 01:59:57 +08:00
龙腾猫跃 6dea3ffb9c Merge pull request #4621 from Pigeon0v0/neo-desc
修改 NeoForge 介绍
2024-08-31 01:42:12 +08:00
allMagic e32bc28510 漏个单引号 2024-08-31 00:46:15 +08:00
allMagic 9ed5f04f17 Update Plain Craft Launcher 2/Modules/ModSecret.vb 2024-08-31 00:44:40 +08:00
allMagic d390ce05d4 Update Plain Craft Launcher 2/Modules/ModSecret.vb 2024-08-31 00:44:33 +08:00
allMagic 6b041cd540 Update .github/workflows/build.yml 2024-08-31 00:42:45 +08:00
allMagic c917066e0b + Const 2024-08-31 00:40:21 +08:00
Pigeon0v0 7b7ad7899a Merge branch 'main' into auth 2024-08-28 19:43:39 +08:00
Pigeon0v0 545ebd680f text: 修改 NeoForge 介绍,更严谨一点 2024-08-28 19:38:47 +08:00
allMagic 5ea5dc3164 Fix Replace client_id 2024-08-27 11:06:43 +08:00
allMagic 68c1deb2aa Merge branch 'main' into main 2024-08-27 10:15:09 +08:00
凌云 3d7cffbcde Merge branch 'Hex-Dragon:main' into issue3519 2024-08-26 18:02:00 +08:00
allMagic 2bdda5795a 更新 build.yml 2024-08-20 11:23:25 +08:00
allMagic 26c492b370 更新 build.yml 2024-08-20 11:15:08 +08:00
allMagic b6a06f8d8d 更新 build.yml 2024-08-20 11:13:04 +08:00
龙腾猫跃 f40a299010 Merge pull request #4404 from tangge233/ModFilter
新功能:简单的本地 Mod 筛选
2024-08-20 00:16:45 +08:00
龙腾猫跃 a509ac6337 Merge pull request #4541 from tangge233/ModPageUIImprove
优化:当有 Mod 选中时在下方空开一定空间方便操作
2024-08-19 19:57:00 +08:00
龙腾猫跃 cfdda03b35 Merge pull request #4533 from wuliaodexiaoluo/4532
Fix #4532
2024-08-19 19:53:14 +08:00
tangge233 894b36e746 style: 当有 Mod 选中时在下方空开一定空间方便操作 2024-08-18 21:41:14 +08:00
无聊的小洛 e42098171e 更新地址 2024-08-18 11:02:24 +08:00
凌云 76549b4039 Merge branch 'Hex-Dragon:main' into issue3519 2024-08-18 07:18:59 +08:00
tangge233 93574f60f4 Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-17 15:48:30 +08:00
龙腾猫跃 62394e0052 2.8.4 2024-08-17 01:46:19 +08:00
凌云andallMagic 0acd917e6b Use suggestion
Update Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

Co-authored-by: allMagic <[email protected]>
2024-08-16 19:09:22 +08:00
SALTWOOD 2427fb7619 refactor: 使用正则表达式检测 NTFS 8.3 文件名 2024-08-16 11:38:09 +08:00
SALTWOOD 3af99aca0a fix: 少了一个字 2024-08-15 17:24:42 +08:00
SALTWOOD 8b0d9e5a5c fix: 暂时使用波浪号检测修复 #4505 2024-08-15 17:12:27 +08:00
tangge233 05dc7a2650 fix: 窗口重获焦点后筛选项被重置 2024-08-15 17:03:41 +08:00
JingHai-Lingyun 881e79dfdf Fix 2024-08-14 22:38:24 +08:00
tangge233 20fcb59e36 Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-14 18:07:05 +08:00
allMagic f919ae49af Merge branch 'Hex-Dragon:main' into main 2024-08-14 18:06:44 +08:00
龙腾猫跃 c62ab46b99 Merge pull request #4485 from allMagicNB/Fix-#4482
Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482
2024-08-14 05:29:20 +08:00
龙腾猫跃 bdb19e1ae4 Merge pull request #4491 from LxHTT/main
fix: 下载 NeoForge 时,从未使用镜像源
2024-08-13 22:55:21 +08:00
Pigeon0v0 5598ff3239 fix: 新增的 otc 参数可能导致网页无法打开,解决方案是去掉了这个参数 2024-08-13 21:57:24 +08:00
LxHTT b11c8c5d96 fix: 下载 NeoForge 时,从未使用镜像源 2024-08-13 21:30:47 +08:00
allMagicNB 348472b3ca Revert 2024-08-13 19:33:15 +08:00
tangge233 918178d0bd Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-13 14:28:42 +08:00
allMagicNB 19fe4c03dc Fix #4482:+ "chcp 65001 > nul" & Encoding:=Encoding.UTF8 2024-08-13 14:00:26 +08:00
allMagicNB 06d92556b6 Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482 2024-08-13 11:57:46 +08:00
allMagic 1519c9038a Merge branch 'Hex-Dragon:main' into main 2024-08-13 10:46:07 +08:00
龙腾猫跃 4c1bfe9140 Merge pull request #4438 from 3gf8jv4dv/kitchen-sink
Revise the translation of Kitchen Sink
2024-08-13 03:46:08 +08:00
tangge233 9577e9946b Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-12 09:54:33 +08:00
龙腾猫跃 a6d6c97fd7 Merge pull request #4415 from allMagicNB/Close-#4366
Close 添加对 MCC 15周年披风的翻译 #4366
2024-08-12 03:11:51 +08:00
龙腾猫跃 1c6af2caca Merge pull request #4291 from youzi-2333/feat-setup-modsrc
添加国内 Mod 镜像下载源
2024-08-12 03:08:47 +08:00
龙腾猫跃 12a3712524 Merge pull request #4449 from tangge233/VersionSortFix
fix: 检测愚人节版本所用时区不正确
2024-08-12 03:07:56 +08:00
龙腾猫跃 9d56a95dcb Merge pull request #4441 from 3gf8jv4dv/mod_modpack-download-filter-gameversion-1.21.1
Add 1.21.1 to Mod and Modpack downloadpage version filter
2024-08-12 03:02:35 +08:00
tangge233 e5a0eddcea fix: 检测愚人节版本所用时区不正确 2024-08-09 14:05:29 +08:00
3gf8jv4dv f7d2cd1cb6 Add 1.21.1 to Mod and Modpack downloadpage version filter 2024-08-08 08:27:58 +08:00
3gf8jv4dv ec3ebe3215 Update 2024-08-07 23:51:17 +08:00
3gf8jv4dv 084fb1248e Revise the translation of Kitchen Sink 2024-08-07 22:41:03 +08:00
tangge233 53743495ec fix: 全选逻辑不正确 2024-08-06 20:34:04 +08:00
tangge233 76adffffad fix: 鬼知道为什么没有初始化 2024-08-06 11:58:37 +08:00
tangge233 7721db131b fix: 刷新列表后全部选项不在 Checked 状态 2024-08-06 11:03:57 +08:00
allMagicNB f639435813 + "MCC 15th Year" Cape 2024-08-06 06:36:56 +08:00
tangge233 9fe1471f8e fix: 用枚举替代字符串 2024-08-05 23:43:31 +08:00
tangge233 eca89febf6 feat: 使用 MyRadioButton 2024-08-05 23:34:49 +08:00
tangge233 f9c4e5a752 fix: Ctrl+A 实现不合逻辑 2024-08-05 19:53:45 +08:00
tangge233 8972aec56a feat: Mod 管理卡片标题 2024-08-05 19:20:28 +08:00
tangge233 0007a0ac72 fix: 全选逻辑问题、UI问题 2024-08-05 18:57:52 +08:00
tangge233 d2ef7d7989 feat: 加个分割线 2024-08-05 18:15:16 +08:00
tangge233 3e06ea4502 fix: 错误的全部统计 2024-08-05 14:37:30 +08:00
tangge233and3gf8jv4dv 7cbdca12f3 Apply suggestions from 3gf8jv4dv
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-08-05 13:51:12 +08:00
tangge233 cfe925c667 feat: 改成龙猫想要的样子 2024-08-05 13:32:36 +08:00
tangge233 c0a966f212 fix: 禁用或启用模组没有改变其所在卡片 2024-08-05 00:52:08 +08:00
tangge233 d915cd48f6 feat: 无可更新 Mod 时隐藏对应卡片 2024-08-05 00:41:00 +08:00
tangge233 591421393f fix: 意料之外的内容加入 2024-08-05 00:31:52 +08:00
tangge233 ebfed4243b feat: 适当修改本地 Mod 管理界面与操作逻辑 2024-08-05 00:22:15 +08:00
tangge233 462f985cc3 初步实现分类展示 2024-08-04 23:24:20 +08:00
allMagic 3f332fee8e X_API_KEY -> CURSEFORGE_API_KEY 2024-08-03 20:00:48 +08:00
allMagic 7be16a8906 Merge branch 'Hex-Dragon:main' into main 2024-08-03 19:49:06 +08:00
Pigeon0v0and3gf8jv4dv 22746c3ca9 fix: typo
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-07-31 06:59:07 +08:00
Pigeon0v0 0bbb048c59 feat(auth): 打开的微软验证网页现在会自动填入设备代码 2024-07-30 21:42:42 +08:00
龙腾猫跃 8f49799c6d Merge pull request #3945 from Silverteal/patch-1
所有4月1日发布的版本自动视为愚人节版
2024-07-29 05:45:40 +08:00
youzi-2333 6c8a7a33b7 👌 💥 更新 LTCatt 的审核 2024-07-28 22:30:59 +08:00
龙腾猫跃 020ce330b5 https://github.com/Hex-Dragon/PCL2/discussions/4361#discussioncomment-10169901 2024-07-28 16:13:06 +08:00
龙腾猫跃 c8c981fd8c 放宽分发限制 2024-07-28 04:28:58 +08:00
youzi-2333 89f537a00e 👌 更新一部分 LTCatt 的审核 2024-07-26 22:52:28 +08:00
龙腾猫跃 9c0ae93d7d Create FUNDING.yml 2024-07-26 17:02:43 +08:00
龙腾猫跃 016ff2c912 Merge pull request #4349 from Forks-Space/main
Readme 徽标更改爱发电 net->com
2024-07-26 16:35:09 +08:00
Ad_closeNN a4982c5ca7 进一步更改徽标 2024-07-26 16:22:23 +08:00
Ad_closeNN 6208a21b85 徽标更改爱发电 net->com 2024-07-26 16:21:32 +08:00
allMagicNB 2b57e1ec48 Merge branch 'main' of https://github.com/allMagicNB/PCL2 2024-07-20 18:10:18 +08:00
allMagicNB 7cf91d923e del Release 2024-07-20 17:55:36 +08:00
youzi-2333 e69b189c8b ✏️ MCLM -> MCIM
我是【该词语违禁】
2024-07-18 14:40:01 +08:00
youzi-2333 8ed02fe4d9 ✨ 为 Mod 列表、下载添加 MCLM 下载源 2024-07-18 12:38:45 +08:00
Pigeon0v0 4ae3e4aa20 feat: 支持复制设备代码和验证网址 2024-07-18 10:46:50 +08:00
allMagic 1bd7b717d0 - dir 2024-07-17 19:58:01 +08:00
allMagic fa9e1be4e2 更新 build.yml 2024-07-17 19:43:38 +08:00
allMagic 15f82f100c 更新 build.yml 2024-07-17 17:28:10 +08:00
allMagic cc18004c41 更新 build.yml 2024-07-17 17:25:04 +08:00
allMagic 227ceccb8f - .zip 2024-07-17 17:22:31 +08:00
allMagic 83a5370bad 更新 build.yml 2024-07-17 16:45:26 +08:00
allMagicNB 2348d3c8f3 + env 2024-07-17 15:13:15 +08:00
allMagicNB d7e649c44e Fix Replace 2024-07-17 15:00:23 +08:00
allMagicNB b10fc8c720 Fix something 2024-07-17 14:56:33 +08:00
allMagic ecf1fae8ff Merge branch 'Hex-Dragon:main' into main 2024-07-15 13:16:55 +08:00
龙腾猫跃 5bd8ac3870 2.8.3 2024-07-13 14:56:27 +08:00
allMagic d52a4ec081 Update build.yml 2024-07-12 13:41:59 +08:00
allMagic a7a4838b96 [no ci]Update build.yml 2024-07-12 13:22:28 +08:00
allMagic c860ad26e2 [no ci]Update build.yml 2024-07-12 13:11:49 +08:00
allMagic 8423ef6371 Merge branch 'Hex-Dragon:main' into main 2024-07-12 11:38:36 +08:00
龙腾猫跃 a3c419e76d 2.8.2 正式版 2024-07-12 01:39:26 +08:00
allMagic eaebd04bbb Merge branch 'Hex-Dragon:main' into main 2024-07-11 21:10:19 +08:00
龙腾猫跃 5436c5ec8a 2.8.2 2024-07-11 20:13:26 +08:00
allMagic 2b55ed078b Update .gitignore 2024-07-11 20:13:08 +08:00
龙腾猫跃 73a8d60d6d Merge pull request #4175 from youzi-2333/feat-3066
完成 #3066 自动安装 modpack.zip
2024-07-11 20:05:58 +08:00
allMagicNB 4358058696 更换语气,让 “应该做” 变成 “可以做”。 2024-07-11 19:45:03 +08:00
allMagicNB d49a8f8717 Fix & + .gitignore & + Headers("x-api-key") 2024-07-11 19:40:46 +08:00
allMagic 59a05a8c71 Merge branch 'Hex-Dragon:main' into main 2024-07-11 16:41:50 +08:00
龙腾猫跃 5fb3e3a786 Merge pull request #4219 from killcerr/main
修复使用绝对路径导致的编译问题
2024-07-11 16:16:38 +08:00
龙腾猫跃 74001fecea Merge pull request #4204 from lactobionicAcid/patch-1
Fix #4183
2024-07-11 16:11:49 +08:00
龙腾猫跃 068b2a4773 Merge pull request #4193 from lactobionicAcid/main
Fix #4179
2024-07-11 16:09:22 +08:00
Silverteal a465807d0c Merge pull request #11 from PCL-Community/patch-1
Fix Bugs
2024-07-11 16:01:31 +08:00
allMagic e0bd274e0d 更新 build.yml 2024-07-11 15:58:19 +08:00
allMagic 4747c3dc68 更新 build.yml 2024-07-11 15:27:27 +08:00
allMagic 3c71a2cbf8 更新 build.yml 2024-07-11 15:21:43 +08:00
allMagic 678fc3b40c Update build.yml 2024-07-11 15:13:15 +08:00
乳糖酸菌 b8c512c04c Update ModModpack.vb
将原先使用的.Remove方法替换为.Replace方法。
2024-07-11 10:36:32 +08:00
killcerr ea2b7298e9 修复使用绝对路径导致的编译问题 2024-07-10 19:57:02 +08:00
killcerr d108b62eed 修复使用绝对路径导致的编译问题 2024-07-10 19:44:33 +08:00
killcerr 8ea99d21be 修复使用绝对路径导致的编译问题 2024-07-10 19:41:26 +08:00
乳糖酸菌 f68978f7d8 Update PageDownloadInstall.xaml.vb
removed extra space
2024-07-10 18:41:45 +08:00
乳糖酸菌 9ab43a72f2 Update PageDownloadInstall.xaml.vb
Fix #4202
2024-07-09 00:25:22 +08:00
乳糖酸菌 7a7370582c Update ModModpack.vb 2024-07-08 04:07:18 +08:00
龙腾猫跃 fce1f90b55 Merge branch 'main' of https://github.com/Hex-Dragon/PCL2 2024-07-07 02:17:38 +08:00
龙腾猫跃 7ee533ca43 2.8.1 2024-07-07 02:17:36 +08:00
youzi-2333 8e3af89bd3 ✨ 完成 #3066 自动安装 modpack.zip 2024-07-06 22:34:12 +08:00
无聊的小洛 10e17d48c5 致命错误
败笔也
2024-07-04 11:37:12 +08:00
无聊的小洛 fa7deb7500 修正错误
为什么要大写啊
2024-07-04 11:36:00 +08:00
无聊的小洛 2f39c57e58 Update FormMain.xaml.vb
之前改的没改回来
2024-07-04 11:35:11 +08:00
wuliaodexiaoluo aa576e669d Fix Bugs 2024-07-04 11:23:15 +08:00
Pigeon0v0 96b0018adf chores: 开源版本提示新增 2024-06-16 06:43:13 +08:00
Pigeon0v0 536c309967 Merge branch 'Hex-Dragon:main' into auth 2024-06-13 20:22:08 +08:00
Pigeon0v0 dea21c27c5 改了改文案避免误解 2024-06-01 11:58:04 +08:00
Pigeon0v0 8b5187bff4 加了确认弹窗并支持取消,加了轮询频率,加了一些兜底 2024-06-01 11:44:15 +08:00
Pigeon0v0 236557ab9e 改了改提示,让用户知道一下设备代码复制到剪贴板了 2024-06-01 10:32:09 +08:00
Pigeon0v0 99b2adb646 feat: 微软登录设备代码流,并移除了浏览器验证方式 2024-06-01 10:00:48 +08:00
Silverteal 73f8bdf4e1 Delete .github/workflows/build-pr.yml 2024-06-01 06:53:20 +08:00
Silverteal a95e8e8bf7 Create build-pr.yml 2024-06-01 06:52:08 +08:00
Silverteal a4d2e21e1f Merge pull request #1 from Hex-Dragon/main
merge upstream
2024-05-31 18:21:05 +08:00
Silverteal 9402523e01 Merge branch 'Hex-Dragon:main' into main 2024-05-31 14:40:01 +08:00
Silverteal c99575c3f1 修改PageDownloadClient.xaml.vb和PageDownloadInstall.xaml.vb
对4月1日版本直接判定为愚人节版
2024-05-04 09:22:24 +08:00
95 changed files with 5970 additions and 3725 deletions

No files matched your search

+3
View File
@@ -0,0 +1,3 @@
# These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat']
+1 -1
View File
@@ -1,6 +1,6 @@
name: "Minecraft 崩溃"
description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "下载或登录时卡住或失败"
description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "综合 Bug 反馈"
description: "遇见了没有细分选项的其他 Bug"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "优化建议"
description: "对已有功能的小幅度优化或改进建议"
labels: [· 优化, 新反馈]
labels: [· 优化, 新提交]
body:
- type: checkboxes
id: "yml-1"
+3
View File
@@ -1,5 +1,8 @@
blank_issues_enabled: false
contact_links:
- name: 主页预设反馈
url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页
about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈
- name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
+1 -1
View File
@@ -1,6 +1,6 @@
name: "新功能提案"
description: "对已有功能的大幅度修改,或添加一个新内容或选项"
labels: [· 新功能, 新反馈]
labels: [· 新功能, 新提交]
body:
- type: checkboxes
id: "yml-1"
+12 -15
View File
@@ -1,5 +1,4 @@
name: Build
on:
push:
paths:
@@ -12,37 +11,35 @@ on:
workflow_dispatch:
jobs:
build:
strategy:
matrix:
configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate]
name: Build
runs-on: windows-latest
strategy:
matrix:
configuration: [Debug, Release]
steps:
- name: Checkout
uses: actions/checkout@v4
with:
fetch-depth: 0
- name: Set Describe
shell: bash
run: |
Describe=`git describe --tags --always`
echo "Describe=$Describe" >> $GITHUB_ENV
describe=`git describe --tags --always`
echo "describe=$describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2
with:
msbuild-architecture: x64
- name: Replace
run: |
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb"
- name: Build
run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }}
- name: Upload a Build Artifact
uses: actions/upload-artifact@v4
with:
name: ${{ matrix.configuration }} ${{ env.Describe }}
name: ${{ matrix.configuration }} ${{ env.describe }}
path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe
+10 -9
View File
@@ -2,23 +2,24 @@
一、承诺与声明。
  开发者承诺,在您遵守本指南的情况下,不会追究您的法律责任,但最终裁量权仍由开发者保留。
  开发者承诺,在您遵守本指南的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
  1、给出适当的署名,且提供指向本存储库的链接。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。
  如果您基于该存储库进行衍生创作,或合理使用了本存储库中的较大量内容,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
  (三)给出适当的说明,表示这是第三方内容。在 GitHub 上直接进行 Fork 是允许的。
  (四)使用本指南文件作为协议,不得附加额外条款。
  (五)不得分发编译后的可执行文件。唯一的例外是,你可以在明确禁止再次分发的前提下,在小于 100 人的 QQ 群内分发编译后的可执行文件。
  如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。
  3、使用本指南文件作为协议,不得附加额外条款。
  4、该衍生作品不能被允许用于再次分发。包括但不限于用于制作整合包。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助功能,或是其他作用相似的功能。包括但不限于主题功能、回声洞投稿功能等。
————————————
+22 -5
View File
@@ -90,7 +90,7 @@ Public Class Application
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
@@ -99,13 +99,17 @@ Public Class Application
'日志初始化
LogStart()
'添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})")
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
'检测压缩包运行
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
MyMsgBox("请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!" & vbCrLf & "程序目前在临时文件夹中运行,设置、游戏存档等可能无法保存,且部分功能将无法使用。", "环境警告", "我知道了", IsWarn:=True)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
End If
'设置初始化
Setup.Load("SystemDebugMode")
@@ -170,9 +174,12 @@ Public Class Application
Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly
Private Shared AssemblyImazenWebp As Assembly
Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Private Shared ReadOnly AssemblyImazenWebpLock As New Object
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock
@@ -198,6 +205,16 @@ Public Class Application
End If
Return AssemblyDialog
End SyncLock
ElseIf args.Name.StartsWithF("Imazen.WebP") Then
SyncLock AssemblyImazenWebpLock
If AssemblyImazenWebp Is Nothing Then
Log("[Start] 加载 DLL:Imazen.WebP")
AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
SetDllDirectory(PathPure.TrimEnd("\"))
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
End If
Return AssemblyImazenWebp
End SyncLock
Else
Return Nothing
End If
@@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
@@ -46,18 +46,18 @@
Black
Highlight
End Enum
Private _ColorType As ColorState = ColorState.Black
Public Property ColorType As ColorState
Get
Return _ColorType
Return GetValue(ColorTypeProperty)
End Get
Set(value As ColorState)
_ColorType = value
If ColorType = value Then Return
SetValue(ColorTypeProperty, value)
RefreshColor()
End Set
End Property '颜色类别
Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata())
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata(ColorState.Black))
'点击事件
+184
View File
@@ -0,0 +1,184 @@
Public Class MyImage
Inherits Image
#Region "公开属性"
''' <summary>
''' 网络图片的缓存有效期。
''' 在这个时间后,才会重新尝试下载图片。
''' </summary>
Public FileCacheExpiredTime As New TimeSpan(7, 0, 0, 0) '7 天
''' <summary>
''' 是否允许将网络图片存储到本地用作缓存。
''' </summary>
Public Property EnableCache As Boolean
Get
Return _EnableCache
End Get
Set(value As Boolean)
_EnableCache = value
End Set
End Property
Private _EnableCache As Boolean = True
''' <summary>
''' 与 Image 的 Source 类似。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。
''' 支持 WebP 格式的图片。
''' </summary>
Public Shadows Property Source As String '覆写 Image 的 Source 属性
Get
Return _Source
End Get
Set(value As String)
If value = "" Then value = Nothing
If _Source = value Then Exit Property
_Source = value
If Not IsInitialized Then Exit Property '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
Load()
End Set
End Property
Private _Source As String = ""
Public Shared Shadows ReadOnly SourceProperty As DependencyProperty = DependencyProperty.Register(
"Source", GetType(String), GetType(MyImage), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary>
''' 当 Source 首次下载失败时,会从该备用地址加载图片。
''' </summary>
Public Property FallbackSource As String
Get
Return _FallbackSource
End Get
Set(value As String)
_FallbackSource = value
End Set
End Property
Private _FallbackSource As String = Nothing
''' <summary>
''' 正在下载网络图片时显示的本地图片。
''' </summary>
Public Property LoadingSource As String
Get
Return _LoadingSource
End Get
Set(value As String)
_LoadingSource = value
End Set
End Property
Private _LoadingSource As String = "pack://application:,,,/images/Icons/NoIcon.png"
#End Region
''' <summary>
''' 实际被呈现的图片地址。
''' </summary>
Public Property ActualSource As String
Get
Return _ActualSource
End Get
Set(value As String)
If value = "" Then value = Nothing
If _ActualSource = value Then Exit Property
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap)
Catch ex As Exception
Log(ex, $"加载图片失败({value})")
Try
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
Catch
End Try
End Try
End Set
End Property
Private _ActualSource As String = Nothing
Private Sub Load() _
Handles Me.Initialized '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
'空
If Source Is Nothing Then
ActualSource = Nothing
Exit Sub
End If
'本地图片
If Not Source.StartsWithF("http") Then
ActualSource = Source
Exit Sub
End If
'从缓存加载网络图片
Dim Url As String = Source
Dim Retried As Boolean = False
Dim TempPath As String = GetTempPath(Url)
Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
RunInNewThread(
Sub()
Dim TempDownloadingPath As String = Nothing
Try
RetryStart:
'下载
ActualSource = LoadingSource '显示加载中图片
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
NetDownload(Url, TempDownloadingPath, True)
If Url <> Source AndAlso Url <> FallbackSource Then
'已经更换了地址
File.Delete(TempDownloadingPath)
ElseIf EnableCache Then
'保存缓存并显示
If File.Exists(TempPath) Then File.Delete(TempPath)
Rename(TempDownloadingPath, TempPath)
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempDownloadingPath)
File.Delete(TempDownloadingPath)
End If
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
Catch
End Try
If Not Retried Then
'更换备用地址
Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer)
Retried = True
Url = If(FallbackSource, Source)
'空
If Url Is Nothing Then
ActualSource = Nothing
Exit Sub
End If
'本地图片
If Not Url.StartsWithF("http") Then
ActualSource = Url
Exit Sub
End If
'从缓存加载网络图片
TempPath = GetTempPath(Url)
TempFile = New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists() Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
'下载
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
GoTo RetryStart
Else
Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
End If
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class
@@ -212,33 +212,26 @@
If Not _Logo = "" Then
If _Logo.StartsWithF("http", True) Then
'网络图片
PathLogo = New Image With {
PathLogo = New MyImage With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo),
.Source = _Logo,
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Background = Bitmap,
.Background = New MyBitmap(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then
' '使用最适合 16x16 物品图片显示的大小
' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor)
' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center
' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width
'Else
PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality)
'End If
.SnapsToDevicePixels = True, .UseLayoutRounding = False,
.HorizontalAlignment = HorizontalAlignment.Stretch, .VerticalAlignment = VerticalAlignment.Stretch
}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
Else
'矢量图
PathLogo = New Shapes.Path With {
@@ -327,8 +320,8 @@
Private Sub OnSizeChanged() Handles Me.SizeChanged
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWithF(".png", True) Then
If PathLogo IsNot Nothing Then
If _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -157,9 +157,7 @@
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue
End Sub)))
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioBox).LabText.Text = e.NewValue)))
'点击事件
@@ -117,9 +117,7 @@
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue
End Sub)))
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioButton).LabText.Text = e.NewValue)))
Public Enum ColorState
White
Highlight
@@ -90,21 +90,21 @@
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register(
"EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register(
"EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
End Class
+3 -3
View File
@@ -104,7 +104,7 @@
<GradientStop Color="{StaticResource ColorObject3}" Offset="1"/>
</LinearGradientBrush>
</Grid.Background>
<Image x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyIconButton x:Name="BtnTitleClose" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,12,0" Theme="White"
LogoScale="0.72" 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" />
<local:MyIconButton x:Name="BtnTitleMin" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,44,0" Theme="White"
@@ -117,7 +117,7 @@
</Grid.ColumnDefinitions>
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" />
<TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" />
<Image x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<local:MyImage x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0">
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" />
@@ -166,7 +166,7 @@
</Border>
</Border>
</Grid>
<StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" />
<StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,20" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />
+167 -251
View File
@@ -10,6 +10,38 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 340 Then 'Release 2.8.8
If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
BugCount += 7
End If
If LastVersion < 338 Then 'Release 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
FeatureCount += 11
BugCount += 21
End If
If LastVersion < 336 Then 'Release 2.8.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 19
BugCount += 24
End If
If LastVersion < 332 Then 'Release 2.8.3
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 330 Then 'Release 2.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
@@ -37,84 +69,69 @@ Public Class FormMain
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 317 Then 'Release 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
BugCount += 2
End If
If LastVersion < 315 Then 'Release 2.6.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
FeatureCount += 17
BugCount += 16
End If
If LastVersion < 313 Then 'Release 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6
BugCount += 10
End If
If LastVersion < 311 Then 'Release 2.6.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 27
BugCount += 25
End If
If LastVersion < 308 Then 'Release 2.6.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 31
BugCount += 37
End If
If LastVersion < 302 Then 'Release 2.6.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug"))
BugCount += 1
End If
If LastVersion < 300 Then 'Release 2.6.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 40
BugCount += 34
End If
If LastVersion < 296 Then 'Release 2.6.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureCount += 21
BugCount += 30
End If
If LastVersion < 293 Then 'Release 2.6.1
BugCount += 1
End If
If LastVersion < 292 Then 'Release 2.6.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
FeatureCount += 24
BugCount += 24
End If
If LastVersion < 286 Then 'Release 2.5.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、安装 Modrinth 的 Mod 与整合包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
FeatureCount += 35
BugCount += 36
End If
#Else
'5: FEAT+
'4: IMP+ FEAT*
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 341 Then 'Snapshot 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug"))
FeatureCount += 17
BugCount += 13
End If
If LastVersion < 339 Then 'Snapshot 2.8.8
If LastVersion = 337 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
BugCount += 7
End If
If LastVersion < 337 Then 'Snapshot 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
FeatureCount += 11
BugCount += 21
End If
If LastVersion < 335 Then 'Snapshot 2.8.6
BugCount += 2
End If
If LastVersion < 334 Then 'Snapshot 2.8.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
If LastVersion = 333 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug"))
End If
FeatureCount += 6
BugCount += 7
End If
If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 13
BugCount += 17
End If
If LastVersion < 331 Then 'Snapshot 2.8.3
If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 329 Then 'Snapshot 2.8.2
If LastVersion >= 327 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Beta 版 NeoForge 的整合包的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复自动安装无法选择部分 OptiFine 的 Bug"))
End If
FeatureCount += 4
BugCount += 8
End If
If LastVersion < 328 Then 'Snapshot 2.8.1
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.12.2- 的 Bug"))
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 Bug"))
If LastVersion = 327 Then BugCount += 1
End If
If LastVersion < 327 Then 'Snapshot 2.8.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
@@ -151,117 +168,6 @@ Public Class FormMain
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 316 Then 'Snapshot 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
BugCount += 2
End If
If LastVersion < 314 Then 'Snapshot 2.6.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
FeatureCount += 17
BugCount += 16
End If
If LastVersion < 312 Then 'Snapshot 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6
BugCount += 10
End If
If LastVersion < 310 Then 'Snapshot 2.6.12
If LastVersion = 309 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理页面添加启用、禁用单个 Mod 的快捷按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 13
BugCount += 12
End If
If LastVersion < 309 Then 'Snapshot 2.6.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureCount += 15
BugCount += 13
End If
If LastVersion < 307 Then 'Snapshot 2.6.10
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 306 Then 'Snapshot 2.6.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureCount += 9
BugCount += 11
End If
If LastVersion < 305 Then 'Snapshot 2.6.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 20
BugCount += 25
End If
If LastVersion < 303 Then 'Snapshot 2.6.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug"))
BugCount += 1
End If
If LastVersion < 301 Then 'Snapshot 2.6.6
FeatureCount += 4
BugCount += 2
End If
If LastVersion < 299 Then 'Snapshot 2.6.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 18
BugCount += 13
End If
If LastVersion < 298 Then 'Snapshot 2.6.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureCount += 18
BugCount += 19
End If
If LastVersion < 297 Then 'Snapshot 2.6.3
FeatureCount += 12
BugCount += 14
End If
If LastVersion < 294 Then 'Snapshot 2.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
FeatureCount += 9
BugCount += 16
End If
If LastVersion < 291 Then 'Snapshot 2.6.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
FeatureCount += 10
BugCount += 2
End If
If LastVersion < 289 Then 'Snapshot 2.5.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
FeatureCount += 6
BugCount += 14
End If
If LastVersion < 288 Then 'Snapshot 2.5.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
FeatureCount += 8
BugCount += 8
End If
If LastVersion < 285 Then 'Snapshot 2.5.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
If LastVersion = 284 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复打开部分帮助报错的 Bug"))
FeatureCount += 8
BugCount += 8
End If
If LastVersion < 284 Then 'Snapshot 2.5.1
If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
FeatureCount += 22
BugCount += 21
End If
If LastVersion < 283 Then 'Snapshot 2.5.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包"))
FeatureCount += 5
BugCount += 5
End If
#End If
'整理更新日志文本
Dim ContentList As New List(Of String)
@@ -282,17 +188,13 @@ Public Class FormMain
RunInNewThread(
Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
OpenWebsite("https://afdian.com/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
End Sub
'窗口加载
Private IsWindowLoadFinished As Boolean = False
''' <summary>
''' 是否为联机提权后自动重启。
''' </summary>
Public Shared IsLinkRestart As Boolean = False
Public Sub New()
ApplicationStartTick = GetTimeTick()
'窗体参数初始化
@@ -308,9 +210,6 @@ Public Class FormMain
'触发降级
DowngradeSub(LastVersion)
End If
''刷新语言
'Lang = ReadReg("Lang", "zh_CN")
'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)}
'刷新主题
ThemeCheckAll(False)
Setup.Load("UiLauncherTheme")
@@ -330,7 +229,6 @@ Public Class FormMain
PanMainLeft.Child = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
'模式提醒
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
@@ -374,13 +272,17 @@ Public Class FormMain
'加载窗口
ThemeRefreshMain()
Try
Height = ReadReg("WindowHeight", MinHeight + 50)
Width = ReadReg("WindowWidth", MinWidth + 50)
Height = Setup.Get("WindowHeight")
Width = Setup.Get("WindowWidth")
Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
Height = MinHeight + 50
Width = MinWidth + 50
Height = MinHeight + 100
Width = MinWidth + 100
End Try
#If DEBUG Then
MinHeight = 50
MinWidth = 50
#End If
Topmost = False
If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
'更改窗口
@@ -399,7 +301,7 @@ Public Class FormMain
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
End Sub, , True)
}, "Form Show")
'Timer 启动
@@ -514,6 +416,16 @@ Public Class FormMain
Setup.Set("UiHiddenOtherHelp", False)
Log("[Start] 已解除帮助页面的隐藏")
End If
'单向迁移微软登录结果(#4836)
If Not Setup.Get("CacheMsV2Migrated") Then
Setup.Set("CacheMsV2Migrated", True)
Setup.Set("CacheMsV2OAuthRefresh", Setup.Get("CacheMsOAuthRefresh"))
Setup.Set("CacheMsV2Access", Setup.Get("CacheMsAccess"))
Setup.Set("CacheMsV2ProfileJson", Setup.Get("CacheMsProfileJson"))
Setup.Set("CacheMsV2Uuid", Setup.Get("CacheMsUuid"))
Setup.Set("CacheMsV2Name", Setup.Get("CacheMsName"))
Log("[Start] 已从老版本迁移微软登录结果")
End If
'输出更新日志
If LastVersionCode = 0 Then Exit Sub
If LowerVersionCode >= VersionCode Then Exit Sub
@@ -545,7 +457,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort()
Next
End Sub, "强行停止下载任务")
@@ -555,35 +467,35 @@ Public Class FormMain
End If
'关闭
RunInUiWait(
Sub()
IsHitTestVisible = False
If PanBack.RenderTransform Is Nothing Then
Dim TransformPos As New TranslateTransform(0, 0)
Dim TransformRotate As New RotateTransform(0)
Dim TransformScale As New ScaleTransform(1, 1)
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
AniStart({
AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(
Sub(i)
TransformScale.ScaleX += i
TransformScale.ScaleY += i
End Sub, 0.88 - TransformScale.ScaleX, 180),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
AaCode(
Sub()
IsHitTestVisible = False
Top = -10000
ShowInTaskbar = False
End Sub, 210),
AaCode(AddressOf EndProgramForce, 230)
}, "Form Close")
Else
EndProgramForce()
End If
Log("[System] 收到关闭指令")
End Sub)
Sub()
IsHitTestVisible = False
If PanBack.RenderTransform Is Nothing Then
Dim TransformPos As New TranslateTransform(0, 0)
Dim TransformRotate As New RotateTransform(0)
Dim TransformScale As New ScaleTransform(1, 1)
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
AniStart({
AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(
Sub(i)
TransformScale.ScaleX += i
TransformScale.ScaleY += i
End Sub, 0.88 - TransformScale.ScaleX, 180),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
AaCode(
Sub()
IsHitTestVisible = False
Top = -10000
ShowInTaskbar = False
End Sub, 210),
AaCode(AddressOf EndProgramForce, 230)
}, "Form Close")
Else
EndProgramForce()
End If
Log("[System] 收到关闭指令")
End Sub)
End Sub
Private Shared IsLogShown As Boolean = False
Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success)
@@ -628,8 +540,8 @@ Public Class FormMain
Public IsSizeSaveable As Boolean = False
Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
If IsSizeSaveable Then
WriteReg("WindowHeight", Height)
WriteReg("WindowWidth", Width)
Setup.Set("WindowHeight", Height)
Setup.Set("WindowWidth", Width)
End If
RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
PanForm.Width = BorderForm.ActualWidth + 0.001
@@ -658,7 +570,7 @@ Public Class FormMain
Exit Sub
ElseIf e.Key = Key.Escape Then
Dim Msg As Object = PanMsg.Children(0)
If TypeOf Msg Is MyMsgText AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
If TypeOf Msg IsNot MyMsgInput AndAlso TypeOf Msg IsNot MyMsgSelect AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
Msg.Btn3_Click()
ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
Msg.Btn2_Click()
@@ -715,7 +627,7 @@ Public Class FormMain
Try
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
'Mod 管理自动刷新
FrmVersionMod.RefreshList()
FrmVersionMod.ReloadModList()
ElseIf PageCurrent = PageType.VersionSelect Then
'版本选择自动刷新
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
@@ -840,11 +752,12 @@ Public Class FormMain
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi(Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Finish)
End Sub)
RunInUi(
Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Finish)
End Sub)
Exit Sub
End If
'Mod 安装
@@ -864,10 +777,12 @@ Public Class FormMain
Install:
Try
For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
@@ -884,7 +799,7 @@ Install:
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
@@ -958,18 +873,19 @@ Install:
''' 把当前窗口拖到最前面。
''' </summary>
Public Sub ShowWindowToTop()
RunInUi(Sub()
'这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
Visibility = Visibility.Visible
ShowInTaskbar = True
WindowState = WindowState.Normal
Hidden = False
Topmost = True '偶尔 SetForegroundWindow 失效
Topmost = False
SetForegroundWindow(Handle)
Focus()
Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height)
End Sub)
RunInUi(
Sub()
'这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
Visibility = Visibility.Visible
ShowInTaskbar = True
WindowState = WindowState.Normal
Hidden = False
Topmost = True '偶尔 SetForegroundWindow 失效
Topmost = False
SetForegroundWindow(Handle)
Focus()
Log($"[System] 窗口已置顶,位置:({Left}, {Top}), {Width} x {Height}")
End Sub)
End Sub
#End Region
Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

+156 -100
View File
@@ -1,4 +1,5 @@
Imports System.IO.Compression
Imports System.Globalization
Imports System.IO.Compression
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
@@ -11,12 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.0." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.9" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.9." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 326 'Release
Public Const VersionCode As Integer = 340 'Release
#Else
Public Const VersionCode As Integer = 327 'Snapshot
Public Const VersionCode As Integer = 341 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -64,7 +66,7 @@ Public Module ModBase
''' </summary>
Public ApplicationOpenTime As Date = Date.Now
''' <summary>
''' 设备唯一标识符。
''' 识别码。
''' </summary>
Public UniqueAddress As String = SecretGetUniqueAddress()
''' <summary>
@@ -80,13 +82,9 @@ Public Module ModBase
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary>
@@ -178,6 +176,10 @@ Public Module ModBase
''' </summary>
Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
''' <summary>
''' 图标,服务端,1x
''' </summary>
Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
''' <summary>
''' 图标,音符,1x
''' </summary>
Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z"
@@ -700,7 +702,7 @@ Public Module ModBase
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString)
Catch ex As Exception
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})")
Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogLevel.Hint)
End Try
End Sub
@@ -774,10 +776,10 @@ Public Module ModBase
End Try
End Sub
''' <summary>
''' 读取文件,如果失败则返回空字符串。
''' 读取文件,如果失败则返回空数组。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -787,17 +789,25 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
Return FileBytes
Else
Log("[System] 欲读取的文件不存在,已返回空字符串:" & FilePath)
Return ""
Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
Return {}
End If
Catch ex As Exception
Log(ex, "读取文件出错:" & FilePath)
Return ""
Return {}
End Try
End Function
''' <summary>
''' 读取文件,如果失败则返回空字符串。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Dim FileBytes = ReadFileBytes(FilePath)
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
End Function
''' <summary>
''' 读取流中的所有文本。
''' </summary>
Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
@@ -822,50 +832,39 @@ Public Module ModBase
''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Text">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
If File.Exists(FilePath) Then
'如果文件存在,刷新目前文件
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath)))
writer.Write(Text)
writer.Flush()
writer.Close()
End Using
Else
'如果文件不存在,则新建并写入
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
End If
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
If File.Exists(FilePath) Then
'如果文件存在,刷新目前文件
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
writer.Write(Text)
writer.Flush()
writer.Close()
End Using
Else
'如果文件不存在,则新建并写入
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
End If
End Sub
''' <summary>
''' 写入文件。
''' 如果 CanThrow 设置为 False,返回是否写入成功。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Content">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
File.WriteAllBytes(FilePath, Content)
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
File.WriteAllBytes(FilePath, Content)
End Sub
''' <summary>
''' 将流写入文件。
''' </summary>
@@ -895,21 +894,11 @@ Public Module ModBase
'文件编码
''' <summary>
''' 获取文件编码。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function GetEncoding(FilePath As String) As Encoding
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'获取编码
GetEncoding = GetEncoding(File.ReadAllBytes(FilePath))
End Function
''' <summary>
''' 获取 Bytes 的编码。
''' 根据字节数组分析其编码。
''' </summary>
Public Function GetEncoding(Bytes As Byte()) As Encoding
Dim Length As Integer = Bytes.Count
If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
'根据 BOM 判断编码
If Bytes(0) >= &HEF Then
'有 BOM 类型
@@ -1016,7 +1005,7 @@ Public Module ModBase
''' </summary>
Public Function CheckPermission(Path As String) As Boolean
Try
If Path = "" Then Return False
If String.IsNullOrEmpty(Path) Then Return False
If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False
@@ -1108,8 +1097,6 @@ Re:
Dim Retry As Boolean = False
Re:
Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1255,28 +1242,47 @@ Re:
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
If Not Directory.Exists(Path) Then Return 0
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
Dim Files As String()
Try
Files = Directory.GetFiles(Path)
Catch ex As DirectoryNotFoundException '#4549
Log(ex, $"疑似为孤立符号链接,尝试直接删除({Path})", LogLevel.Developer)
Directory.Delete(Path)
Return 0
End Try
For Each FilePath As String In Files
Dim RetriedFile As Boolean = False
RetryFile:
Try
File.Delete(str)
File.Delete(FilePath)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
Else
Throw
End If
End Try
Next
Temp = Directory.GetDirectories(Path)
For Each str As String In Temp
For Each str As String In Directory.GetDirectories(Path)
DeleteDirectory(str, IgnoreIssue)
Next
Dim RetriedDir As Boolean = False
RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败")
Else
Throw
@@ -1342,8 +1348,8 @@ Re:
'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
@@ -1362,7 +1368,7 @@ Re:
If CommonReason Is Nothing Then
Return Desc & Stack & TypeDesc
Else
Dim Result As String = DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf
Dim Result As String = CommonReason & vbCrLf & DescList.First & vbCrLf & "————————————" & vbCrLf
DescList(0) = "详细错误信息:"
Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc
End If
@@ -1390,8 +1396,8 @@ Re:
'常见错误(记得同时修改上面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
@@ -1405,7 +1411,7 @@ Re:
'构造输出信息
If CommonReason IsNot Nothing Then
Return DescList.First & ":" & CommonReason
Return CommonReason & "详细错误:" & DescList.First
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
@@ -1445,14 +1451,14 @@ Re:
End Function
''' <summary>
''' 获取 Json 对象。
''' 获取 JSON 对象。
''' </summary>
Public Function GetJson(Data As String)
Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception
Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 json 对象失败:" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
End Try
End Function
@@ -1573,14 +1579,14 @@ Re:
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then
StartPos += Before.Length
StartPos += After.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
@@ -1641,10 +1647,15 @@ Re:
End Function
''' <summary>
''' 输入 And 字符不会报错的 Val。
''' 不会报错的 Val。
''' 如果输入有误,返回 0。
''' </summary>
Public Function Val(Str As Object) As Double
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Try
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Catch
Return 0
End Try
End Function
'转义
@@ -1652,7 +1663,10 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
@@ -1798,10 +1812,10 @@ Re:
'进行搜索,获取相似信息
For Each Entry In Entries
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
Entry.AbsoluteRight = False
For Each Pair In Entry.SearchSource
If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
Next
Entry.AbsoluteRight =
Query.Split(" ").All( '对于按空格分割的每一段
Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配,则标记为完全匹配项
Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
Next
'按照相似度进行排序
Entries = Sort(Entries,
@@ -1830,6 +1844,29 @@ Re:
#Region "系统"
''' <summary>
''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
''' </summary>
Public PathPure As String = GetPureASCIIDir()
Private Function GetPureASCIIDir() As String
If (Path & "PCL").IsASCII() Then
Return Path & "PCL\"
ElseIf PathAppdata.IsASCII() Then
Return PathAppdata
ElseIf PathTemp.IsASCII() Then
Return PathTemp
Else
Return OsDrive & "ProgramData\PCL\"
End If
End Function
''' <summary>
''' 指示接取到这个异常的函数进行重试。
''' </summary>
Public Class RestartException
Inherits Exception
End Class
''' <summary>
''' 当前程序是否拥有管理员权限。
''' </summary>
@@ -1848,6 +1885,13 @@ Re:
Return NewProcess.ExitCode
End Function
''' <summary>
''' 判断当前系统语言是否为中文。
''' </summary>
Public Function IsSystemLanguageChinese() As Boolean
Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
End Function
Private Uuid As Integer = 1
Private UuidLock As Object
''' <summary>
@@ -2413,6 +2457,14 @@ Retry:
Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
End Function
''' <summary>
''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
''' </summary>
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
Return Control.DesiredSize.Width > Control.ActualWidth
End Function
#End Region
#Region "Debug"
@@ -2653,7 +2705,11 @@ Retry:
End Sub
Public Function CanFeedback(ShowHint As Boolean) As Boolean
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If ShowHint Then MyMsgBox("你的 PCL 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈")
If ShowHint Then
If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
UpdateCheckByButton()
End If
End If
Return False
Else
Return True
@@ -2665,7 +2721,7 @@ Retry:
Public Sub FeedbackInfo()
On Error Resume Next
Log("[System] 诊断信息:" & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
@@ -91,17 +91,18 @@
_State = value
Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(Sub()
Select Case value
Case LoadState.Loading
LoadingState = MyLoading.MyLoadingState.Run
Case LoadState.Failed
LoadingState = MyLoading.MyLoadingState.Error
Case Else
LoadingState = MyLoading.MyLoadingState.Stop
End Select
RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
RunInUi(
Sub()
Select Case value
Case LoadState.Loading
LoadingState = MyLoading.MyLoadingState.Run
Case LoadState.Failed
LoadingState = MyLoading.MyLoadingState.Error
Case Else
LoadingState = MyLoading.MyLoadingState.Stop
End Select
RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
End Set
End Property
@@ -287,15 +288,13 @@
End SyncLock
End Try
'检验输入以确定情况
If (Not IsForceRestart) AndAlso '不要求强行重启
((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同
(State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功
If IsForceRestart Then Return True '强制要求重启
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
'如果输入相同且未出错则不重试
Return False
Return False '则不重试
Else
'需要开始
Return True
Return True '需要开始
End If
End Function
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
@@ -316,7 +315,7 @@
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动")
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已" & If(IsForceRestarting, "强制", "") & "启动")
LoadDelegate(Me)
If IsAborted Then
Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束,输出被弃用(最新线程:" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & ")", LogLevel.Developer)
@@ -440,12 +439,13 @@
Exit Sub
End If
End SyncLock
RunInThread(Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
RunInThread(
Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
End Sub
''' <summary>
@@ -484,7 +484,7 @@
Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
Dim IsFinished As Boolean = True
Dim Ignore As Boolean = False
Dim Blocked As Boolean = False
Dim Input As Object = Me.Input
For Each Loader In Loaders
Select Case Loader.State
@@ -492,28 +492,30 @@
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
End If
'更新下一个加载器的输入
Input = CType(Loader, Object).Output
End If
'如果不让继续启动,且已有加载器正在加载中,就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
End If
End If
'已经有正在加载中的了,不需要再启动了
IsFinished = False
Ignore = True
Blocked = True
Case Else
Restart:
'未启动,则启动加载器
IsFinished = False
If Ignore Then Continue For
If Blocked Then Continue For
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
@@ -527,8 +529,8 @@ Restart:
Else
Loader.Start(IsForceRestart:=IsForceRestarting)
End If
'如果不让继续启动,那就不启动呗
If Loader.Block Then Ignore = True
'阻止继续
If Loader.Block Then Blocked = True
End Select
Next
If IsFinished Then
@@ -566,38 +568,33 @@ Restart:
End Class
'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbar As New SynchronizedCollection(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
End SyncLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar.ToList()
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
@@ -625,15 +622,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
+84 -69
View File
@@ -1,5 +1,4 @@
Imports System.Net
Imports PCL.ModNet
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -141,7 +140,7 @@ Retry:
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Public Function NetGetCodeByRequestMultiple(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing
@@ -207,10 +206,10 @@ RequestFinished:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时,已接收 " & Result.Count & " B(" & Url & ")")
If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException($"获取结果失败({CType(ex, WebException).Status},{ex.Message},{Url})", ex)
Else
Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex)
Throw New WebException($"获取结果失败({If(TypeOf ex Is WebException, CType(ex, WebException).Status & ",", "")}{ex.Message},{Url})", ex)
End If
Finally
Request.Abort()
@@ -269,12 +268,7 @@ RequestFinished:
'下载
Using Client As New WebClient
Try
If UseBrowserUserAgent Then
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode
End If
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
SecretHeadersSign(Url, Client, UseBrowserUserAgent)
Client.DownloadFile(Url, LocalFile)
Catch ex As Exception
File.Delete(LocalFile)
@@ -316,7 +310,7 @@ Retry:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999
If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then Throw
Select Case RetryCount
Case 0
If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")")
@@ -335,7 +329,7 @@ Retry:
''' <summary>
''' 同时发送多个网络请求并要求返回内容。
''' </summary>
Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
Public Function NetRequestMultiple(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True)
Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing
@@ -344,7 +338,7 @@ Retry:
Dim th As New Thread(
Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog)
Catch ex As Exception
FailCount += 1
RequestEx = ex
@@ -419,7 +413,7 @@ RequestFinished:
Throw
Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then
Throw New WebException("连接服务器超时,请检查你的网络环境是否良好(" & Url & ")", ex)
ex = New WebException($"连接服务器超时,请检查你的网络环境是否良好({ex.Message},{Url})", ex)
Else
'获取请求失败的返回
Dim Res As String = ""
@@ -433,15 +427,34 @@ RequestFinished:
End Using
Catch
End Try
Throw New WebException("网络请求失败(" & Url & "," & ex.Message & ")" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex)
If Res = "" Then
ex = New WebException($"网络请求失败({ex.Status},{ex.Message},{Url})", ex)
Else
ex = New ResponsedWebException($"服务器返回错误({ex.Status},{ex.Message},{Url}){vbCrLf}{Res}", Res, ex)
End If
End If
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Catch ex As Exception
Throw New WebException("网络请求失败(" & Url & ")", ex)
ex = New WebException("网络请求失败(" & Url & ")", ex)
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Finally
If DataStream IsNot Nothing Then DataStream.Dispose()
If Resp IsNot Nothing Then Resp.Dispose()
End Try
End Function
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
Public Overloads Property Response As String
Public Sub New(Message As String, Response As String, InnerException As Exception)
MyBase.New(Message, InnerException)
Me.Response = Response
End Sub
End Class
''' <summary>
''' 最大线程数。
@@ -688,8 +701,7 @@ RequestFinished:
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New List(Of LoaderDownload)
Public Tasks As New SynchronizedCollection(Of LoaderDownload)
''' <summary>
''' 所有下载源。
''' </summary>
@@ -881,7 +893,6 @@ RequestFinished:
Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean
@@ -928,7 +939,6 @@ RequestFinished:
Dim StartPosition As Long, StartSource As NetSource = Nothing
Dim Th As Thread, ThreadInfo As NetThread
SyncLock LockChain
'获取线程起点与下载源
'不分割
If IsNoSplit Then GoTo Capture
@@ -964,7 +974,7 @@ Capture:
Next
'是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads
@@ -980,10 +990,8 @@ StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
'链表处理
If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
@@ -1040,6 +1048,15 @@ StartThread:
If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
Log($"[Download] {LocalName} {Info.Uuid}#:重定向至 {HttpResponse.ResponseUri.OriginalString}")
End If
''从响应头获取文件名
'If Info.IsFirstThread Then
' Dim FileName As String = GetFileNameFromResponse(HttpResponse)
' If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#:远程文件名:{If(FileName, "未提供")}")
' If FileName IsNot Nothing AndAlso LocalName = "待定" Then
' LocalName = FileName
' Log($"[Download] {LocalName} {Info.Uuid}#:从响应头获取到文件名")
' End If
'End If
'文件大小校验
ContentLength = HttpResponse.ContentLength
If ContentLength = -1 Then
@@ -1124,7 +1141,7 @@ NotSupportRange:
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
End SyncLock
Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime
If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值
If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值
If RealDataCount > 0 Then
'有数据
If Info.DownloadDone = 0 Then
@@ -1140,11 +1157,9 @@ NotSupportRange:
End If
SyncLock LockCount
Info.Source.FailCount = 0
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount = 0
Next
End SyncLock
For Each Task In Tasks
Task.FailCount = 0
Next
End SyncLock
NetManager.DownloadDone += RealDataCount
SyncLock LockDone
@@ -1167,7 +1182,7 @@ NotSupportRange:
ResultStream.Write(HttpData, 0, RealDataCount)
End If
'检查速度是否过慢
If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s,且速度小于 1K/s
If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1.5s,且速度小于 1.5K/s
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
End If
Info.LastReceiveTime = GetTimeTick()
@@ -1198,11 +1213,9 @@ SourceBreak:
'状态变更
SyncLock LockCount
Info.Source.FailCount += 1
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount += 1
Next
End SyncLock
For Each Task In Tasks
Task.FailCount += 1
Next
End SyncLock
Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
@@ -1281,6 +1294,17 @@ Wrong:
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try
End Sub
''' <summary>
''' 从 HTTP 响应头中获取文件名。
''' 如果没有,返回 Nothing。
''' </summary>
Private Function GetFileNameFromResponse(response As HttpWebResponse) As String
Dim header As String = response.Headers("Content-Disposition")
If String.IsNullOrEmpty(header) Then Return Nothing
'attachment; filename="filename.ext"
If Not header.Contains("filename=") Then Return Nothing
Return header.After("filename=").Trim(""""c, " "c).Before(";")
End Function
'下载文件的最终收束事件
''' <summary>
@@ -1307,7 +1331,7 @@ Retry:
'合并文件
If IsNoSplit Then
'仅有一个线程,从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件")
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件,长度:" & SmailFileCache.Count)
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray)
@@ -1338,13 +1362,13 @@ Retry:
If Check.ActualSize = -1 Then
Check.ActualSize = FileSize
ElseIf Check.ActualSize <> FileSize Then
Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B,网络获取结果为 " & FileSize & "B")
Throw New Exception($"文件大小不一致:任务要求为 {Check.ActualSize} B,网络获取结果为 {FileSize}B")
End If
End If
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 合并文件失败,下载线程细节:")
Log($"[Download] {LocalName} 文件校验失败,下载线程细节:")
For Each Th As NetThread In Threads
Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
Next
@@ -1397,10 +1421,8 @@ Retry:
''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载
SyncLock LockTasks
Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub
End SyncLock
Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub
'确认中断
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
@@ -1430,11 +1452,9 @@ Retry:
NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
End SyncLock
SyncLock LockTasks
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
End SyncLock
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
End Sub
End Class
@@ -1652,6 +1672,9 @@ NextElement:
'复制已存在的文件
For Each FileToken In ExistFiles
Dim File As NetFile = FileToken.Key
SyncLock LockState
If File.State > NetState.WaitForCopy Then Exit Sub
End SyncLock
Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0
Retry:
@@ -1880,7 +1903,7 @@ Retry:
For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
Next
'为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
@@ -1900,7 +1923,7 @@ Retry:
'新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
Next
End While
Catch ex As Exception
@@ -1961,9 +1984,7 @@ Retry:
If Files(File.LocalPath).State >= NetState.Finish Then
'该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
Files(File.LocalPath) = File
SyncLock LockRemain
FileRemain += 1
@@ -1974,15 +1995,11 @@ Retry:
'该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件
File = Files(File.LocalPath)
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
End If
Else
'没有该文件
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
Files.Add(File.LocalPath, File)
SyncLock LockRemain
FileRemain += 1
@@ -2004,14 +2021,12 @@ Retry:
''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </summary>
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
Return True
End If
Next
End SyncLock
For Each Task In LoaderTaskbar.ToList()
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
Return True
End If
Next
Return False
End Function
@@ -233,6 +233,8 @@ Public Class ValidateFolderName
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
'检查文件夹重名
Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then
@@ -286,6 +288,8 @@ Public Class ValidateFileName
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
@@ -351,6 +355,8 @@ Fin:
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
Next
Return ""
End Function
@@ -7,7 +7,7 @@ Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Dictionary(Of String, MyBitmap)
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary>
''' 存储的图片
@@ -61,23 +61,32 @@ Public Class MyBitmap
Pic = BitmapCache(FilePathOrResourceName).Pic
Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.Add(FilePathOrResourceName, Pic)
BitmapCache.TryAdd(FilePathOrResourceName, Pic)
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
Pic = New System.Drawing.Bitmap(InputStream)
InputStream.Dispose()
'判断是否为 WebP 文件头
Dim Header(1) As Byte
InputStream.Read(Header, 0, 2)
InputStream.Seek(0, SeekOrigin.Begin)
If Header(0) = 82 AndAlso Header(1) = 73 Then
'读取 WebP
Dim FileBytes(InputStream.Length - 1) As Byte
InputStream.Read(FileBytes, 0, FileBytes.Length)
Pic = WebPDecoder.DecodeFromBytes(FileBytes) '将代码隔离在另外一个类中,这样只要不走进这个分支就不会加载 Imazen.WebP.dll
Else
Pic = New System.Drawing.Bitmap(InputStream)
End If
End Using
End If
Catch ex As Exception
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, $"加载位图失败({FilePathOrResourceName})")
Throw
Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex)
Else
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer)
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try
End If
End Try
@@ -104,6 +113,13 @@ Public Class MyBitmap
Pic = New System.Drawing.Bitmap(MS)
End Using
End Sub
Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
End Function
End Class
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
@@ -247,7 +247,13 @@
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
If Data("logo").Count > 0 Then
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
LogoUrl = Data("logo")("url")
Else
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
'FileIndexes / GameVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
@@ -278,7 +284,8 @@
End If
'Tags
Tags = New List(Of String)
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段:https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category
'Mod
Case 406 : Tags.Add("世界元素")
@@ -385,9 +392,9 @@
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪")
Case "kitchen-sink" : Tags.Add("大杂烩")
Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res
'FUTURE: Res
End Select
Next
If Not Tags.Any() Then Tags.Add("杂项")
@@ -416,7 +423,7 @@
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
@@ -535,7 +542,7 @@
Return NewItem
End Function
Public Function GetControlLogo() As String
If LogoUrl Is Nothing Then
If String.IsNullOrEmpty(LogoUrl) Then
Return PathImage & "Icons/NoIcon.png"
Else
Return LogoUrl
@@ -629,19 +636,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -943,30 +950,30 @@ Retry:
Dim CurseForgeFailed As Boolean = False
If CurseForgeUrl IsNot Nothing Then
CurseForgeThread = RunInNewThread(
Sub()
Try
'获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data")
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
SyncLock ResultsLock
RawResults.AddRange(ProjectList)
End SyncLock
Storage.CurseForgeOffset += ProjectList.Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = Storage.CurseForgeOffset
[Error] = ex
CurseForgeFailed = True
End Try
End Sub, "CurseForge Project Request")
Sub()
Try
'获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data")
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
SyncLock ResultsLock
RawResults.AddRange(ProjectList)
End SyncLock
Storage.CurseForgeOffset += ProjectList.Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex
CurseForgeFailed = True
End Try
End Sub, "CurseForge Project Request")
End If
'启动 Modrinth 线程
@@ -974,32 +981,32 @@ Retry:
Dim ModrinthFailed As Boolean = False
If ModrinthUrl IsNot Nothing Then
ModrinthThread = RunInNewThread(
Sub()
Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New CompProject(JsonEntry))
Sub()
Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
SyncLock ResultsLock
For Each Project In ProjectList
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
RawResults.Add(Project)
Next
'更新结果
SyncLock ResultsLock
For Each Project In ProjectList
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
RawResults.Add(Project)
Next
End SyncLock
Storage.ModrinthOffset += ProjectList.Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
End Try
End Sub, "Modrinth Project Request")
End SyncLock
Storage.ModrinthOffset += ProjectList.Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
End Try
End Sub, "Modrinth Project Request")
End If
'等待线程结束
@@ -1021,7 +1028,7 @@ Retry:
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有符合条件的结果")
Throw New Exception("没有搜索结果")
End If
End If
ElseIf [Error] IsNot Nothing Then
@@ -1076,7 +1083,7 @@ Retry:
If String.IsNullOrEmpty(Task.Input.SearchText) Then
'如果没有搜索文本,按下载量将结果排序
For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30))
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
Next
Else
'如果有搜索文本,按关联度将结果排序
@@ -1084,7 +1091,7 @@ Retry:
Dim Entry As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9)
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -1253,7 +1260,9 @@ Retry:
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}).Distinct().ToList()
Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
@@ -1287,11 +1296,10 @@ Retry:
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Any() Then
If CType(Data("files"), JArray).Any() Then '可能为空
Dim File As JToken = Data("files")(0)
FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")}
DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Hash = File("hashes")("sha1")
End If
'Dependencies
@@ -1427,9 +1435,9 @@ Retry:
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
TargetProject = CompProjectCache(ProjectId)
ElseIf FromCurseForge Then 'CurseForge
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"))
TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
Else 'Modrinth
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8))
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If
'获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId)
@@ -1437,13 +1445,13 @@ Retry:
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If
Else
'Modrinth
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
@@ -1457,11 +1465,10 @@ Retry:
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods",
Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
"POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
Else
Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
Accept:="application/json", IsJson:=True)
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
End If
For Each Project In Projects
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
@@ -1469,7 +1476,7 @@ Retry:
End If
'更新前置 Mod 信息
If Deps.Any Then
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId)
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
File.Dependencies.Add(DepProject.Id)
@@ -1489,10 +1496,11 @@ Retry:
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort()
If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep)
End Function).ToList
Deps = Deps.Where(
Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置 Mod 列表
@@ -389,7 +389,7 @@ Extracted:
版本Json中存在多个Forge
Mod过多导致超出ID限制
NightConfig的Bug
ShadersMod与Optifine同时安装
ShadersMod与OptiFine同时安装
Forge安装不完整
Mod需要Java11
Mod缺少前置或MC版本错误
@@ -516,7 +516,7 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
@@ -525,6 +525,7 @@ Done:
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
@@ -623,8 +624,11 @@ Done:
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Suspected Mod") Then
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If
End If
@@ -744,7 +748,7 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ContainsF(".jar", True) OrElse
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -844,8 +848,11 @@ NextStack:
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示
FrmMain.ShowWindowToTop()
Dim ShowLog As Action =
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub()
'弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key)
Else
@@ -853,11 +860,9 @@ NextStack:
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath)
End If
End Sub
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
End Sub))
Case 3
'弹窗选择:导出错误报告
Dim FileAddress As String = Nothing
Try
'获取文件路径
@@ -881,7 +886,11 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
Next
'导出报告
@@ -938,9 +947,9 @@ NextStack:
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
@@ -976,7 +985,7 @@ NextStack:
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
@@ -988,7 +997,7 @@ NextStack:
If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
@@ -998,12 +1007,12 @@ NextStack:
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.ShadersMod与Optifine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.ShadersMod与OptiFine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Results.Add("可能由于其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.Mod需要Java11
@@ -1029,7 +1038,7 @@ NextStack:
Case CrashReason.文件或内容校验失败
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
Case CrashReason.Forge安装不完整
Results.Add("由于 Forge 安装不完整,导致游戏无法正常运行。\n请尝试重新安装 Forge。\h")
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
@@ -8,21 +8,20 @@
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable Then
'是否跳过
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
End If
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
@@ -52,7 +51,7 @@
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件"
@@ -65,9 +64,9 @@
#End Region
#Region "下载资源文件"
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
If ShouldIgnoreFileCheck(Version) Then
Log("[Download] 已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
@@ -100,7 +99,7 @@
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新:每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引")
Log("[Download] 无需更新资源文件索引,取消")
Task.Abort()
End If
End Sub))
@@ -117,7 +116,7 @@
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
@@ -610,7 +609,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -679,7 +680,9 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -828,8 +831,8 @@
''' <summary>
''' NeoForge 版本列表,BMCLAPI。
''' </summary>
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListOfficialMain)
Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
@@ -1075,29 +1078,155 @@
#End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequest。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
'UNDONE: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequest。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
'UNDONE: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Public Function DlSourceResourceGet(Original As String) As String()
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
MojangBase
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
}
End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String()
Public Function DlSourceLibraryGet(Original As String) As String()
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
MojangBase
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Public Function DlSourceModGet(Original As String) As String
Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
MojangBase
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
}
End Function
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 6
Public JavaListCacheVersion As Integer = 7
''' <summary>
''' 目前所有可用的 Java。
@@ -216,10 +216,12 @@
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList
@@ -550,7 +552,7 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -4,6 +4,7 @@ Public Module ModLaunch
#Region "开始"
Public CurrentLaunchOptions As McLaunchOptions = Nothing
Public Class McLaunchOptions
''' <summary>
''' 强制指定在启动后进入的服务器 IP。
@@ -20,32 +21,34 @@ Public Module ModLaunch
''' 默认值:Nothing。使用 McVersionCurrent。
''' </summary>
Public Version As McVersion = Nothing
''' <summary>
''' 额外的启动参数。
''' </summary>
Public ExtraArgs As New List(Of String)
End Class
''' <summary>
''' 尝试启动 Minecraft。必须在 UI 线程调用。
''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
''' </summary>
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
Options = If(Options, New McLaunchOptions)
CurrentLaunchOptions = If(Options, New McLaunchOptions)
'预检查
If Not RunInUi() Then
Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
End If
If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中!", HintType.Critical)
Return False
End If
'强制切换需要启动的版本
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
'检查版本
Options.Version.Load()
If Options.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft:" & Options.Version.Info, HintType.Critical)
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Critical)
Return False
End If
'切换版本
McVersionCurrent = Options.Version
McVersionCurrent = CurrentLaunchOptions.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False)
@@ -95,7 +98,7 @@ Public Module ModLaunch
McLaunchPrecheck()
McLaunchLog("预检测已通过")
Catch ex As Exception
Hint(ex.Message, HintType.Critical)
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
Throw
End Try
'正式加载
@@ -103,8 +106,8 @@ Public Module ModLaunch
'构造主加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
McLoginLoader, '.ProgressWeight = 15, .Block = False
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -144,7 +147,7 @@ Public Module ModLaunch
Hint(McVersionCurrent.Name & " 启动成功!", HintType.Finish)
Case LoadState.Aborted
If AbortHint Is Nothing Then
Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
Else
Hint(AbortHint, HintType.Finish)
End If
@@ -159,7 +162,7 @@ NextInner:
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息,则以此为准显示提示
'若错误信息为 $$,则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误
@@ -168,7 +171,9 @@ NextInner:
Else
'没有特殊处理过的错误信息
McLaunchLog("错误:" & GetExceptionDetail(ex))
Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Log(ex,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Throw
End If
End Try
@@ -211,36 +216,45 @@ NextInner:
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info)
'检查输入信息
Dim CheckResult As String = ""
RunInUiWait(Sub()
Dim LoginInput As McLoginData = McLoginInput()
CheckResult = McLoginAble(LoginInput)
End Sub)
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
RunInNewThread(Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.net/a/LTCat")
End If
End Select
End Sub, "Donate")
RunInNewThread(
Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
End Sub, "Donate")
#End If
'正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
Select Case Setup.Get("SystemLaunchCount")
Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
"如果觉得 Minecraft 还不错,也可以考虑购买正版支持一下,毕竟开发游戏也很不容易……" & vbCrLf &
"在你登录一次正版账号后,就不会再出现这个提示了。",
"考虑一下正版?", "购买正版游戏", "下次一定") = 1 Then
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End If
End Select
If IsSystemLanguageChinese() Then
Select Case Setup.Get("SystemLaunchCount")
Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
"如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
"在你登录一次正版账号后,就不会再出现这个提示了!",
"考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End If
End Select
ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
Case 2
Hint("游戏将以试玩模式启动!", HintType.Critical)
CurrentLaunchOptions.ExtraArgs.Add("--demo")
Case 3
Throw New Exception("$$")
End Select
End If
End If
End Sub
@@ -364,7 +378,7 @@ NextInner:
'根据当前登录方式优先返回
Select Case Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
Case McLoginType.Legacy
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Case McLoginType.Nide
@@ -373,7 +387,7 @@ NextInner:
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
End Select
'查找所有可能的项
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
@@ -385,7 +399,7 @@ NextInner:
Public Function McLoginAble() As String
Select Case Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
Return FrmLoginMs.IsVaild()
Else
Return ""
@@ -436,7 +450,7 @@ NextInner:
Case McLoginType.Legacy
LoginData = PageLoginLegacy.GetLoginData()
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
LoginData = PageLoginMs.GetLoginData()
Else
LoginData = PageLoginMsSkin.GetLoginData()
@@ -487,19 +501,22 @@ NextInner:
#Region "分方式登录模块"
'各个登录方式的主对象与输入构造
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000}
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart)
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
'主加载函数,返回所有需要的登录信息
Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
Dim Input As McLoginMs = Data.Input
Dim LogUsername As String = Input.UserName
McLaunchLog("登录方式:正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
Data.Progress = 0.05
'检查是否已经登录完成
If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then
If Not Data.IsForceRestarting AndAlso '不要求强行重启
Input.AccessToken <> "" AndAlso '已经登录过了
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
Data.Output = New McLoginResult With
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
GoTo SkipLogin
@@ -509,49 +526,47 @@ NextInner:
If Input.OAuthRefreshToken = "" Then
'无 RefreshToken
Relogin:
Dim OAuthCode As String = MsLoginStep1(Data)
If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.2
OAuthTokens = MsLoginStep2(OAuthCode, False)
OAuthTokens = MsLoginStep1New(Data)
Else
'有 RefreshToken
OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True)
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
If OAuthTokens(0) = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
End If
'要求重新打开登录网页认证
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
Data.Progress = 0.35
If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.25
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim OAuthAccessToken As String = OAuthTokens(0)
Dim OAuthRefreshToken As String = OAuthTokens(1)
Dim XBLToken As String = MsLoginStep3(OAuthAccessToken)
Data.Progress = 0.5
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.4
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Tokens = MsLoginStep4(XBLToken)
Data.Progress = 0.65
Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.55
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim AccessToken As String = MsLoginStep5(Tokens)
Data.Progress = 0.8
Dim AccessToken As String = MsLoginStep4(Tokens)
Data.Progress = 0.7
If Data.IsAborted Then Throw New ThreadInterruptedException
MsLoginStep6(AccessToken)
Data.Progress = 0.9
MsLoginStep5(AccessToken)
Data.Progress = 0.85
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep7(AccessToken)
Dim Result = MsLoginStep6(AccessToken)
Data.Progress = 0.98
'输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken)
Setup.Set("CacheMsUuid", Result(0))
Setup.Set("CacheMsName", Result(1))
Setup.Set("CacheMsProfileJson", Result(2))
Setup.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsV2Access", AccessToken)
Setup.Set("CacheMsV2Uuid", Result(0))
Setup.Set("CacheMsV2Name", Result(1))
Setup.Set("CacheMsV2ProfileJson", Result(2))
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
MsJson.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result(1)) = OAuthRefreshToken
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
'解锁主题
SkipLogin:
'结束
McLoginMsRefreshTime = GetTimeTick()
McLaunchLog("微软登录完成")
SkipLogin:
Setup.Set("HintBuy", True) '关闭正版购买提示
Data.Progress = 0.98
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
End Sub
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -668,6 +683,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/validate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8") '没有返回值的
'将登录结果输出
Data.Output.AccessToken = AccessToken
@@ -691,6 +707,7 @@ LoginFinish:
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
@@ -721,6 +738,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8"))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
@@ -780,6 +798,16 @@ LoginFinish:
Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败:" & ErrorMessage)
End If
'通用关键字检测
If AllMessage.Contains("403") Then
Select Case Data.Input.Type
Case McLoginType.Auth
@@ -805,90 +833,48 @@ LoginFinish:
End Try
End Function
'微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1")
If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849,WebBrowser 已经无法正常加载微软登录网页了
SystemBrowser:
'Windows 7 或老版 Windows 10 登录
OpenWebsite(FormLoginOAuth.LoginUrl1)
Dim Result As String =
MyMsgBoxInput("等待网页登录",
"登录完成后,网页会变得完全空白,把那个空白网页的网址复制到下面的框中就行了!" & vbCrLf &
"如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
If Result Is Nothing Then
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
'微软登录步骤 1,原始登录:获取 DeviceCode 并开启登录网页
Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
'参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
'初始请求
Retry:
McLaunchLog("开始微软登录步骤 1/6(原始登录)")
Dim PrepareJson As JObject = GetJson(NetRequestRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded"))
McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
'弹窗
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
WaitingMyMsgBox.Add(Converter)
While Converter.Result Is Nothing
Thread.Sleep(100)
End While
If TypeOf Converter.Result Is RestartException Then
If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ},然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项,请选择 {vbLQ}设置密码{vbRQ},设置完毕后再登录。",
"需要使用密码登录", "重新登录", "设置密码", "取消",
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
GoTo Retry
Else
Return RegexSeek(Result, "(?<=code\=)[^&]+")
Throw New Exception("$$")
End If
Hint("网页登录成功,你可以关闭浏览器啦!", HintType.Finish)
ElseIf TypeOf Converter.Result Is Exception Then
Throw CType(Converter.Result, Exception)
Else
'Windows 10 登录
Dim ReturnCode As String = Nothing
Dim ReturnEx As Exception = Nothing
Dim IsFinished As LoadState = LoadState.Loading
Dim LoginForm As FormLoginOAuth = Nothing
Dim IsSwitchToSystemBrowser As Boolean = False
RunInUi(Sub()
Try
LoginForm = New FormLoginOAuth
LoginForm.Show()
AddHandler LoginForm.OnLoginSuccess, Sub(Code As String)
ReturnCode = Code
IsFinished = LoadState.Finished
End Sub
AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
IsFinished = LoadState.Aborted
IsSwitchToSystemBrowser = IsSwitch
End Sub
Catch ex As Exception
ReturnEx = ex
IsFinished = LoadState.Failed
End Try
End Sub)
Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted
Thread.Sleep(20)
Loop
RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close())
If IsFinished = LoadState.Finished Then
Return ReturnCode
ElseIf IsFinished = LoadState.Failed Then
Throw ReturnEx
ElseIf IsSwitchToSystemBrowser Then
McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
GoTo SystemBrowser
Else
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
End If
Return Converter.Result
End If
End Function
'微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String()
McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
'微软登录步骤 1,刷新登录:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
Private Function MsLoginStep1Refresh(Code As String) As String()
McLaunchLog("开始微软登录步骤 1/6(刷新登录)")
Dim Request As String
If IsRefresh Then
Request = "client_id=00000000402b5328" & "&" &
"refresh_token=" & Uri.EscapeDataString(Code) & "&" &
"grant_type=refresh_token" & "&" &
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
Else
Request = "client_id=00000000402b5328" & "&" &
"code=" & Uri.EscapeDataString(Code) & "&" &
"grant_type=authorization_code" & "&" &
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
End If
Dim Result As String
Try
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2)
Result = NetRequestMultiple("https://login.live.com/oauth20_token.srf", "POST",
$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
"application/x-www-form-urlencoded", 2)
Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
If ex.Message.Contains("must sign in again") OrElse (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269
Return {"Relogin", ""}
Else
Throw
@@ -900,28 +886,28 @@ SystemBrowser:
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return {AccessToken, RefreshToken}
End Function
'微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
Private Function MsLoginStep3(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 3")
'微软登录步骤 2:从 OAuth AccessToken 获取 XBLToken
Private Function MsLoginStep2(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 2/6")
Dim Request As String = "{
""Properties"": {
""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": """ & AccessToken & """
},
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
""Properties"": {
""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
},
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestMultiple("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
End Function
'微软登录步骤 4:从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep4(XBLToken As String) As String()
McLaunchLog("开始微软登录步骤 4")
'微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As String()
McLaunchLog("开始微软登录步骤 3/6")
Dim Request As String = "{
""Properties"": {
@@ -935,7 +921,7 @@ SystemBrowser:
}"
Dim Result As String
Try
Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Result = NetRequestMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Message.Contains("2148916227") Then
@@ -971,14 +957,14 @@ SystemBrowser:
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
Return {XSTSToken, UHS}
End Function
'微软登录步骤 5:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
Private Function MsLoginStep5(Tokens As String()) As String
McLaunchLog("开始微软登录步骤 5")
'微软登录步骤 4:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
Private Function MsLoginStep4(Tokens As String()) As String
McLaunchLog("开始微软登录步骤 4/6")
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
Dim Result As String
Try
Result = NetRequestMulty("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Result = NetRequestRetry("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json")
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
@@ -996,11 +982,11 @@ SystemBrowser:
Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken
End Function
'微软登录步骤 6:验证微软账号是否持有 MC,这也会刷新 XGP
Private Sub MsLoginStep6(AccessToken As String)
McLaunchLog("开始微软登录步骤 6")
'微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
Private Sub MsLoginStep5(AccessToken As String)
McLaunchLog("开始微软登录步骤 5/6")
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Dim Result As String = NetRequestMultiple("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Try
Dim ResultJson As JObject = GetJson(Result)
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
@@ -1015,13 +1001,13 @@ SystemBrowser:
Throw
End Try
End Sub
'微软登录步骤 7:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep7(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 7")
'微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep6(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 6/6")
Dim Result As String
Try
Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Result = NetRequestMultiple("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
@@ -1069,7 +1055,7 @@ SystemBrowser:
Case 3
'使用正版用户名
Try
If Not SkinName = "" Then
If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
@@ -1199,7 +1185,7 @@ SystemBrowser:
'统一通行证检测
If Setup.Get("LoginType") = McLoginType.Nide Then
'至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If
SyncLock JavaLock
@@ -1226,12 +1212,12 @@ SystemBrowser:
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101"
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) Then
JavaCode = "8u101"
If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1276,28 +1262,35 @@ SystemBrowser:
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
Dim WrapperPath As String = PathPure & "JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Try
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex As Exception
If File.Exists(WrapperPath) Then
'因为未知原因 Java Wrapper 可能变为只读文件(#4243)
Log(ex, "Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
Try
File.Delete(WrapperPath)
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex2 As Exception
Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
WrapperPath = PathPure & "JavaWrapper2.jar"
Try
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex3 As Exception
Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
End Try
End Try
Else
Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
End If
End Try
End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath
End Function
Private ExtractJavaWrapperLock As New Object
''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
If PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\")
ElseIf PathTemp.IsASCII() Then
Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
Return PathTemp.TrimEnd("\")
Else
Log("[Java] Wrapper:AppData 路径与 Temp 路径中均包含非 ASCII 字符,换用 ProgramData 目录")
Return OsDrive & "ProgramData\PCL"
End If
End Function
'主方法,合并 Jvm、Game、Replace 三部分的参数数据
Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken)))
@@ -1339,8 +1332,12 @@ SystemBrowser:
Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
'全屏
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
'由 Option 传入的额外参数
For Each Arg In CurrentLaunchOptions.ExtraArgs
Arguments += " " & Arg.Trim
Next
'进服
Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
'QuickPlay
@@ -1394,7 +1391,7 @@ SystemBrowser:
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1404,7 +1401,7 @@ SystemBrowser:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'添加 MainClass
@@ -1461,7 +1458,7 @@ NextVersion:
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1471,7 +1468,7 @@ NextVersion:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1770,7 +1767,6 @@ NextVersion:
{
""authenticationDatabase"": {
""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": {
""66666555554444433333222221111100"": {
@@ -1801,7 +1797,6 @@ NextVersion:
{
""authenticationDatabase"": {
""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": {
""66666555554444433333222221111100"": {
@@ -1877,16 +1872,12 @@ NextVersion:
End Try
'离线皮肤 Alex 警告
Try
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If
Catch ex As Exception
Log(ex, "检查离线皮肤失效失败")
End Try
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If
'离线皮肤资源包
Try
@@ -2046,18 +2037,18 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程")
AbortHint = "导出启动脚本成功!"
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
Loader.Parent.Abort()
Exit Sub '导出脚本完成
End If
Catch ex As Exception
Log(ex, "输出启动脚本失败")
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
End Try
'执行自定义命令
@@ -2128,6 +2119,8 @@ IgnoreCustomSkin:
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数
StartInfo.StandardErrorEncoding = Encoding.UTF8
StartInfo.StandardOutputEncoding = Encoding.UTF8
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
@@ -475,22 +475,27 @@ VersionSearchFinish:
''' </summary>
Public Property JsonText As String
Get
'快速检查 JSON 是否以 { 开头、} 结尾;忽略空白字符
Dim FastJsonCheck =
Function(Json As String) As Boolean
Dim TrimedJson As String = Json.Trim()
Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
End Function
If _JsonText Is Nothing Then
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json")
If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
_JsonText = ReadFile(Path & Name & ".json")
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If _JsonText.Length = 0 Then
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
Throw New Exception("版本 Json 文件为空或读取失败")
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
GetJson(_JsonText) '触发异常
Else
Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
Log("[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
Thread.Sleep(2000)
_JsonText = ReadFile(Path & Name & ".json")
If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败")
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
End If
End If
If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText)
End If
Return _JsonText
End Get
@@ -562,10 +567,10 @@ Recheck:
GoTo Recheck
End If
Catch ex As Exception
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
Log(ex, "合并版本依赖项 JSON 失败(" & If(InheritVersion, "null").ToString & ")")
End Try
Catch ex As Exception
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
Throw New Exception("初始化版本 JSON 时失败(" & If(Name, "null") & ")", ex)
End Try
Try
'处理 JumpLoader
@@ -665,7 +670,7 @@ Recheck:
Try
Dim JsonObjCheck = JsonObject
Catch ex As Exception
Log(ex, "版本 json 可用性检查失败(" & Path & ")")
Log(ex, "版本 JSON 可用性检查失败(" & Path & ")")
JsonText = ""
JsonObject = Nothing
Info = ex.Message
@@ -1029,21 +1034,21 @@ ExitDataLoad:
Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower
If Name.StartsWithF("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
Return "2015 | 作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
ElseIf Name = "1.rv-pre1" Then
Return "是时候将现代科技带入 Minecraft 了!"
Return "2016 | 是时候将现代科技带入 Minecraft 了!"
ElseIf Name = "3d shareware v1.34" Then
Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "2020 | 我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "22w13oneblockatatime" Then
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
Return "2022 | 一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
ElseIf Name = "23w13a_or_b" Then
Return "研究表明:玩家喜欢作出选择——越多越好!"
Return "2023 | 研究表明:玩家喜欢作出选择——越多越好!"
ElseIf Name = "24w14potato" Then
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
Else
Return ""
End If
@@ -1251,9 +1256,8 @@ OnLoaded:
Dim VersionList As New List(Of McVersion)
#Region "循环加载每个版本的信息"
Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories
For Each Folder As DirectoryInfo In Dirs
If Not Folder.EnumerateFiles.Any Then
For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
Continue For
End If
@@ -1523,7 +1527,7 @@ OnLoaded:
''' 要求玩家选择一个皮肤文件,并进行相关校验。
''' </summary>
Public Function McSkinSelect() As McSkinInfo
Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件")
Dim FileName As String = SelectFile("皮肤文件(*.png;*.jpg;*.webp)|*.png;*.jpg;*.webp", "选择皮肤文件")
'验证有效性
If FileName = "" Then Return New McSkinInfo With {.IsVaild = False}
@@ -1930,7 +1934,7 @@ OnLoaded:
''' <summary>
''' 获取版本缺失的支持库文件所对应的 NetTaskFile。
''' </summary>
Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile)
Public Function McLibFix(Version As McVersion) As List(Of NetFile)
If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json
Dim Result As New List(Of NetFile)
@@ -1943,91 +1947,99 @@ OnLoaded:
Catch ex As Exception
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
End Try
If CoreJarOnly Then Return Result
'是否跳过校验
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
'Library 文件
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip))
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
'统一通行证文件
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
Dim TargetFile = PathAppdata & "nide8auth.jar"
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetGetCodeByDownload({
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetGetCodeByDownload({
"https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
End If
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
If Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
End If
End If
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
Dim TargetFile = PathAppdata & "authlib-injector.jar"
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取 Authlib-Injector 下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Dim DownloadAddress As String = DownloadInfo("download_url")
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
End If
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
Dim TargetFile = PathPure & "\authlib-injector.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({
"https://authlib-injector.yushi.moe/artifact/latest.json",
"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取 Authlib-Injector 下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
If Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
Result.Add(New NetFile({
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
End If
End If
End If
'跳过校验
If ShouldIgnoreFileCheck(Version) Then
Log("[Minecraft] 用户要求尽量忽略文件检查,这可能会保留有误的文件")
Result = Result.Where(
Function(f)
If File.Exists(f.LocalPath) Then
Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, LogLevel.Debug)
Return False
Else
Return True
End If
End Function).ToList
End If
Return Result
End Function
''' <summary>
''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
''' </summary>
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile)
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Result As New List(Of NetFile)
'获取
For Each Token As McLibToken In Libs
'检查文件
Dim Checker As FileChecker
If AllowUnsameFile Then '只要文件存在则通过检查,用于放宽完整性校验的情况
Checker = New FileChecker(MinSize:=1)
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
End If
Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
'文件不符合,添加下载
Dim Urls As New List(Of String)
If Token.Url IsNot Nothing Then
'获取 Url 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then
Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Token.Url.Contains(".tsrg") Then
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings(#4425)
End If
If Token.Url.Contains("maven") Then
Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
@@ -2049,7 +2061,7 @@ OnLoaded:
'普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
End If
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next
'去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
@@ -2157,77 +2169,50 @@ OnLoaded:
''' </summary>
Public Size As Long
''' <summary>
''' 是否为 Virtual 资源文件。
''' </summary>
Public IsVirtual As Boolean
''' <summary>
''' 文件的 Hash 校验码。
''' </summary>
Public Hash As String
Public Overrides Function ToString() As String
Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath
Return GetString(Size) & " | " & LocalPath
End Function
End Structure
''' <summary>
''' 获取 Minecraft 的资源文件列表。失败会抛出异常。
''' </summary>
''' <param name="Name">版本的资源名称,如“1.13.1”。</param>
Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken)
Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken)
Dim IndexName = McAssetsGetIndexName(Version)
Try
'初始化
If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json")
McAssetsListGet = New List(Of McAssetsToken)
Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json"))
If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json")
Dim Result As New List(Of McAssetsToken)
Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json"))
'确认 Virtual 与 Map 状态
Dim IsVirtual As Boolean = False
If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then
IsVirtual = True
'刷新 resources 文件夹符号链接(#2182)
'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta")
'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then
Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug)
Try
DeleteDirectory(PathMcFolder & "resources\", True)
Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\")
Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""")
Log($"[Minecraft] 符号链接创建结果:{Result}")
If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果({Result})")
Catch ex As Exception
Log(ex, "创建资源文件夹链接失败,游戏可能会没有声音", LogLevel.Msgbox)
End Try
'读取列表
For Each File As JProperty In Json("objects").Children
Dim LocalPath As String
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then
'Remap
LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\")
ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then
'Virtual
LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\")
Else
'正常
LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString
End If
End If
'加载列表
If IsVirtual Then
For Each File As JProperty In Json("objects").Children
McAssetsListGet.Add(New McAssetsToken With {
.IsVirtual = True,
.LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"),
.SourcePath = File.Name,
.Hash = File.Value("hash").ToString,
.Size = File.Value("size").ToString
})
Next
Else
For Each File As JProperty In Json("objects").Children
McAssetsListGet.Add(New McAssetsToken With {
.IsVirtual = False,
.LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString,
.SourcePath = File.Name,
.Hash = File.Value("hash").ToString,
.Size = File.Value("size").ToString
})
Next
End If
Result.Add(New McAssetsToken With {
.LocalPath = LocalPath,
.SourcePath = File.Name,
.Hash = File.Value("hash").ToString,
.Size = File.Value("size").ToString
})
Next
Return Result
Catch ex As Exception
Log(ex, "获取资源文件列表失败:" & Name)
Log(ex, "获取资源文件列表失败:" & IndexName)
Throw
End Try
End Function
@@ -2236,12 +2221,12 @@ OnLoaded:
''' <summary>
''' 获取版本缺失的资源文件所对应的 NetTaskFile。
''' </summary>
Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
Dim Result As New List(Of NetFile)
Dim AssetsList As List(Of McAssetsToken)
Try
AssetsList = McAssetsListGet(IndexAddress)
AssetsList = McAssetsListGet(Version)
Dim Token As McAssetsToken
If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04
For i = 0 To AssetsList.Count - 1
@@ -1,6 +1,7 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 7
Public Class McMod
@@ -47,7 +48,7 @@ Public Module ModMod
Get
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
@@ -58,7 +59,7 @@ Public Module ModMod
Public Enum McModState As Integer
Fine = 0
Disabled = 1
Unavaliable = 2
Unavailable = 2
End Enum
#End Region
@@ -707,7 +708,7 @@ Finished:
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path)
For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
@@ -814,7 +815,7 @@ Finished:
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
@@ -824,6 +825,7 @@ Finished:
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
@@ -852,7 +854,7 @@ Finished:
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
If CacheContent <> "" Then
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
@@ -861,6 +863,7 @@ Finished:
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try
Cache("version") = LocalModCacheVersion
@@ -886,7 +889,7 @@ Finished:
End If
ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
@@ -901,8 +904,8 @@ Finished:
'排序
ModList = Sort(ModList,
Function(Left As McMod, Right As McMod) As Boolean
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
Return Left.State = McMod.McModState.Unavaliable
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavailable
Else
Return Not Right.FileName.CompareTo(Left.FileName)
End If
@@ -924,7 +927,6 @@ Finished:
End Try
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 5
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -944,7 +946,7 @@ Finished:
'McVersions = McVersions.Distinct().ToList()
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
@@ -952,7 +954,7 @@ Finished:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -973,19 +975,18 @@ Finished:
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
Dim ModrinthProject = CType(GetJson(DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods
@@ -1005,9 +1006,9 @@ Finished:
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
@@ -1022,8 +1023,8 @@ Finished:
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Exit Sub
@@ -1045,17 +1046,16 @@ Finished:
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
@@ -1066,9 +1066,9 @@ Finished:
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
@@ -1087,7 +1087,7 @@ Finished:
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
@@ -1113,9 +1113,9 @@ Finished:
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
@@ -1129,11 +1129,13 @@ Finished:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBars())
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
@@ -1275,4 +1277,4 @@ Finished:
End Function
#End If
End Module
End Module
@@ -12,9 +12,10 @@ Public Module ModModpack
RunInThread(Sub() ModpackInstall(File))
End Sub
''' <summary>
''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。
''' 安装一个给定的整合包文件,返回启动的安装加载器,如果未成功启动则返回 Nothing。
''' 必须在工作线程执行。
''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
@@ -25,6 +26,7 @@ Public Module ModModpack
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("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +37,6 @@ Public Module ModModpack
End If
End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
@@ -45,6 +46,7 @@ Public Module ModModpack
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
@@ -55,54 +57,52 @@ Public Module ModModpack
End If
End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next
Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
End If
End Try
'执行对应的安装方法
Select Case PackType
Case 0
Log("[ModPack] 整合包种类:CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1
Log("[ModPack] 整合包种类:HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2
Log("[ModPack] 整合包种类:MMC")
InstallPackMMC(File, Archive, ArchiveBaseFolder)
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类:MCBBS")
InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Case 4
Log("[ModPack] 整合包种类:Modrinth")
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9
Log("[ModPack] 整合包种类:压缩包")
Archive.Dispose()
Archive = Nothing
InstallPackCompress(File, ArchiveBaseFolder)
Return InstallPackCompress(File, ArchiveBaseFolder)
Case Else
If ShowHint Then
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
Else
Log("[ModPack] 未能识别该整合包的种类,无法安装!")
End If
Return False
Return Nothing
End Select
Return True
Catch ex As Exception
Log(ex, "准备安装整合包失败", LogLevel.Feedback)
Return False
Return Nothing
Finally
If Archive IsNot Nothing Then Archive.Dispose()
End Try
@@ -159,7 +159,8 @@ Retry:
#Region "不同类型整合包的安装方法"
'CurseForge
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
@@ -167,18 +168,18 @@ Retry:
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
Return Nothing
End Try
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'获取 Mod API 版本信息
@@ -191,11 +192,11 @@ Retry:
'Forge 指定
If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
Exit Sub
Return Nothing
End If
Try
Log("[ModPack] 整合包 Forge 版本:" & Id)
ForgeVersion = Id.Split("-")(1)
ForgeVersion = Id.Replace("forge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
@@ -204,7 +205,7 @@ Retry:
'NeoForge 指定
Try
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
NeoForgeVersion = Id.Split("-")(1)
NeoForgeVersion = Id.Replace("neoforge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
@@ -213,7 +214,7 @@ Retry:
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Split("-")(1)
FabricVersion = Id.Replace("fabric-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
@@ -259,7 +260,7 @@ Retry:
'获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -319,7 +320,7 @@ Retry:
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -341,8 +342,8 @@ Retry:
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
@@ -350,14 +351,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -365,11 +362,11 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'Modrinth
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
@@ -378,7 +375,7 @@ Retry:
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
@@ -400,42 +397,42 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
Exit Sub
Return Nothing
End Select
Next
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If
Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If
Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {})
@@ -452,8 +449,10 @@ Retry:
End Select
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next
If FileList.Any Then
@@ -470,7 +469,7 @@ Retry:
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -492,8 +491,8 @@ Retry:
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
@@ -501,14 +500,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -516,25 +511,26 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub
End Function
'HMCL
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(Json("name"), "")
Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
@@ -555,7 +551,7 @@ Retry:
'构造加载器
If Json("gameVersion") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -563,7 +559,7 @@ Retry:
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -591,14 +587,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -607,10 +599,11 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'MMC
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
@@ -618,14 +611,14 @@ Retry:
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
@@ -685,7 +678,7 @@ Retry:
'构造版本安装请求
If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
@@ -702,12 +695,12 @@ Retry:
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
End Select
Next
'构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -720,14 +713,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -735,10 +724,12 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'MCBBS
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
@@ -746,14 +737,17 @@ Retry:
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
@@ -774,7 +768,7 @@ Retry:
'构造加载器
If Json("addons") Is Nothing Then
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons")
@@ -782,11 +776,11 @@ Retry:
Next
If Not Addons.ContainsKey("game") Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -798,7 +792,7 @@ Retry:
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -811,14 +805,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -826,28 +816,36 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
'普通压缩包
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
'获取解压路径
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub
If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return Nothing
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Return Nothing
'要求显示名称
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
'解压
Hint("正在解压压缩包……")
UnpackFiles(TargetFolder, FileAddress, Nothing)
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder, NewName, False)
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish)
End Sub
Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
New LoaderTask(Of String, Integer)("安装压缩包",
Sub()
UnpackFiles(TargetFolder, FileAddress, Nothing)
PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
End Sub)
})
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
#End Region
@@ -88,26 +88,27 @@
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
'初始化时钟
RunInNewThread(Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
TimerWindow()
TimerLog()
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
Next
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
RunInNewThread(
Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
TimerWindow()
TimerLog()
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
Next
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
End Sub
'状态
@@ -349,22 +350,21 @@
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……")
FeedbackInfo()
RunInNewThread(Sub()
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(PID)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json",
Path & "PCL\Log1.txt",
Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try
End Sub, "Crash Analyzer")
RunInNewThread(
Sub()
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(PID)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try
End Sub, "Crash Analyzer")
End Sub
'强制关闭
@@ -1,6 +1,7 @@
<Grid x:Class="MyCompItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
x:Name="PanBack" Height="64"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
@@ -23,7 +24,7 @@
<Border.Clip>
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
@@ -4,90 +4,14 @@
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
Return PathLogo.Source
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 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, "加载资源工程图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化资源工程图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[Comp] 已清理损坏的资源工程图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的资源工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载资源工程图标失败(" & value & ")")
End Try
PathLogo.Source = value
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Public Property Title As String
@@ -24,30 +24,27 @@
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<local:MyIconTextButton Grid.Column="2" Text="更新" />
</Grid>-->
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Grid.Column="2"
Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</Grid>
<!-- 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">
@@ -55,6 +52,6 @@
</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}"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray4}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid>
@@ -6,90 +6,14 @@ Public Class MyLocalModItem
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
Return PathLogo.Source
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
End Try
PathLogo.Source = value
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Private _Title As String
@@ -104,7 +28,7 @@ RetryStart:
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavaliable
Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
@@ -117,12 +41,12 @@ RetryStart:
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
Return If(LabSubtitle?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
If LabSubtitle.Text = value Then Exit Property
LabSubtitle.Text = value
LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
@@ -145,9 +69,9 @@ RetryStart:
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
@@ -379,7 +303,7 @@ RetryStart:
#End Region
Public Sub Refresh()
Public Sub Refresh() Handles Me.Loaded
RunInUi(
Sub()
'更新
@@ -406,30 +330,45 @@ RetryStart:
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
'标题与描述
Dim DescFileName As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable
NewDescription = GetFileNameFromPath(Entry.Path)
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavailable
DescFileName = GetFileNameFromPath(Entry.Path)
End Select
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.Name
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名,详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
'描述
NewDescription = DescFileName
End If
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
@@ -438,6 +377,11 @@ RetryStart:
NewDescription += ": " & "存在错误,无法获取信息"
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
@@ -458,7 +402,7 @@ RetryStart:
'<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" />
' Source="/Images/Icons/Unavailable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
@@ -535,4 +479,17 @@ RetryStart:
FrmVersionMod.UpdateMods({Entry})
End Sub
'自适应(#4465)
Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
'压缩 Subtitle
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
ElseIf Not ColumnExtend.Width.IsStar AndAlso Not LabSubtitle.IsTextTrimmed Then
'向右展开 Subtitle
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
End If
End Sub
End Class
+34 -21
View File
@@ -21,26 +21,28 @@
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏"
If Data(0) = "\current" Then
@@ -90,7 +92,18 @@
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Try
Select Case Data.Length
Case 1
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case 2
PageOtherTest.StartCustomDownload(Data(0), Data(1))
Case Else
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Data(0), "未知")
End Try
Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
+17 -10
View File
@@ -69,14 +69,14 @@ Public Module ModMain
Dim Percent As Double = 0.3
Select Case CurrentHint.Type
Case HintType.Info
TargetColor0 = New MyColor(37, 155, 252)
TargetColor1 = New MyColor(10, 142, 252)
TargetColor0 = New MyColor(215, 37, 155, 252)
TargetColor1 = New MyColor(215, 10, 142, 252)
Case HintType.Finish
TargetColor0 = New MyColor(33, 177, 33)
TargetColor1 = New MyColor(29, 160, 29)
TargetColor0 = New MyColor(215, 33, 177, 33)
TargetColor1 = New MyColor(215, 29, 160, 29)
Case Else 'HintType.Critical
TargetColor0 = New MyColor(255, 53, 11)
TargetColor1 = New MyColor(255, 43, 0)
TargetColor0 = New MyColor(215, 255, 53, 11)
TargetColor1 = New MyColor(215, 255, 43, 0)
End Select
If Not IsNothing(DoubleStack) Then
'有重复提示,且该提示的进入动画已播放
@@ -176,15 +176,17 @@ EndHint:
Public Title As String
Public Text As String
''' <summary>
''' 输入框模式:文本框的文本;选择模式:需要放进去的 List(Of MyListItem)。
''' 输入模式:文本框的文本。
''' 选择模式:需要放进去的 List(Of MyListItem)。
''' 登录模式:登录步骤 1 中返回的 JSON。
''' </summary>
Public Content As Object
''' <summary>
''' 仅输入框模式:输入验证规则。
''' 输入模式:输入验证规则。
''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate)
''' <summary>
''' 仅输入框模式:提示文本。
''' 输入模式:提示文本。
''' </summary>
Public HintText As String = ""
''' <summary>
@@ -214,7 +216,9 @@ EndHint:
''' </summary>
Public IsExited As Boolean = False
''' <summary>
''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮,则为 Nothing。
''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
''' 选择模式:点击的按钮编号,从 1 开始。
''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
''' </summary>
Public Result As Object
End Class
@@ -222,6 +226,7 @@ EndHint:
Text
[Select]
Input
Login
End Enum
''' <summary>
@@ -352,6 +357,8 @@ EndHint:
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Login
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
End Select
WaitingMyMsgBox.RemoveAt(0)
Else
+1 -1
View File
@@ -280,7 +280,7 @@
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Thread.Sleep(1000000000)
+19 -13
View File
@@ -8,8 +8,12 @@ Friend Module ModSecret
#Region "杂项"
'在开源内容的注册表键与普通内容的注册表键隔离
'在开源版的注册表与常规版的注册表隔离,以防数据冲突
Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
Public Const OAuthClientId As String = ""
'CurseForge API Key
Public Const CurseForgeAPIKey As String = ""
Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级
@@ -41,8 +45,9 @@ Friend Module ModSecret
Environment.[Exit](Result.Cancel)
End If
'开源版本提示
MyMsgBox($"该版本中不包含以下特性:
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中)
MyMsgBox($"该版本中无法使用以下特性:
- CurseForge API 调用:需要你自行申请 API Key,然后添加到 ModSecret.vb 的开头
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
@@ -89,35 +94,36 @@ Friend Module ModSecret
#Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String)
'只处理以 {CDN} 结尾的链接
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function
''' <summary>
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Client.Headers("User-Agent") = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
Client.Headers("x-api-key") = CurseForgeAPIKey
End Sub
''' <summary>
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Request.UserAgent = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Request.UserAgent = "PCL2/" & VersionStandardCode
End If
Request.Referer = "http://" & VersionCode & ".pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
Request.Headers("x-api-key") = CurseForgeAPIKey
End Sub
#End Region
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.0.0")>
<Assembly: AssemblyFileVersion("2.8.0.0")>
<Assembly: AssemblyVersion("2.8.9.0")>
<Assembly: AssemblyFileVersion("2.8.9.0")>
<Assembly: NeutralResourcesLanguage("")>
+20
View File
@@ -100,6 +100,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Imazen_WebP() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -120,6 +130,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property libwebp64() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -130,12 +130,18 @@
<data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Imazen_WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
@@ -1,4 +1,5 @@
Imports System.IO.Compression
Imports System.Net.Http
Public Module ModDownloadLib
@@ -28,15 +29,12 @@ Public Module ModDownloadLib
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return LoaderTaskbar(i)
Hint("该版本正在下载中!", HintType.Critical)
Return LoaderTaskbar(i)
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader
Hint("该版本正在下载中!", HintType.Critical)
Return OngoingLoader
Next
'已有版本检查
If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then
@@ -62,50 +60,6 @@ Public Module ModDownloadLib
Return Nothing
End Try
End Function
''' <summary>
''' 保存某个 Minecraft 版本的核心文件(仅 Json 与核心 Jar)。
''' </summary>
''' <param name="Id">所下载的 Minecraft 的版本名。</param>
''' <param name="JsonUrl">Json 文件的 Mojang 官方地址。</param>
Public Sub McDownloadClientCore(Id As String, JsonUrl As String, Behaviour As NetPreDownloadBehaviour)
Try
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
Dim Loaders As New List(Of LoaderBase)
'下载版本 Json 文件
Loaders.Add(New LoaderDownload("下载版本 json 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 jar 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 获取下载某个 Minecraft 版本的加载器列表。
@@ -161,7 +115,7 @@ Public Module ModDownloadLib
LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
Task.Output = McAssetsFixList(New McVersion(VersionFolder), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21})
@@ -213,7 +167,12 @@ Public Module ModDownloadLib
ToolTipService.SetVerticalOffset(BtnInfo, 30)
ToolTipService.SetHorizontalOffset(BtnInfo, 2)
AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
sender.Buttons = {BtnInfo}
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnServer, BtnInfo}
End Sub
Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
@@ -226,7 +185,12 @@ Public Module ModDownloadLib
ToolTipService.SetVerticalOffset(BtnInfo, 30)
ToolTipService.SetHorizontalOffset(BtnInfo, 2)
AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
sender.Buttons = {BtnSave, BtnInfo}
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnSave, BtnInfo, BtnServer}
End Sub
Private Sub McDownloadMenuLog(sender As Object, e As RoutedEventArgs)
Dim Version As JToken
@@ -239,6 +203,75 @@ Public Module ModDownloadLib
End If
McUpdateLogShow(Version)
End Sub
Private Sub McDownloadMenuSaveServer(sender As Object, e As RoutedEventArgs)
Dim Version As MyListItem
If TypeOf sender Is MyListItem Then
Version = sender
ElseIf TypeOf sender.Parent Is MyListItem Then
Version = sender.Parent
Else
Version = sender.Parent.Parent
End If
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 服务端下载" Then Continue For
Hint("该服务端正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'构建服务端
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'分析服务端 JAR 文件下载地址
Dim McVersion As New McVersion(VersionFolder)
If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then Throw New Exception($"{Id} 版本没有提供服务端文件")
Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1"))
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
'添加启动脚本
Dim Bat As String =
$"@echo off
title {Id} 原版服务端
echo 如果服务端立即停止,请右键编辑该脚本,将下一行开头的 java 替换为适合该 Minecraft 版本的完整 java.exe 的路径。
echo 你可以在 PCL 的 [设置 → 启动选项] 中查看已安装的 java,所需的 java.exe 一般在其中的 bin 文件夹下。
echo ------------------------------
echo 如果提示 ""You need to agree to the EULA in order to run the server"",请打开 eula.txt,按说明阅读并同意 Minecraft EULA 后,将该文件最后一行中的 eula=false 改为 eula=true。
echo ------------------------------
""java"" -server -XX:+UseG1GC -Xmx4096M -Xms1024M -XX:+UseCompressedOops -jar {Id}-server.jar nogui
echo ----------------------
echo 服务端已停止。
pause"
WriteFile(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
File.Delete(VersionFolder & Id & ".json")
End Sub
) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 服务端下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", LogLevel.Feedback)
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
Dim Version As MyListItem
If TypeOf sender Is MyListItem Then
@@ -248,7 +281,41 @@ Public Module ModDownloadLib
Else
Version = sender.Parent.Parent
End If
McDownloadClientCore(Version.Title, Version.Tag("url").ToString, NetPreDownloadBehaviour.HintWhileExists)
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址",
Sub(Task) Task.Output = New List(Of NetFile) From {DlClientJarGet(New McVersion(VersionFolder), False)}
) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 显示某 Minecraft 版本的更新日志。
@@ -316,46 +383,6 @@ Public Module ModDownloadLib
#Region "OptiFine 下载"
Public Sub McDownloadOptiFine(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.NameVersion
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
Dim IsNewVersion As Boolean = Val(DownloadInfo.Inherit.Split(".")(1)) >= 14
Dim Target As String = If(IsNewVersion,
PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(),
PathMcFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", ""))
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'已有版本检查
If File.Exists(VersionFolder & Id & ".json") Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & Id & ".jar")
File.Delete(VersionFolder & Id & ".json")
Else
Exit Sub
End If
End If
'启动
Dim Loader As New LoaderCombo(Of String)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineLoader(DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback)
End Try
End Sub
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.NameVersion
@@ -363,14 +390,11 @@ Public Module ModDownloadLib
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(DownloadInfo)
@@ -408,7 +432,7 @@ Public Module ModDownloadLib
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer"
End If
@@ -793,14 +817,11 @@ Retry:
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
'已有版本检查
If File.Exists(VersionFolder & VersionName & ".json") Then
@@ -830,14 +851,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
@@ -1007,73 +1025,6 @@ Retry:
#Region "Forgelike 下载"
Public Sub McDownloadForgelike(Info As DlForgelikeEntry)
'老版本提示
If Not Info.IsNeoForge Then
Dim ForgeInfo As DlForgeVersionEntry = Info
If ForgeInfo.Category = "client" Then
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
McDownloadForgelikeSave(Info)
End If
Exit Sub
End If
If ForgeInfo.Category = "universal" OrElse ForgeInfo.Inherit.StartsWithF("1.5") Then
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
McDownloadForgelikeSave(Info)
End If
Exit Sub
End If
End If
'初始化参数
Dim McVersionName As String = $"{Info.Inherit}-{Info.LoaderName.ToLower}-{Info.VersionName}"
Dim TempFolder As String = $"{PathTemp}Cache\Code\{Info.LoaderName}Install-{Info.Version}_{GetUuid()}.{Info.FileExtension}"
Dim McVersionFolder As String = $"{PathMcFolder}versions\{McVersionName}\"
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = Info.LoaderName & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'已有版本检查
If File.Exists(McVersionFolder & McVersionName & ".json") Then
If MyMsgBox("版本 " & McVersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(McVersionFolder & McVersionName & ".jar")
File.Delete(McVersionFolder & McVersionName & ".json")
Else
Exit Sub
End If
End If
'启动
Dim Loader As New LoaderCombo(Of String)(Info.LoaderName & " 下载",
McDownloadForgelikeLoader(Info.IsNeoForge, If(Info.IsNeoForge, CType(Info, DlNeoForgeListEntry).ApiName, Info.VersionName), Info.Inherit, Info)) With
{.OnStateChanged = AddressOf McInstallState}
Loader.Start(McVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 下载失败", LogLevel.Feedback)
Finally
'删除安装包
Try
If File.Exists(TempFolder) Then File.Delete(TempFolder)
Catch
End Try
End Try
End Sub
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try
Dim Target As String = SelectAs("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
@@ -1082,14 +1033,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = DisplayName & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
'获取下载地址
Dim Files As New List(Of NetFile)
@@ -1151,7 +1099,7 @@ Retry:
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If
@@ -1242,79 +1190,74 @@ Retry:
End SyncLock
End Sub
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
If Content.StartsWithF(" Data") OrElse Content.StartsWithF(" Slim") Then
If ModeDebug Then Log("[Installer] " & Content)
ElseIf Content.StartsWithF(" Reading patch ") Then
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress = 0.86
Else
Select Case Content
Case "Extracting json"
Log("[Installer] " & Content)
Task.Progress = 0.07
Case "Downloading libraries"
Log("[Installer] " & Content)
Task.Progress = 0.08
Case " File exists: Checksum validated."
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress += 0.003
Case "Building Processors"
Task.Progress = 0.38
Case "Task: DOWNLOAD_MOJMAPS" 'B
Task.Progress = 0.4
Case "Task: MERGE_MAPPING" 'B
Task.Progress = 0.6
Case "Splitting: "
Task.Progress = 0.62
Case "Parameter Annotations" 'B
Task.Progress = 0.66
Case "Processing Complete" 'B
Task.Progress = 0.7
Case "Remapping final jar" 'A
Task.Progress = 0.72
Case "Remapping jar... 50%" 'A
Task.Progress = 0.76
Case "Remapping jar... 100%" 'A
Task.Progress = 0.81
Case "Injecting profile"
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Exit Sub
End Select
Log("[Installer] " & Content)
End If
Select Case Content
Case "Extracting json"
Log("[Installer] " & Content)
Task.Progress = 0.07
Case "Downloading libraries"
Log("[Installer] " & Content)
Task.Progress = 0.08
Case " File exists: Checksum validated."
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress += 0.003
Case "Building Processors"
Task.Progress = 0.18
Case "Task: DOWNLOAD_MOJMAPS" 'B
Task.Progress = 0.2
Case "Task: MERGE_MAPPING" 'B
Task.Progress = 0.3
Case "Splitting: "
Task.Progress = 0.35
Case "Parameter Annotations" 'B
Task.Progress = 0.4
Case "Processing Complete" 'B
Task.Progress = 0.5
Case "log: null" 'new
Task.Progress = 0.5
Case "Sorting" 'new
Task.Progress = 0.65
Case "Remapping final jar" 'A
Task.Progress = 0.72
Case "Remapping jar... 50%" 'A
Task.Progress = 0.76
Case "Remapping jar... 100%" 'A
Task.Progress = 0.81
Case "Injecting profile"
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Exit Sub
End Select
Log("[Installer] " & Content)
End Sub
''' <summary>
''' 获取下载某个 Forgelike 版本的加载器列表。
''' </summary>
Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, Version As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, LoaderVersion As String, TargetVersion As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing) As List(Of LoaderBase)
'参数初始化
McFolder = If(McFolder, PathMcFolder)
If IsNeoForge AndAlso Info Is Nothing Then
'需要传入 API Name,但整合包版本可能不以 1.20.1- 开头,所以需要进行特别处理
If Inherit = "1.20.1" AndAlso Not Version.StartsWithF("1.20.1-") Then
Info = New DlNeoForgeListEntry("1.20.1-" & Version)
If Inherit = "1.20.1" AndAlso Not LoaderVersion.StartsWithF("1.20.1-") Then
Info = New DlNeoForgeListEntry("1.20.1-" & LoaderVersion)
Else
Info = New DlNeoForgeListEntry(Version)
Info = New DlNeoForgeListEntry(LoaderVersion)
End If
End If
If Not IsNeoForge AndAlso Version.StartsWithF("1.") AndAlso Version.Contains("-") Then
If Not IsNeoForge AndAlso LoaderVersion.StartsWithF("1.") AndAlso LoaderVersion.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Before("-")
Version = Version.After("-")
Inherit = LoaderVersion.Before("-")
LoaderVersion = LoaderVersion.After("-")
End If
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{Version}_{RandomInteger(0, 100000)}"
Dim VersionName As String = If(IsNeoForge, "neoforge-" & Version.Replace("1.20.1-", ""), "forge-" & Version)
Dim VersionFolder As String = $"{McFolder}versions\{VersionName}\"
Log($"[Download] Forgelike 安装目标版本文件夹:{VersionFolder}")
Dim DisplayName As String = $"{LoaderName} {Inherit} - {Version}"
Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{LoaderVersion}_{RandomInteger(0, 100000)}"
Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\"
Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}"
Dim Loaders As New List(Of LoaderBase)
Dim LibVersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" '作为 Lib 文件目标的版本文件夹
Dim LibVersionFolder As String = $"{PathMcFolder}versions\{TargetVersion}\" '作为 Lib 文件目标的版本文件夹
'获取 Forge 下载信息
If Info Is Nothing Then
@@ -1326,12 +1269,12 @@ Retry:
Task.Progress = 0.8
'查找对应版本
For Each ForgeVersion In ForgeLoader.Output
If VersionSortInteger(ForgeVersion.Version.ToString, Version) = 0 Then
If VersionSortInteger(ForgeVersion.Version.ToString, LoaderVersion) = 0 Then
Info = ForgeVersion
Exit Sub
End If
Next
Throw New Exception($"未能找到 {LoaderName} " & Inherit & "-" & Version & " 的详细信息!")
Throw New Exception($"未能找到 {LoaderName} " & Inherit & "-" & LoaderVersion & " 的详细信息!")
End Sub) With {.ProgressWeight = 3})
End If
'下载 Forgelike 主文件
@@ -1354,9 +1297,11 @@ Retry:
Else
'Forge
Dim Forge As DlForgeVersionEntry = Info
Dim FileName As String =
$"{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}/forge-{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}"
Files.Add(New NetFile({
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}"
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{FileName}"
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash)))
End If
Task.Output = Files
@@ -1364,8 +1309,8 @@ Retry:
Loaders.Add(New LoaderDownload($"下载 {LoaderName} 主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
'安装(仅在新版安装时需要原版 Jar)
If IsNeoForge OrElse Version.Before(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & Version)
If IsNeoForge OrElse LoaderVersion.Before(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
@@ -1388,15 +1333,17 @@ Retry:
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
Log("[Download] 需要下载 Mappings:" & Address)
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If
Task.Progress = 0.8
'去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{Version}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{Version}-client.jar") Then
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
@@ -1498,10 +1445,15 @@ Retry:
'如果没有新增文件夹,那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹,那么拷贝 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
WriteFile(VersionFolder & VersionName & ".json", ReadFile(JsonFile.FullName))
WriteFile(VersionFolder & TargetVersion & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{TargetVersion}.json")
ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
Else
'没有新增文件夹
Log("[Download] 未找到新增的版本文件夹")
End If
'新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally
@@ -1515,7 +1467,7 @@ Retry:
End Try
End Sub) With {.ProgressWeight = 10})
Else
Log("[Download] 检测为非新版 Forge:" & Version)
Log("[Download] 检测为非新版 Forge:" & LoaderVersion)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing
@@ -1533,8 +1485,8 @@ Retry:
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = VersionName
WriteFile(VersionFolder & VersionName & ".json", JsonVersion.ToString)
JsonVersion("id") = TargetVersion
WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString)
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
@@ -1550,12 +1502,10 @@ Retry:
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9
'建立 Json 文件
Json("versionInfo")("id") = VersionName
Json("versionInfo")("id") = TargetVersion
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & VersionName & ".json", Json("versionInfo").ToString)
WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString)
End If
'新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex)
Finally
@@ -1569,11 +1519,6 @@ Retry:
End Try
End Try
End Sub) With {.ProgressWeight = 1})
If FixLibrary Then
If IsCustomFolder Then Throw New Exception("若需要补全支持库,就不能自定义 MC 文件夹")
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload($"下载 {LoaderName} 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 11})
End If
End If
Return Loaders
@@ -1838,14 +1783,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "Fabric " & Version & " 安装器下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
@@ -1881,26 +1823,24 @@ Retry:
'下载 Json
MinecraftName = MinecraftName.Replace("∞", "infinite") '放在 ID 后面避免影响版本文件夹名称
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If FixLibrary Then
McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName)
End If
Task.Progress = 0.5
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json"
}, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))}
'新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
End Sub) With {.ProgressWeight = 0.5})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If FixLibrary Then
McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName)
End If
Task.Progress = 0.5
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json"
}, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))}
End Sub) With {.ProgressWeight = 0.5})
Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5})
'下载支持库
If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8})
End If
@@ -2138,7 +2078,7 @@ Retry:
If Request.OptiFineEntry IsNot Nothing Then OptiFineFolder = TempMcFolder & "versions\" & Request.OptiFineEntry.NameVersion
Dim ForgeFolder As String = Nothing
If Request.ForgeEntry IsNot Nothing Then Request.ForgeVersion = If(Request.ForgeVersion, Request.ForgeEntry.VersionName)
If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-forge-" & Request.ForgeVersion
If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\forge-" & Request.ForgeVersion
Dim NeoForgeFolder As String = Nothing
If Request.NeoForgeEntry IsNot Nothing Then Request.NeoForgeVersion = If(Request.NeoForgeVersion, Request.NeoForgeEntry.VersionName)
If Request.NeoForgeVersion IsNot Nothing Then NeoForgeFolder = TempMcFolder & "versions\neoforge-" & Request.NeoForgeVersion
@@ -2147,12 +2087,16 @@ Retry:
Dim LiteLoaderFolder As String = Nothing
If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader"
'OptiFine 是否作为 Mod 进行下载
Dim OptiFineAsMod As Boolean =
(Request.OptiFineEntry IsNot Nothing OrElse Request.OptiFineVersion IsNot Nothing) AndAlso Request.FabricVersion IsNot Nothing
'判断 OptiFine 是否作为 Mod 进行下载
Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0)
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine
(Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric...
(Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15(#4134)
Dim ModsFolder As String = New McVersion(OutputFolder).GetPathIndie(True) & "mods\"
If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载")
OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\"
OptiFineFolder = ModsFolder
End If
'记录日志
@@ -2174,11 +2118,11 @@ Retry:
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
@@ -2193,11 +2137,11 @@ Retry:
End If
'Forge
If Request.ForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing})
End If
'NeoForge
If Request.NeoForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 25, .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If
'LiteLoader
If Request.LiteLoaderEntry IsNot Nothing Then
@@ -2213,7 +2157,12 @@ Retry:
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", ModsFolder)
'新建 mods 文件夹
If Request.ForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
Directory.CreateDirectory(ModsFolder)
Log("[Download] 自动创建 mods 文件夹:" & ModsFolder)
End If
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Not DontFixLibraries AndAlso
@@ -43,6 +43,12 @@
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -56,7 +62,7 @@
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next
'清空当前
PanMain.Children.Clear()
@@ -167,14 +167,14 @@
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
Sub()
If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
@@ -55,10 +55,6 @@
Card.StackInstall()
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadForgelike(sender.Tag)
End Sub
'介绍栏
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://files.minecraftforge.net")
@@ -618,6 +618,12 @@
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -724,6 +730,7 @@
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0
Else 'XXXX
@@ -61,7 +61,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
@@ -33,6 +33,7 @@
<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.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
@@ -13,12 +13,18 @@
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize)
If FrmDownloadMod IsNot Nothing Then
Dim ModLoader As CompModLoaderType = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
Dim GameVersion As String = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
If GameVersion IsNot Nothing AndAlso GameVersion.Contains(".") AndAlso Val(GameVersion.Split(".")(1)) < 14 AndAlso '1.14-
ModLoader = CompModLoaderType.Forge Then '选择了 Forge
ModLoader = CompModLoaderType.Any '此时,视作没有筛选 Mod Loader(因为部分老 Mod 没有设置自己支持的加载器)
End If
With Request
.SearchText = FrmDownloadMod.TextSearchName.Text
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
.GameVersion = GameVersion
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
.ModLoader = ModLoader
.Source = CType(Val(FrmDownloadMod.ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With
End If
@@ -8,7 +8,7 @@
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.19+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.20.1+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组,它也兼容一些 Forge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
@@ -32,6 +32,7 @@
<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.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
@@ -60,7 +61,7 @@
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
@@ -1,28 +0,0 @@
<Window x:Class="FormLoginOAuth"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d"
Height="720" Width="580" MinHeight="720" MinWidth="580" ResizeMode="CanResize" WindowStartupLocation="CenterScreen" Title="Microsoft 账户登录">
<Grid>
<Grid.Background>
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">
<GradientStop Color="White" Offset="0"/>
<GradientStop Color="{DynamicResource ColorObject8}" Offset="1"/>
</LinearGradientBrush>
</Grid.Background>
<StackPanel x:Name="PanLoading" Orientation="Vertical" VerticalAlignment="Center" HorizontalAlignment="Center">
<local:MyLoading x:Name="Loading" Text="正在加载登录页面" HorizontalAlignment="Center" />
<TextBlock Text="如果网络环境不佳,加载可能非常缓慢甚至一直加载不出来" Margin="0,25,0,0"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
<TextBlock Text="此时请尝试使用 VPN 或加速器,然后重试"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
</StackPanel>
<WebBrowser x:Name="Browser1" Visibility="Collapsed" Tag="1" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser2" Visibility="Collapsed" Tag="2" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser3" Visibility="Collapsed" Tag="3" Margin="0,0,0,25" />
<local:MyTextButton Text="如果遇到问题,可以点击这里使用系统浏览器登录" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="0,0,0,5" x:Name="HintSwitch" />
</Grid>
</Window>
@@ -1,100 +0,0 @@
Imports System.Windows.Navigation
Public Class FormLoginOAuth
Public Event OnLoginSuccess(code As String)
Public Event OnLoginCanceled(IsSwitch As Boolean)
'跳转事件
Private IsLoginSuccessed As Boolean = False
Private IsSwitch As Boolean = False
Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating
Dim Url As String = e.Uri.AbsoluteUri
If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向:" & Url)
If Url.Contains("code=") Then
Dim Code As String = RegexSeek(Url, "(?<=code\=)[^&]+")
Log("[Login] 抓取到 OAuth 返回码:" & Code)
IsLoginSuccessed = True
RaiseEvent OnLoginSuccess(Code)
ElseIf Url.Contains("github.") Then
Hint("PCL 不支持使用 GitHub 登录微软账号!", HintType.Critical)
Close()
End If
End Sub
'已导航事件
Private IsFirstLoaded As Boolean = False
Private IsFirstLoadedLock As New Object
Private Sub Browser_Navigated(sender As WebBrowser, e As NavigationEventArgs) Handles Browser1.Navigated, Browser2.Navigated, Browser3.Navigated
SyncLock IsFirstLoadedLock
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
End SyncLock
RunInThread(Sub()
Thread.Sleep(1000)
RunInUi(Sub()
sender.Visibility = Visibility.Visible
PanLoading.Visibility = Visibility.Collapsed
Log("[Login] 已将登录窗口切换至浏览器")
End Sub)
End Sub)
End Sub
'窗体的进出事件
Public Shared LoginUrl1 As String = "https://login.microsoftonline.com/consumers/oauth2/v2.0/authorize?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf"
Public Shared LoginUrl2 As String = "https://login.live.com/oauth20_authorize.srf?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf"
Private Sub FrmLoginOAuth_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Browser1.Navigate(LoginUrl1)
RunInThread(Sub()
'估计是由于时间戳原因,同时导航会导致误报密码失败
Thread.Sleep(2500)
RunInUi(Sub()
Try '防止在 Dispose 之后调用
If Not IsFirstLoaded Then Browser2.Navigate(LoginUrl1)
Catch
End Try
End Sub)
Thread.Sleep(2500)
RunInUi(Sub()
Try
If Not IsFirstLoaded Then Browser3.Navigate(LoginUrl2)
Catch
End Try
End Sub)
End Sub)
End Sub
Private Sub FormLoginOAuth_Closed() Handles Me.Closed
RunInThread(Sub()
Thread.Sleep(1000) '释放会卡一下,所以稍等一下……
RunInUiWait(Sub()
Try
Browser1.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 1 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser2.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 2 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser3.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 3 失败")
End Try
End Sub)
End Sub)
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch)
FrmMain.Focus()
End Sub
Private Sub HintSwitch_Click() Handles HintSwitch.Click
IsSwitch = True
Close()
End Sub
End Class
@@ -0,0 +1,40 @@
<Grid x:Class="MyMsgLogin"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
RenderTransformOrigin="0,0.5" UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="400" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="25">
<Grid.RenderTransform>
<TransformGroup>
<RotateTransform x:Name="TransformRotate" Angle="-4" />
<TranslateTransform x:Name="TransformPos" X="0" Y="40" />
</TransformGroup>
</Grid.RenderTransform>
<Border Name="PanBorder" CornerRadius="7" Background="#FBFBFB">
<Border.Effect>
<DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="20" ShadowDepth="4" RenderingBias="Performance" Opacity="0.8" x:Name="EffectShadow" />
</Border.Effect>
<Grid Name="PanMain" VerticalAlignment="Top" Margin="22,22,22,23">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="2" />
<RowDefinition Height="13" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
<StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="重新打开网页" x:Name="Btn1" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="打开网页" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="复制代码" x:Name="Btn2" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="复制文本" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="取消" x:Name="Btn3" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
</Border>
</Grid>
@@ -0,0 +1,145 @@
Public Class MyMsgLogin
Private Data As JObject
Private UserCode As String '需要用户在网页上输入的设备代码
Private DeviceCode As String '用于轮询的设备代码
Private Website As String '验证网页的网址
#Region "弹窗"
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Public Sub New(Converter As MyMsgBoxConverter)
Try
InitializeComponent()
Btn1.Name = Btn1.Name & GetUuid()
Btn2.Name = Btn2.Name & GetUuid()
Btn3.Name = Btn3.Name & GetUuid()
MyConverter = Converter
ShapeLine.StrokeThickness = GetWPFSize(1)
Data = Converter.Content
Init()
Catch ex As Exception
Log(ex, "登录弹窗初始化失败", LogLevel.Hint)
End Try
End Sub
Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
Try
'动画
Opacity = 0
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, If(MyConverter.IsWarn, New MyColor(140, 80, 0, 0), New MyColor(90, 0, 0, 0)) - FrmMain.PanMsg.Background, 200), "PanMsg Background")
AniStart({
AaOpacity(Me, 1, 120, 60),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 300, 60, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 登录弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
Catch ex As Exception
Log(ex, "登录弹窗加载失败", LogLevel.Hint)
End Try
End Sub
Private Sub Close()
'动画
AniStart({
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
}, "MyMsgBox " & Uuid)
End Sub
'实现回车和 Esc 的接口(#4857)
Public Sub Btn1_Click() Handles Btn1.Click
End Sub
Public Sub Btn3_Click() Handles Btn3.Click
Finished(New ThreadInterruptedException)
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
On Error Resume Next
If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
End Sub
#End Region
Private Sub Finished(Result As Object)
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Result
RunInUi(AddressOf Close)
Thread.Sleep(200)
FrmMain.ShowWindowToTop()
End Sub
Private Sub Init()
UserCode = Data("user_code")
DeviceCode = Data("device_code")
Website = Data("verification_uri")
'设置 UI
LabTitle.Text = "登录 Minecraft"
LabCaption.Text =
$"登录网页将自动开启,请在网页中输入 {UserCode}(已自动复制)。" & vbCrLf & vbCrLf &
$"如果网络环境不佳,网页可能一直加载不出来,届时请使用 VPN 并重试。" & vbCrLf &
$"你也可以用其他设备打开 {Website} 并输入上述代码。"
Btn1.EventData = Website
Btn2.EventData = UserCode
'启动工作线程
RunInNewThread(AddressOf WorkThread, "MyMsgLogin")
End Sub
Private Sub WorkThread()
Thread.Sleep(3000)
If MyConverter.IsExited Then Exit Sub
OpenWebsite(Website)
ClipboardSet(UserCode)
Thread.Sleep((Data("interval").ToObject(Of Integer) - 1) * 1000)
'轮询
Dim UnknownFailureCount As Integer = 0
Do While Not MyConverter.IsExited
Try
Dim Result = NetRequestOnce(
"https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST",
"grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
"client_id=" & OAuthClientId & "&" &
"device_code=" & DeviceCode & "&" &
"scope=XboxLive.signin%20offline_access",
"application/x-www-form-urlencoded", 5000 + UnknownFailureCount * 5000, MakeLog:=False)
'获取结果
Dim ResultJson As JObject = GetJson(Result)
McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒")
Hint("网页登录成功!", HintType.Finish)
Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString})
Return
Catch ex As Exception
If ex.Message.Contains("authorization_declined") Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Return
ElseIf ex.Message.Contains("expired_token") Then
Finished(New Exception("$登录用时太长啦,重新试试吧!"))
Return
ElseIf ex.Message.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”,见 #269
Finished(New RestartException)
Return
ElseIf ex.Message.Contains("authorization_pending") Then
Thread.Sleep(2000)
ElseIf UnknownFailureCount <= 2 Then
UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000)
Else
Finished(New Exception("登录轮询失败", ex))
Return
End If
End Try
Loop
End Sub
End Class
@@ -177,8 +177,8 @@
Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress))
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsV2Uuid"), SkinAddress))
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -241,7 +241,8 @@ Retry:
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Follower's", "追随者披风"}
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -21,6 +21,27 @@
'加载版本
RunInNewThread(
Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
'确认自动安装
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Setup.Set("LaunchFolderSelect", "$.minecraft\")
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If
End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +56,27 @@
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Dim InstallLoader = ModpackInstall(PackInstallPath)
If InstallLoader Is Nothing Then
Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
Else
Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
End If
End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
@@ -99,7 +130,7 @@
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible
@@ -265,7 +296,7 @@
Case 0 '正版或离线
UnknownType:
If RadioLoginType5.Checked Then
If Setup.Get("CacheMsAccess") = "" Then
If Setup.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -280,7 +311,7 @@ UnknownType:
RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版
If Setup.Get("CacheMsAccess") = "" Then
If Setup.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -344,7 +375,7 @@ UnknownType:
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String)
'获取名称
Return New EqualableList(Of String) From {Setup.Get("CacheMsName"), Setup.Get("CacheMsUuid")}
Return New EqualableList(Of String) From {Setup.Get("CacheMsV2Name"), Setup.Get("CacheMsV2Uuid")}
End Function
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String))
'清空已有皮肤
@@ -619,7 +650,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候"
FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
@@ -702,7 +733,7 @@ ExitRefresh:
If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退
If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了
'文本
LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %"
Dim HasLaunchDownloader As Boolean = False
Try
@@ -102,6 +102,26 @@ Download:
Log("[Page] 主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file"
GoTo Download
Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/"
GoTo Download
Case 7
Log("[Page] 主页预设:主页市场")
Url = "https://homepage-market.pages.dev/Custom.xaml"
GoTo Download
Case 8
Log("[Page] 主页预设:更新日志")
Url = "https://updatehomepage.pages.dev/UpdateHomepage.xaml"
GoTo Download
Case 9
Log("[Page] 主页预设:PCL 新功能说明书")
Url = "https://gitee.com/wforstbreeze/whats-new-pcl/raw/main/Custom.xaml"
GoTo Download
Case 10
Log("[Page] 主页预设:OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL"
GoTo Download
End Select
End Select
RunInUi(Sub() LoadContent(Content))
@@ -128,7 +148,7 @@ Download:
Dim NeedDownload As Boolean = True
Try
Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000)
If Version.Length > 100 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
If Version.Length > 1000 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
@@ -58,19 +58,21 @@
Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存
Setup.Set("CacheAuthName", "")
RunInThread(Sub()
Try
Dim Data As McLoginServer = GetLoginData()
Data.ForceReselectProfile = True
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", LogLevel.Hint)
End Try
End Sub)
RunInThread(
Sub()
Try
Dim Data As McLoginServer = GetLoginData()
Data.ForceReselectProfile = True
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", LogLevel.Hint)
End Try
End Sub)
End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "")
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")}
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")}
Dim Result As McLoginMs = Nothing
RunInUiWait(
Sub()
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Setup.Get("CacheMsName")
TextName.Text = Setup.Get("CacheMsV2Name")
'皮肤在 Loaded 加载
End Sub
''' <summary>
@@ -20,9 +20,9 @@
''' </summary>
Public Shared Function GetLoginData() As McLoginMs
If McLoginMsLoader.State = LoadState.Finished Then
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName"), .AccessToken = Setup.Get("CacheMsAccess"), .Uuid = Setup.Get("CacheMsUuid"), .ProfileJson = Setup.Get("CacheMsProfileJson")}
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name"), .AccessToken = Setup.Get("CacheMsV2Access"), .Uuid = Setup.Get("CacheMsV2Uuid"), .ProfileJson = Setup.Get("CacheMsV2ProfileJson")}
Else
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")}
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")}
End If
End Function
@@ -50,11 +50,11 @@
'退出登录
Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheMsOAuthRefresh", "")
Setup.Set("CacheMsAccess", "")
Setup.Set("CacheMsProfileJson", "")
Setup.Set("CacheMsUuid", "")
Setup.Set("CacheMsName", "")
Setup.Set("CacheMsV2OAuthRefresh", "")
Setup.Set("CacheMsV2Access", "")
Setup.Set("CacheMsV2ProfileJson", "")
Setup.Set("CacheMsV2Uuid", "")
Setup.Set("CacheMsV2Name", "")
McLoginMsLoader.Abort()
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -90,8 +90,8 @@
Try
Retry:
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess")
Dim Uuid As String = Setup.Get("CacheMsUuid")
Dim AccessToken As String = Setup.Get("CacheMsV2Access")
Dim Uuid As String = Setup.Get("CacheMsV2Uuid")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
@@ -99,7 +99,7 @@ Retry:
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
{New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
}
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
If Result.Contains("request requires user authentication") Then
@@ -419,75 +419,6 @@ Public Class PageLinkIoi
'获取数据包
Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing)
'获取数据
Dim Id As String = JsonData("id"), Type As String = JsonData("type")
Select Case Type
Case "connect"
Dim DisplayName As String = JsonData("name")
Dim User As New LinkUserIoi(Id, DisplayName, NewSocket)
'如果发生了双向连接
If UserList.ContainsKey(Id) Then
If Id > IoiId Then
Log("[IOI] 双向连接,应当抛弃当前用户(" & DisplayName & ")")
For Each Pair In UserList(User.Id).Ports.ToList
User.Ports(Pair.Key) = Pair.Value
Next
UserList(Id).Dispose()
Else
'应当保留当前用户
Log("[IOI] 双向连接,应当保留当前用户(" & DisplayName & ")")
NewSocket.Dispose()
Exit Sub
End If
End If
'加入列表
UserList.Add(Id, User)
'返回请求
User.RelativeThread = RunInNewThread(Sub()
SendPortsubBack(User, JsonData("version").ToObject(Of Integer))
End Sub, "Link Connect " & DisplayName)
'更新时间
User.LastReceive = Date.Now
Case "update"
If Not UserList.ContainsKey(Id) Then Throw New Exception("未在列表中的用户发送了更新请求:" & Id)
Dim User = UserList(Id)
'拉满进度(该请求也作为反向连接回应出现,用于向正向连接方传达连接已完成信号)
User.Progress = 1
'更新名称
Dim DisplayName As String = JsonData("name")
User.DisplayName = DisplayName
'更新房间列表
If JsonData("rooms") IsNot Nothing Then
User.Rooms = New List(Of RoomEntry)
For Each RoomObject In JsonData("rooms")
User.Rooms.Add(New RoomEntry(RoomObject("port"), RoomObject("name"), User))
Next
End If
'更新 Ping
Dim Stage As Integer = JsonData("stage"), Unique As Long = JsonData("unique")
If Stage > 1 Then
User.PingRecord.Enqueue((Date.Now - User.PingPending(Unique)).TotalMilliseconds / 2)
If User.PingRecord.Count > 5 Then User.PingRecord.Dequeue()
User.PingPending.Remove(Unique)
End If
'返回请求
If Stage > 0 AndAlso Stage < 3 Then RunInNewThread(Sub()
Try
SendUpdateRequest(User, Stage + 1, Unique)
Catch ex As Exception
Log(ex, "发送回程请求失败")
End Try
End Sub, "Link Update " & DisplayName)
'更新时间
User.LastReceive = Date.Now
Case "disconnect"
'断开连接
If Not UserList.ContainsKey(Id) Then Exit Sub
UserRemove(UserList(Id), ShowLeaveMessage:=JsonData("message") Is Nothing)
If JsonData("message") IsNot Nothing Then Hint(JsonData("message").ToString, If(JsonData("isError").ToObject(Of Boolean), HintType.Critical, HintType.Info))
Case Else
Throw New Exception("未知的操作种类:" & Type)
End Select
End Sub
''' <summary>
''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。
@@ -63,7 +63,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
@@ -29,7 +29,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.net/a/LTCat" />
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid>
</local:MyCard>
@@ -55,7 +55,7 @@
<local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" />
<local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" />
<local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" />
<local:MyListItem Title="DoodleHuang" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了部分很难找到的 Minecraft 版本与一些技术支持!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 中国 Mod 下载镜像源和帮助库图床!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" />
<local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" />
<local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" />
@@ -75,7 +75,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/DoodleHuang.png" Grid.Row="3" Margin="3">
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/z0z0r4.png" Grid.Row="3" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
@@ -104,312 +104,108 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,10,20">
<TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 5~6 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 9 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10">
<TextBlock Width="120" Margin="0,1.5" Text="哈哈哈哈哈" />
<TextBlock Width="120" Margin="0,1.5" Text="江户川柯南" />
<TextBlock Width="120" Margin="0,1.5" Text="loner..?" />
<TextBlock Width="120" Margin="0,1.5" Text="野比大豆" />
<TextBlock Width="120" Margin="0,1.5" Text="无心之举" />
<TextBlock Width="120" Margin="0,1.5" Text="林禊" />
<TextBlock Width="120" Margin="0,1.5" Text="??!" />
<TextBlock Width="120" Margin="0,1.5" Text="Petrichor" />
<TextBlock Width="120" Margin="0,1.5" Text="一只可爱的frisk啊" />
<TextBlock Width="120" Margin="0,1.5" Text="luvFwt" />
<TextBlock Width="120" Margin="0,1.5" Text="厨师长" />
<TextBlock Width="120" Margin="0,1.5" Text="星輝月下゛" />
<TextBlock Width="120" Margin="0,1.5" Text="密早宪综籽" />
<TextBlock Width="120" Margin="0,1.5" Text="黑云月稀" />
<TextBlock Width="120" Margin="0,1.5" Text="星月球" />
<TextBlock Width="120" Margin="0,1.5" Text="ADerAQi" />
<TextBlock Width="120" Margin="0,1.5" Text="van" />
<TextBlock Width="120" Margin="0,1.5" Text="Eterfrusa" />
<TextBlock Width="120" Margin="0,1.5" Text="kpocc07" />
<TextBlock Width="120" Margin="0,1.5" Text="觉莫" />
<TextBlock Width="120" Margin="0,1.5" Text="我是DGHSFG" />
<TextBlock Width="120" Margin="0,1.5" Text="lhw0616" />
<TextBlock Width="120" Margin="0,1.5" Text="2DGIRL" />
<TextBlock Width="120" Margin="0,1.5" Text="雨猫霖" />
<TextBlock Width="120" Margin="0,1.5" Text="Grazie" />
<TextBlock Width="120" Margin="0,1.5" Text="鲲鹏roc" />
<TextBlock Width="120" Margin="0,1.5" Text="皮皮苏" />
<TextBlock Width="120" Margin="0,1.5" Text="哆啦哆啦" />
<TextBlock Width="120" Margin="0,1.5" Text="serendipity" />
<TextBlock Width="120" Margin="0,1.5" Text="W-Qi" />
<TextBlock Width="120" Margin="0,1.5" Text="tenneidp" />
<TextBlock Width="120" Margin="0,1.5" Text="叢沄" />
<TextBlock Width="120" Margin="0,1.5" Text="jian_ke" />
<TextBlock Width="120" Margin="0,1.5" Text="ZHypocrite" />
<TextBlock Width="120" Margin="0,1.5" Text="浑荀" />
<TextBlock Width="120" Margin="0,1.5" Text="yoo-ovo" />
<TextBlock Width="120" Margin="0,1.5" Text="洛梓风anemo" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃的狗" />
<TextBlock Width="120" Margin="0,1.5" Text="落灯花" />
<TextBlock Width="120" Margin="0,1.5" Text="涩图来一份" />
<TextBlock Width="120" Margin="0,1.5" Text="FSAH217" />
<TextBlock Width="120" Margin="0,1.5" Text="炽绪" />
<TextBlock Width="120" Margin="0,1.5" Text="JUBEYsl" />
<TextBlock Width="120" Margin="0,1.5" Text="阿祺27" />
<TextBlock Width="120" Margin="0,1.5" Text="江上数峰青" />
<TextBlock Width="120" Margin="0,1.5" Text="ECHO" />
<TextBlock Width="120" Margin="0,1.5" Text="路易斯" />
<TextBlock Width="120" Margin="0,1.5" Text="别曹曹了" />
<TextBlock Width="120" Margin="0,1.5" Text="Szy" />
<TextBlock Width="120" Margin="0,1.5" Text="长安常安" />
<TextBlock Width="120" Margin="0,1.5" Text="鲨鲨" />
<TextBlock Width="120" Margin="0,1.5" Text="对白拼拼凑凑" />
<TextBlock Width="120" Margin="0,1.5" Text="月下吃米糖" />
<TextBlock Width="120" Margin="0,1.5" Text="小雨要" />
<TextBlock Width="120" Margin="0,1.5" Text="臻榛搸殝" />
<TextBlock Width="120" Margin="0,1.5" Text="王富贵" />
<TextBlock Width="120" Margin="0,1.5" Text="久久" />
<TextBlock Width="120" Margin="0,1.5" Text="嗯哼?" />
<TextBlock Width="120" Margin="0,1.5" Text="木沐" />
<TextBlock Width="120" Margin="0,1.5" Text="永久里" />
<TextBlock Width="120" Margin="0,1.5" Text="小白狐" />
<TextBlock Width="120" Margin="0,1.5" Text="Z." />
<TextBlock Width="120" Margin="0,1.5" Text="芝惑鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="MegnaAegwynn " />
<TextBlock Width="120" Margin="0,1.5" Text="DJLD" />
<TextBlock Width="120" Margin="0,1.5" Text="曦月" />
<TextBlock Width="120" Margin="0,1.5" Text="TylerDeng" />
<TextBlock Width="120" Margin="0,1.5" Text="1899年的提拉米苏" />
<TextBlock Width="120" Margin="0,1.5" Text="bzwm" />
<TextBlock Width="120" Margin="0,1.5" Text="GhaMZz" />
<TextBlock Width="120" Margin="0,1.5" Text="雪游" />
<TextBlock Width="120" Margin="0,1.5" Text="奇怪的大土豆" />
<TextBlock Width="120" Margin="0,1.5" Text="Moonlight-池绾" />
<TextBlock Width="120" Margin="0,1.5" Text="fusocietyck" />
<TextBlock Width="120" Margin="0,1.5" Text="爬爬鸡" />
<TextBlock Width="120" Margin="0,1.5" Text="山千海千" />
<TextBlock Width="120" Margin="0,1.5" Text="氿离Yoi" />
<TextBlock Width="120" Margin="0,1.5" Text="如风沐烟" />
<TextBlock Width="120" Margin="0,1.5" Text="一条博子" />
<TextBlock Width="120" Margin="0,1.5" Text="m1679" />
<TextBlock Width="120" Margin="0,1.5" Text="snow" />
<TextBlock Width="120" Margin="0,1.5" Text="3瓶奶茶" />
<TextBlock Width="120" Margin="0,1.5" Text="Elkanah_" />
<TextBlock Width="120" Margin="0,1.5" Text="孤默少言" />
<TextBlock Width="120" Margin="0,1.5" Text="也要拿出真本事" />
<TextBlock Width="120" Margin="0,1.5" Text="武彩鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="雷霆兴哥" />
<TextBlock Width="120" Margin="0,1.5" Text="EnsoNani" />
<TextBlock Width="120" Margin="0,1.5" Text="Ann.Midnight" />
<TextBlock Width="120" Margin="0,1.5" Text="郁子恒是FW" />
<TextBlock Width="120" Margin="0,1.5" Text="ZIHE_kk" />
<TextBlock Width="120" Margin="0,1.5" Text="文八" />
<TextBlock Width="120" Margin="0,1.5" Text="寂月星落" />
<TextBlock Width="120" Margin="0,1.5" Text="Writer_DaMao" />
<TextBlock Width="120" Margin="0,1.5" Text="gwd233" />
<TextBlock Width="120" Margin="0,1.5" Text="Sutvh" />
<TextBlock Width="120" Margin="0,1.5" Text="崔东山" />
<TextBlock Width="120" Margin="0,1.5" Text="Botaiii" />
<TextBlock Width="120" Margin="0,1.5" Text="凛仙子D-" />
<TextBlock Width="120" Margin="0,1.5" Text="MooFaH" />
<TextBlock Width="120" Margin="0,1.5" Text="嘿哈吼" />
<TextBlock Width="120" Margin="0,1.5" Text="下山吃肉的兔子" />
<TextBlock Width="120" Margin="0,1.5" Text="warship" />
<TextBlock Width="120" Margin="0,1.5" Text="木落微雨" />
<TextBlock Width="120" Margin="0,1.5" Text="杨阳baby" />
<TextBlock Width="120" Margin="0,1.5" Text="白茶" />
<TextBlock Width="120" Margin="0,1.5" Text="路过一下的尘垒" />
<TextBlock Width="120" Margin="0,1.5" Text="counterea" />
<TextBlock Width="120" Margin="0,1.5" Text="雨中盛开的花朵" />
<TextBlock Width="120" Margin="0,1.5" Text="珊瑚宫心海" />
<TextBlock Width="120" Margin="0,1.5" Text="luner" />
<TextBlock Width="120" Margin="0,1.5" Text="时崎王罪丶" />
<TextBlock Width="120" Margin="0,1.5" Text="Nicht" />
<TextBlock Width="120" Margin="0,1.5" Text="冰薇" />
<TextBlock Width="120" Margin="0,1.5" Text="Archetto" />
<TextBlock Width="120" Margin="0,1.5" Text="蓝冰之刃" />
<TextBlock Width="120" Margin="0,1.5" Text="Baguette" />
<TextBlock Width="120" Margin="0,1.5" Text="KenshenLove" />
<TextBlock Width="120" Margin="0,1.5" Text="花卉" />
<TextBlock Width="120" Margin="0,1.5" Text="hmmmfffll" />
<TextBlock Width="120" Margin="0,1.5" Text="夕阳下的余光" />
<TextBlock Width="120" Margin="0,1.5" Text="扶风°" />
<TextBlock Width="120" Margin="0,1.5" Text="唠叨的土豆" />
<TextBlock Width="120" Margin="0,1.5" Text="ulifx" />
<TextBlock Width="120" Margin="0,1.5" Text="DXX" />
<TextBlock Width="120" Margin="0,1.5" Text="小曲" />
<TextBlock Width="120" Margin="0,1.5" Text="0飞霜墨染0" />
<TextBlock Width="120" Margin="0,1.5" Text="Aminos1337" />
<TextBlock Width="120" Margin="0,1.5" Text="死亡旋风大魔王" />
<TextBlock Width="120" Margin="0,1.5" Text="风见翎" />
<TextBlock Width="120" Margin="0,1.5" Text="雷霆" />
<TextBlock Width="120" Margin="0,1.5" Text="[擦汗]" />
<TextBlock Width="120" Margin="0,1.5" Text="远东雪橇猫" />
<TextBlock Width="120" Margin="0,1.5" Text="安夏洛克" />
<TextBlock Width="120" Margin="0,1.5" Text="acac" />
<TextBlock Width="120" Margin="0,1.5" Text="瑞风" />
<TextBlock Width="120" Margin="0,1.5" Text="xiankeQAQ" />
<TextBlock Width="120" Margin="0,1.5" Text="BDUCK" />
<TextBlock Width="120" Margin="0,1.5" Text="fuaglove" />
<TextBlock Width="120" Margin="0,1.5" Text="prprprrrpop" />
<TextBlock Width="120" Margin="0,1.5" Text="YOCE" />
<TextBlock Width="120" Margin="0,1.5" Text="忹." />
<TextBlock Width="120" Margin="0,1.5" Text="夜青" />
<TextBlock Width="120" Margin="0,1.5" Text="橘糸侑You" />
<TextBlock Width="120" Margin="0,1.5" Text="薇克波顿" />
<TextBlock Width="120" Margin="0,1.5" Text="夂冬螽" />
<TextBlock Width="120" Margin="0,1.5" Text="Colitary" />
<TextBlock Width="120" Margin="0,1.5" Text="Harm_b10ck" />
<TextBlock Width="120" Margin="0,1.5" Text="乆月" />
<TextBlock Width="120" Margin="0,1.5" Text="Kaoukala" />
<TextBlock Width="120" Margin="0,1.5" Text="墨染★希" />
<TextBlock Width="120" Margin="0,1.5" Text="松菀" />
<TextBlock Width="120" Margin="0,1.5" Text="疾驰火车" />
<TextBlock Width="120" Margin="0,1.5" Text="疾影烬" />
<TextBlock Width="120" Margin="0,1.5" Text="Awfrlu+" />
<TextBlock Width="120" Margin="0,1.5" Text="Lava_drop_" />
<TextBlock Width="120" Margin="0,1.5" Text="? *???* ?" />
<TextBlock Width="120" Margin="0,1.5" Text="Gwynsur" />
<TextBlock Width="120" Margin="0,1.5" Text="许淼淼" />
<TextBlock Width="120" Margin="0,1.5" Text="waneng0807" />
<TextBlock Width="120" Margin="0,1.5" Text="安anLa" />
<TextBlock Width="120" Margin="0,1.5" Text="MQDCB" />
<TextBlock Width="120" Margin="0,1.5" Text="我dnmd" />
<TextBlock Width="120" Margin="0,1.5" Text="猫舍旁边有恶犬" />
<TextBlock Width="120" Margin="0,1.5" Text="yk" />
<TextBlock Width="120" Margin="0,1.5" Text="Cik-z" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃不是桃丫" />
<TextBlock Width="120" Margin="0,1.5" Text="陌白" />
<TextBlock Width="120" Margin="0,1.5" Text="C418" />
<TextBlock Width="120" Margin="0,1.5" Text="醉梦仙露" />
<TextBlock Width="240" Margin="0,1.5" Text="Re.从零开始跟猪鲨鲨恋爱" />
<TextBlock Width="120" Margin="0,1.5" Text="玄?" />
<TextBlock Width="120" Margin="0,1.5" Text="olwlm" />
<TextBlock Width="120" Margin="0,1.5" Text="XiaoLe_SH" />
<TextBlock Width="120" Margin="0,1.5" Text="龙大炮" />
<TextBlock Width="120" Margin="0,1.5" Text="陆阿藏" />
<TextBlock Width="120" Margin="0,1.5" Text="lo" />
<TextBlock Width="120" Margin="0,1.5" Text="七夜英理" />
<TextBlock Width="120" Margin="0,1.5" Text="lizi" />
<TextBlock Width="120" Margin="0,1.5" Text="范德Fa" />
<TextBlock Width="120" Margin="0,1.5" Text="云自无心" />
<TextBlock Width="120" Margin="0,1.5" Text="尚可" />
<TextBlock Width="120" Margin="0,1.5" Text="回转命运" />
<TextBlock Width="120" Margin="0,1.5" Text="恶搞的人格" />
<TextBlock Width="120" Margin="0,1.5" Text="安安生生" />
<TextBlock Width="120" Margin="0,1.5" Text="蛋仔派对-小冷" />
<TextBlock Width="120" Margin="0,1.5" Text="间铃" />
<TextBlock Width="120" Margin="0,1.5" Text="瀧柳" />
<TextBlock Width="120" Margin="0,1.5" Text="IRasciblebh" />
<TextBlock Width="120" Margin="0,1.5" Text="15183318101" />
<TextBlock Width="120" Margin="0,1.5" Text="LALALA" />
<TextBlock Width="120" Margin="0,1.5" Text="大香蕉" />
<TextBlock Width="120" Margin="0,1.5" Text="Another0" />
<TextBlock Width="120" Margin="0,1.5" Text="丢天帝" />
<TextBlock Width="120" Margin="0,1.5" Text="魔法喵酱" />
<TextBlock Width="120" Margin="0,1.5" Text="wshilaoliu" />
<TextBlock Width="120" Margin="0,1.5" Text="PangDaHusky" />
<TextBlock Width="120" Margin="0,1.5" Text="qi_lu" />
<TextBlock Width="120" Margin="0,1.5" Text="LetvGodyan" />
<TextBlock Width="120" Margin="0,1.5" Text="Amo" />
<TextBlock Width="120" Margin="0,1.5" Text="liang" />
<TextBlock Width="120" Margin="0,1.5" Text="baijillys" />
<TextBlock Width="120" Margin="0,1.5" Text="栗悟飯とカメハメ波" />
<TextBlock Width="120" Margin="0,1.5" Text="姜路扬" />
<TextBlock Width="120" Margin="0,1.5" Text="LuluPipi" />
<TextBlock Width="120" Margin="0,1.5" Text="Atuo" />
<TextBlock Width="120" Margin="0,1.5" Text="泳圈鼬用攀瀑" />
<TextBlock Width="120" Margin="0,1.5" Text="EWD" />
<TextBlock Width="120" Margin="0,1.5" Text="孟然君" />
<TextBlock Width="120" Margin="0,1.5" Text="num61" />
<TextBlock Width="120" Margin="0,1.5" Text="Elysia_mc" />
<TextBlock Width="120" Margin="0,1.5" Text="Wehrmacht" />
<TextBlock Width="120" Margin="0,1.5" Text="野生的小乐子" />
<TextBlock Width="120" Margin="0,1.5" Text="星韵林" />
<TextBlock Width="120" Margin="0,1.5" Text="剁椒鱼头" />
<TextBlock Width="120" Margin="0,1.5" Text="Jking" />
<TextBlock Width="240" Margin="0,1.5" Text="抖音搜索:清凉夏日一只瓜" />
<TextBlock Width="120" Margin="0,1.5" Text="HEARLEY" />
<TextBlock Width="120" Margin="0,1.5" Text="woaini_awa" />
<TextBlock Width="120" Margin="0,1.5" Text="龙天行" />
<TextBlock Width="120" Margin="0,1.5" Text="亦羽君" />
<TextBlock Width="120" Margin="0,1.5" Text="言十七" />
<TextBlock Width="120" Margin="0,1.5" Text="zzc" />
<TextBlock Width="120" Margin="0,1.5" Text="w?z?r?y" />
<TextBlock Width="120" Margin="0,1.5" Text="havoc" />
<TextBlock Width="120" Margin="0,1.5" Text="一条咸鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="大鸡翅膀" />
<TextBlock Width="120" Margin="0,1.5" Text="月语" />
<TextBlock Width="120" Margin="0,1.5" Text="BBQ" />
<TextBlock Width="120" Margin="0,1.5" Text="糖糖" />
<TextBlock Width="120" Margin="0,1.5" Text="七月一" />
<TextBlock Width="120" Margin="0,1.5" Text="独角受" />
<TextBlock Width="120" Margin="0,1.5" Text="10000cituitui" />
<TextBlock Width="120" Margin="0,1.5" Text="Television" />
<TextBlock Width="120" Margin="0,1.5" Text="......" />
<TextBlock Width="120" Margin="0,1.5" Text="LONG11" />
<TextBlock Width="120" Margin="0,1.5" Text="OP仙人" />
<TextBlock Width="120" Margin="0,1.5" Text="陌音依矢—笠风" />
<TextBlock Width="120" Margin="0,1.5" Text="kinno_mc" />
<TextBlock Width="120" Margin="0,1.5" Text="Avid" />
<TextBlock Width="120" Margin="0,1.5" Text="brimobe" />
<TextBlock Width="120" Margin="0,1.5" Text="Momoki" />
<TextBlock Width="120" Margin="0,1.5" Text="徐小疯" />
<TextBlock Width="120" Margin="0,1.5" Text="我爱龙猫!!!" />
<TextBlock Width="120" Margin="0,1.5" Text="233" />
<TextBlock Width="120" Margin="0,1.5" Text="礼尚往来" />
<TextBlock Width="120" Margin="0,1.5" Text="会吐槽的毛熊" />
<TextBlock Width="120" Margin="0,1.5" Text="耶梦加得" />
<TextBlock Width="120" Margin="0,1.5" Text="pumpkin" />
<TextBlock Width="120" Margin="0,1.5" Text="Solaray3" />
<TextBlock Width="120" Margin="0,1.5" Text="m1a0w0" />
<TextBlock Width="120" Margin="0,1.5" Text="懿轩" />
<TextBlock Width="120" Margin="0,1.5" Text="圆圆xyz" />
<TextBlock Width="120" Margin="0,1.5" Text="EchoLong" />
<TextBlock Width="120" Margin="0,1.5" Text="光与影的对白" />
<TextBlock Width="120" Margin="0,1.5" Text="AptS:1547" />
<TextBlock Width="120" Margin="0,1.5" Text="中转站" />
<TextBlock Width="120" Margin="0,1.5" Text="情猫" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃Mahero" />
<TextBlock Width="120" Margin="0,1.5" Text="Ew_o" />
<TextBlock Width="120" Margin="0,1.5" Text="叽里呱啦" />
<TextBlock Width="120" Margin="0,1.5" Text="MHNIO" />
<TextBlock Width="120" Margin="0,1.5" Text="小洺" />
<TextBlock Width="120" Margin="0,1.5" Text="龙儿" />
<TextBlock Width="120" Margin="0,1.5" Text="ccll48" />
<TextBlock Width="120" Margin="0,1.5" Text="Ling7844" />
<TextBlock Width="120" Margin="0,1.5" Text="不会写网名的屑" />
<TextBlock Width="120" Margin="0,1.5" Text="Aresposeidon1124" />
<TextBlock Width="120" Margin="0,1.5" Text="钻石Daiyamondo" />
<TextBlock Width="120" Margin="0,1.5" Text="七月无风" />
<TextBlock Width="120" Margin="0,1.5" Text="YuTian" />
<TextBlock Width="120" Margin="0,1.5" Text="csleep" />
<TextBlock Width="120" Margin="0,1.5" Text="小天使" />
<TextBlock Width="120" Margin="0,1.5" Text="墨水" />
<TextBlock Width="120" Margin="0,1.5" Text="阿耀" />
<TextBlock Width="120" Margin="0,1.5" Text="青绵kipilu" />
<TextBlock Width="120" Margin="0,1.5" Text="IWI_Margarita" />
<TextBlock Width="120" Margin="0,1.5" Text="小林カンナ" />
<TextBlock Width="120" Margin="0,1.5" Text="TD-Clotys" />
<TextBlock Width="120" Margin="0,1.5" Text="哈先生" />
<TextBlock Width="120" Margin="0,1.5" Text="老潘" />
<TextBlock Width="120" Margin="0,1.5" Text="绝少" />
<TextBlock Width="120" Margin="0,1.5" Text="咸鱼汤鱼咸" />
<TextBlock Width="120" Margin="0,1.5" Text="Celery" />
<TextBlock Width="120" Margin="0,1.5" Text="简称FV" />
<TextBlock Width="120" Margin="0,1.5" Text="飞翔的PUMA" />
<TextBlock Width="120" Margin="0,1.5" Text="123456。?" />
<TextBlock Width="120" Margin="0,1.5" Text="heitong_shu" />
<TextBlock Width="120" Margin="0,1.5" Text="Lan" />
<TextBlock Width="120" Margin="0,1.5" Text="sanjuou" />
<TextBlock Width="120" Margin="0,1.5" Text="芙芙" />
<TextBlock Width="120" Margin="0,1.5" Text="zyc11230170" />
<TextBlock Width="120" Margin="0,1.5" Text="TOUHOULUO" />
<TextBlock Width="120" Margin="0,1.5" Text="在下雾切" />
<TextBlock Width="120" Margin="0,1.5" Text="exusiai2357" />
<TextBlock Width="120" Margin="0,1.5" Text="???" />
<TextBlock Width="120" Margin="0,1.5" Text="润煌Ricardo" />
<TextBlock Width="120" Margin="0,1.5" Text="无风" />
<TextBlock Width="120" Margin="0,1.5" Text="缘花乐" />
<TextBlock Width="120" Margin="0,1.5" Text="Willian" />
<TextBlock Width="120" Margin="0,1.5" Text="墨尘烟雨" />
<TextBlock Width="120" Margin="0,1.5" Text="加五九九五" />
<TextBlock Width="120" Margin="0,1.5" Text="白裘峪" />
<TextBlock Width="120" Margin="0,1.5" Text="加载中..." />
<TextBlock Width="120" Margin="0,1.5" Text="Стразар" />
<TextBlock Width="120" Margin="0,1.5" Text="夜语霖" />
<TextBlock Width="120" Margin="0,1.5" Text="Wolfgang_233" />
<TextBlock Width="120" Margin="0,1.5" Text="小螺浩" />
<TextBlock Width="120" Margin="0,1.5" Text="rtoe332" />
<TextBlock Width="120" Margin="0,1.5" Text="lliiooll" />
<TextBlock Width="120" Margin="0,1.5" Text="QFwushang" />
<TextBlock Width="120" Margin="0,1.5" Text="竹翼" />
<TextBlock Width="120" Margin="0,1.5" Text="没差" />
<TextBlock Width="120" Margin="0,1.5" Text="用户13223" />
<TextBlock Width="120" Margin="0,1.5" Text="猫羽喵" />
<TextBlock Width="120" Margin="0,1.5" Text="水阔鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="无名氏" />
<TextBlock Width="120" Margin="0,1.5" Text="绘梨衣のGodzilla" />
<TextBlock Width="120" Margin="0,1.5" Text="521HERTZ" />
<TextBlock Width="120" Margin="0,1.5" Text="momotsuki" />
<TextBlock Width="120" Margin="0,1.5" Text="浩东流" />
<TextBlock Width="120" Margin="0,1.5" Text="破片南瓜" />
<TextBlock Width="120" Margin="0,1.5" Text="playalone" />
<TextBlock Width="120" Margin="0,1.5" Text="木丶九九" />
<TextBlock Width="120" Margin="0,1.5" Text="闫雁" />
<TextBlock Width="120" Margin="0,1.5" Text="雨季丶看花落丬" />
<TextBlock Width="120" Margin="0,1.5" Text="greenClemente" />
<TextBlock Width="120" Margin="0,1.5" Text="nfd" />
<TextBlock Width="120" Margin="0,1.5" Text="求阙" />
<TextBlock Width="120" Margin="0,1.5" Text="苏苏" />
<TextBlock Width="120" Margin="0,1.5" Text="冰魄凝华Iris" />
<TextBlock Width="120" Margin="0,1.5" Text="TNT" />
<TextBlock Width="120" Margin="0,1.5" Text="jokeresin" />
<TextBlock Width="120" Margin="0,1.5" Text="冻冻莓" />
<TextBlock Width="120" Margin="0,1.5" Text="木吉" />
<TextBlock Width="120" Margin="0,1.5" Text="寰辰" />
<TextBlock Width="120" Margin="0,1.5" Text="大智" />
<TextBlock Width="120" Margin="0,1.5" Text="晚吟" />
<TextBlock Width="120" Margin="0,1.5" Text="e_2" />
<TextBlock Width="120" Margin="0,1.5" Text="墨辞" />
<TextBlock Width="120" Margin="0,1.5" Text="CongYiXu1259" />
<TextBlock Width="120" Margin="0,1.5" Text="绀香十九" />
<TextBlock Width="120" Margin="0,1.5" Text="花十一" />
<TextBlock Width="120" Margin="0,1.5" Text="摸摸鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="不想起名" />
<TextBlock Width="120" Margin="0,1.5" Text="Corazon" />
<TextBlock Width="120" Margin="0,1.5" Text="断幕" />
<TextBlock Width="120" Margin="0,1.5" Text="wuying" />
<TextBlock Width="120" Margin="0,1.5" Text="隐”" />
<TextBlock Width="120" Margin="0,1.5" Text="华子" />
<TextBlock Width="120" Margin="0,1.5" Text="Hikari" />
<TextBlock Width="120" Margin="0,1.5" Text="小辉joyb_" />
<TextBlock Width="120" Margin="0,1.5" Text="bluck" />
<TextBlock Width="120" Margin="0,1.5" Text="风人过" />
<TextBlock Width="120" Margin="0,1.5" Text="锦锋" />
<TextBlock Width="120" Margin="0,1.5" Text="初辟鸿蒙" />
<TextBlock Width="120" Margin="0,1.5" Text="YLF零度" />
<TextBlock Width="120" Margin="0,1.5" Text="ADB114514" />
<TextBlock Width="120" Margin="0,1.5" Text="晓乐" />
<TextBlock Width="120" Margin="0,1.5" Text="Raze" />
<TextBlock Width="120" Margin="0,1.5" Text="jj" />
<TextBlock Width="120" Margin="0,1.5" Text="社÷老登" />
<TextBlock Width="120" Margin="0,1.5" Text="仝圮" />
<TextBlock Width="240" Margin="0,1.5" Text="FSL Launcher - 小黄菌" />
<TextBlock Width="120" Margin="0,1.5" Text="华燃王小灭" />
<TextBlock Width="120" Margin="0,1.5" Text="Charlotte_Caius" />
<TextBlock Width="120" Margin="0,1.5" Text="木了丰" />
<TextBlock Width="120" Margin="0,1.5" Text="-夜-光-" />
<TextBlock Width="120" Margin="0,1.5" Text="蓝色骷髅" />
<TextBlock Width="120" Margin="0,1.5" Text="易游" />
<TextBlock Width="120" Margin="0,1.5" Text="祈绫参_UPE" />
<TextBlock Width="120" Margin="0,1.5" Text="卖梦的人" />
<TextBlock Width="120" Margin="0,1.5" Text="rking" />
<TextBlock Width="120" Margin="0,1.5" Text="柠果籽" />
<TextBlock Width="240" Margin="0,1.5" Text="真我 · 人之律者爱莉希雅" />
<TextBlock Width="120" Margin="0,1.5" Text="KevinREL" />
<TextBlock Width="120" Margin="0,1.5" Text="LEIBI" />
<TextBlock Width="120" Margin="0,1.5" Text="GNFDF" />
<TextBlock Width="120" Margin="0,1.5" Text="朱重八" />
<TextBlock Width="120" Margin="0,1.5" Text="TONYAF" />
<TextBlock Width="120" Margin="0,1.5" Text="Reshiram???" />
<TextBlock Width="120" Margin="0,1.5" Text="克罗44" />
<TextBlock Width="120" Margin="0,1.5" Text="社恐的波奇酱" />
<TextBlock Width="120" Margin="0,1.5" Text="Xylophone233" />
<TextBlock Width="120" Margin="0,1.5" Text="陌上如玉" />
<TextBlock Width="120" Margin="0,1.5" Text="lili66" />
<TextBlock Width="120" Margin="0,1.5" Text="小派呀" />
<TextBlock Width="120" Margin="0,1.5" Text="日想" />
<TextBlock Width="120" Margin="0,1.5" Text="墨处择" />
<TextBlock Width="120" Margin="0,1.5" Text="刘畅" />
<TextBlock Width="120" Margin="0,1.5" Text="做好事不留名的好心人" />
<TextBlock Width="120" Margin="0,1.5" Text="好将军" />
<TextBlock Width="120" Margin="0,1.5" Text="为生活而拼搏" />
<TextBlock Width="120" Margin="0,1.5" Text="韬光养晦" />
<TextBlock Width="120" Margin="0,1.5" Text="知芍" />
<TextBlock Width="120" Margin="0,1.5" Text="awa" />
<TextBlock Width="120" Margin="0,1.5" Text="CaTy" />
<TextBlock Width="120" Margin="0,1.5" Text="zhifeiwen" />
<TextBlock Width="120" Margin="0,1.5" Text="磁爆步兵" />
<TextBlock Width="120" Margin="0,1.5" Text="双开门冰箱AK15" />
<TextBlock Width="120" Margin="0,1.5" Text="泠羽" />
<TextBlock Width="120" Margin="0,1.5" Text="lupeihao" />
<TextBlock Width="120" Margin="0,1.5" Text="木子" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
@@ -418,7 +214,7 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.net/a/LTCat" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
@@ -427,12 +223,12 @@
<local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True">
<StackPanel Margin="25,39,23,20">
<TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件会汇报自己的版本名与版本号,以统计用户数量与各版本的用户数量占比。除此之外,本软件不会上传您的任何信息。&#13;若您能提供未经外部修改的本软件本体上传隐私信息的确凿证据,开发者会向您支付 PCL 开发所获全部净收入。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件的 User Agent 中包含启动器的版本号,以统计各版本的用户数量。&#13;除此之外,本软件不会向开发者上传任何其他信息。" TextWrapping="Wrap" />
<TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:[email protected]" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:[email protected]&#13;非 MINECRAFT 官方产品。未经 MOJANG 或 MICROSOFT 批准,也不与 MOJANG 或 MICROSOFT 关联。" TextWrapping="Wrap" />
<StackPanel Orientation="Horizontal" Height="35" HorizontalAlignment="Left" Margin="0,12,0,0">
<local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" />
<local:MyButton Text="查看源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
<local:MyButton Text="开源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</StackPanel>
</StackPanel>
</local:MyCard>
@@ -458,6 +254,8 @@
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" Grid.Column="0" Text="Java Launch Wrapper" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="0" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2022 00ll00&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
@@ -494,10 +292,18 @@
<local:MyButton Grid.Row="9" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://iconmonstr.com/license/" />
<TextBlock Grid.Row="10" Grid.Column="0" Text="Iconfont" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="10" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © ALIMAMA MUX, powered by alimama THX." TextWrapping="Wrap" />
<local:MyButton Grid.Row="11" Grid.Column="2" MinWidth="140" Text="查看原网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
<TextBlock Grid.Row="10" Grid.Column="0" Text="libwebp wrapper for .NET" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="10" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2012 Imazen&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
<local:MyButton Grid.Row="11" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/imazen/libwebp-net" />
<local:MyButton Grid.Row="11" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/imazen/libwebp-net/blob/master/LICENSE.txt" />
<TextBlock Grid.Row="12" Grid.Column="0" Text="Iconfont" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="12" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © ALIMAMA MUX, powered by alimama THX." TextWrapping="Wrap" />
<local:MyButton Grid.Row="13" Grid.Column="2" MinWidth="140" Text="查看原网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://www.iconfont.cn/" />
</Grid>
</local:MyCard>
</StackPanel>
@@ -19,7 +19,7 @@
End Sub
Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click
OpenWebsite("https://afdian.net/a/bangbang93")
OpenWebsite("https://afdian.com/a/bangbang93")
End Sub
Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click
OpenWebsite("https://www.mcmod.cn")
@@ -27,7 +27,7 @@
Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click
ClipboardSet(UniqueAddress)
End Sub
Private Sub DonateCodeInput() Handles BtnDonateInput.Click
Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput()
End Sub
@@ -83,7 +83,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
@@ -127,8 +127,8 @@
'打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If Not CanFeedback(True) Then Exit Sub
Select Case MyMsgBox("是否要打开反馈列表网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"反馈提示", "提交新反馈", "查看反馈列表", "取消")
Select Case MyMsgBox("在提交新反馈前,建议先搜索反馈列表,以避免重复提交。" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"反馈", "提交新反馈", "查看反馈列表", "取消")
Case 1
Feedback(True, False)
Case 2
@@ -137,7 +137,7 @@
End Sub
Public Shared Sub TryVote() Handles ItemVote.Click
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
"新功能投票", "打开", "取消") = 2 Then Exit Sub
OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created")
End Sub
@@ -9,6 +9,8 @@
''' </summary>
Private ReadOnly SetupDict As New Dictionary(Of String, SetupEntry) From {
{"Identify", New SetupEntry("", Source:=SetupSource.Registry)},
{"WindowHeight", New SetupEntry(550)},
{"WindowWidth", New SetupEntry(900)},
{"HintDownloadThread", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintNotice", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintDownload", New SetupEntry(0, Source:=SetupSource.Registry)},
@@ -42,6 +44,12 @@
{"CacheMsProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Migrated", New SetupEntry(False, Source:=SetupSource.Registry)},
{"CacheMsV2OAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Access", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2ProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Uuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsV2Name", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideClient", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
@@ -86,7 +94,7 @@
{"LaunchArgumentWindowHeight", New SetupEntry(480)},
{"LaunchArgumentWindowType", New SetupEntry(1)},
{"LaunchArgumentRam", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LaunchAdvanceJvm", New SetupEntry("-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")},
{"LaunchAdvanceJvm", New SetupEntry("-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")},
{"LaunchAdvanceGame", New SetupEntry("")},
{"LaunchAdvanceRun", New SetupEntry("")},
{"LaunchAdvanceRunWait", New SetupEntry(True)},
@@ -105,9 +113,10 @@
{"ToolDownloadSpeed", New SetupEntry(42, Source:=SetupSource.Registry)},
{"ToolDownloadVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolModLocalNameStyle", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -591,7 +600,7 @@
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png")
FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png"
Catch ex As Exception
FrmMain.ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", LogLevel.Msgbox)
@@ -7,9 +7,9 @@
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="离线皮肤">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,皮肤预览与 Steve/Alex/自定义 选项暂时仅保证对 1.19.2 以前的版本有效!" IsWarn="False" Margin="0,0,0,10" />
<local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" IsWarn="True" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -321,6 +321,11 @@
''' 获取当前设置的 RAM 值。单位为 GB。
''' </summary>
Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double
'------------------------------------------
' 修改下方代码时需要一并修改 PageVersionSetup
'------------------------------------------
Dim RamGive As Double
If Setup.Get("LaunchRamType") = 0 Then
'自动配置
@@ -507,7 +512,7 @@ PreFin:
#End Region
#Region "启动参数"
#Region "其他选项"
Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged
If ComboArgumentWindowType Is Nothing Then Exit Sub
@@ -545,6 +550,19 @@ PreFin:
End If
End Sub
'版本隔离警告
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档,不建议修改这项设置!",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
AniControlEnabled += 1
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
AniControlEnabled -= 1
End If
End Sub
#End Region
#Region "高级设置"
@@ -115,7 +115,7 @@
PageID = ID
Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
@@ -7,9 +7,43 @@
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="下载">
<StackPanel Margin="25,37,25,12">
<StackPanel Margin="25,37,25,15">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="27" />
<RowDefinition Height="27" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表源" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本最新,但加载缓慢)" />
</local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="2" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" />
<TextBlock VerticalAlignment="Center" Grid.Row="3" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="3" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" />
<TextBlock VerticalAlignment="Top" Grid.Row="4" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="4" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="5" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="开启验证会提高安全性、降低盗号风险(见 #2767),但也可能导致正版登录失败(见 #3018)。" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="Mod 与整合包">
<StackPanel Margin="25,37,25,15">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
@@ -20,45 +54,33 @@
<RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="27" />
<RowDefinition Height="27" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" />
<local:MyComboBoxItem Content="在官方源加载缓慢时改用镜像源(平衡)" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本为最新,但加载非常缓慢)" />
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载源" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadMod" Grid.Row="0" Grid.ColumnSpan="2" Tag="ToolDownloadMod" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(暂时无效)" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源" IsSelected="True" />
</local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 命名风格" Margin="0,0,25,0" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载文件名" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="2" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1"
ToolTip="决定下载的 Mod 的默认文件名中,中文译名应该放在哪个位置">
ToolTip="下载 Mod 时,Mod 的默认文件名中,中文译名应该放在哪个位置">
<local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" />
<local:MyComboBoxItem Content="译名位于文件名开头:遗物-relics-0.1.14" />
<local:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" />
<local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="4" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" />
<TextBlock VerticalAlignment="Center" Grid.Row="5" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" />
<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 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 管理样式" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="4" x:Name="ComboModLocalNameStyle" Grid.ColumnSpan="2" Tag="ToolModLocalNameStyle" Grid.Column="1"
ToolTip="在 Mod 管理页面中,Mod 项的显示方式">
<local:MyComboBoxItem Content="标题显示译名,详情显示文件名" IsSelected="True" />
<local:MyComboBoxItem Content="标题显示文件名,详情显示译名" />
</local:MyComboBox>
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="6" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -93,7 +115,8 @@
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="5" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" />
@@ -116,15 +139,23 @@
<local:ValidateFolderPath UseMinecraftCharCheck="False" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,5,0,0">
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,12,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemSettingExp" MinWidth="140" Text="导出设置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemSettingImp" MinWidth="140" Text="导入设置" Padding="13,0" Margin="0,0,20,0" />
</Grid>
<Grid Height="35" Grid.Row="7" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
</Grid>
</Grid>
</local:MyCard>
@@ -1,33 +1,5 @@
Class PageSetupSystem
#Region "语言"
'Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
' AniControlEnabled -= 1
' '读取设置
' Select Case Lang
' Case "zh_CN"
' ComboLang.SelectedIndex = 0
' Case "zh_HK"
' ComboLang.SelectedIndex = 1
' Case "en_US"
' ComboLang.SelectedIndex = 2
' End Select
' CheckDebug.Checked = ReadReg("SystemDebugMode", "False")
' AniControlEnabled += 1
'End Sub
'Private Sub RefreshLang() Handles ComboLang.SelectionChanged
' If IsLoaded Then
' If Not ComboLang.IsLoaded Then Exit Sub
' Lang = CType(ComboLang.SelectedItem, MyComboBoxItem).Tag
' Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Url("Languages\" & Lang & ".xaml", UrlKind.Relative)}
' WriteReg("Lang", Lang)
' End If
'End Sub
#End Region
Private Shadows IsLoaded As Boolean = False
Private Sub PageSetupSystem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
@@ -35,7 +7,10 @@
'重复加载部分
PanBack.ScrollToHome()
#If Not BETA Then
#If BETA Then
PanDonate.Visibility = Visibility.Collapsed
#Else
PanDonate.Visibility = Visibility.Visible
ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)"
#End If
@@ -55,11 +30,14 @@
SliderDownloadThread.Value = Setup.Get("ToolDownloadThread")
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion")
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert")
'Mod 与整合包
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
ComboModLocalNameStyle.SelectedIndex = Setup.Get("ToolModLocalNameStyle")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
'Minecraft 更新提示
CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease")
CheckUpdateSnapshot.Checked = Setup.Get("ToolUpdateSnapshot")
@@ -87,9 +65,10 @@
Setup.Reset("ToolDownloadSpeed")
Setup.Reset("ToolDownloadVersion")
Setup.Reset("ToolDownloadTranslate")
Setup.Reset("ToolDownloadKeepModpack")
Setup.Reset("ToolDownloadIgnoreQuilt")
Setup.Reset("ToolDownloadCert")
Setup.Reset("ToolDownloadMod")
Setup.Reset("ToolModLocalNameStyle")
Setup.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese")
@@ -111,13 +90,13 @@
End Sub
'将控件改变路由到设置改变
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadKeepModpack.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadMod.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
@@ -165,26 +144,24 @@
End Sub
'自动更新
Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
Private Sub ComboSystemActivity_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If ComboSystemActivity.SelectedIndex = 2 Then
If MyMsgBox("若选择此项,即使在将来出现严重问题时,你也无法获取相关通知。" & vbCrLf &
"例如,如果发现某个版本游戏存在严重 Bug,你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
"一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemActivity.SelectedItem = e.RemovedItems(0)
End If
If ComboSystemActivity.SelectedIndex <> 2 Then Exit Sub
If MyMsgBox("若选择此项,即使在将来出现严重问题时,你也无法获取相关通知。" & vbCrLf &
"例如,如果发现某个版本游戏存在严重 Bug,你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
"一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemActivity.SelectedItem = e.RemovedItems(0)
End If
End Sub
Private Sub ComboSystemUpdate_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged
Private Sub ComboSystemUpdate_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If ComboSystemUpdate.SelectedIndex = 3 Then
If MyMsgBox("若选择此项,即使在启动器将来出现严重问题时,你也无法获取更新并获得修复。" & vbCrLf &
"例如,如果官方修改了登录方式,从而导致现有启动器无法登录,你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
"一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
End If
If ComboSystemUpdate.SelectedIndex <> 3 Then Exit Sub
If MyMsgBox("若选择此项,即使在启动器将来出现严重问题时,你也无法获取更新并获得修复。" & vbCrLf &
"例如,如果官方修改了登录方式,从而导致现有启动器无法登录,你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
"一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
End If
End Sub
Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click
@@ -212,4 +189,15 @@
End Try
End Function
#Region "导出 / 导入设置"
Private Sub BtnSystemSettingExp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingExp.Click
Hint("该功能尚在开发中!")
End Sub
Private Sub BtnSystemSettingImp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingImp.Click
Hint("该功能尚在开发中!")
End Sub
#End Region
End Class
@@ -242,6 +242,11 @@
<local:MyComboBoxItem Content="简单主页(作者:MFn233)" />
<local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
<local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" />
<local:MyComboBoxItem Content="PCL 更新日志(作者:Joker2184)" />
<local:MyComboBoxItem Content="PCL 新功能说明书(作者:WForst-Breeze)" />
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" />
</local:MyComboBox>
</Grid>
</StackPanel>
@@ -25,14 +25,15 @@
Next
End If
AniControlEnabled += 1
Reload() '#4826,在每次进入页面时都刷新一下
AniControlEnabled -= 1
'非重复加载部分
If IsLoaded Then Exit Sub
IsLoaded = True
AniControlEnabled += 1
SliderLoad()
Reload()
AniControlEnabled -= 1
#If BETA Then
PanLauncherHide.Visibility = Visibility.Visible
@@ -269,17 +270,16 @@
End Try
End Sub
'顶部栏
Private Sub BtnLogoChange_Click(sender As Object, e As EventArgs) Handles BtnLogoChange.Click
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片")
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp)|*.png;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then Exit Sub
Try
'拷贝文件
File.Delete(Path & "PCL\Logo.png")
CopyFile(FileName, Path & "PCL\Logo.png")
'设置当前显示
FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png")
FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png"
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("改变标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
@@ -296,7 +296,7 @@ Refresh:
'已有图片则不再选择
If File.Exists(Path & "PCL\Logo.png") Then
Try
FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png")
FrmMain.ImageTitleLogo.Source = Path & "PCL\Logo.png"
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("调整标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
@@ -315,7 +315,7 @@ Refresh:
Exit Sub
End If
'没有图片则要求选择
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片")
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.webp)|*.png;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
@@ -364,27 +364,28 @@ Refresh:
End Sub
Private Sub BtnMusicClear_Click(sender As Object, e As EventArgs) Handles BtnMusicClear.Click
If MyMsgBox("即将删除背景音乐文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
RunInThread(Sub()
Hint("正在删除背景音乐……")
'停止播放音乐
MusicNAudio = Nothing
MusicWaitingList = New List(Of String)
MusicAllList = New List(Of String)
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(Path & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Finish)
Catch ex As Exception
Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
End Try
Try
Directory.CreateDirectory(Path & "PCL\Musics")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Hint("正在删除背景音乐……")
'停止播放音乐
MusicNAudio = Nothing
MusicWaitingList = New List(Of String)
MusicAllList = New List(Of String)
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(Path & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Finish)
Catch ex As Exception
Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
End Try
Try
Directory.CreateDirectory(Path & "PCL\Musics")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox)
End Try
End Sub)
End If
End Sub
Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change
@@ -427,9 +428,9 @@ Refresh:
RadioLauncherTheme5Gray.Opacity -= 0.23
RadioLauncherTheme5.Opacity += 0.23
AniStart({
AaOpacity(RadioLauncherTheme5Gray, 1, 1000),
AaOpacity(RadioLauncherTheme5, -1, 1000)
}, "ThemeUnlock")
AaOpacity(RadioLauncherTheme5Gray, 1, 1000 * AniSpeed),
AaOpacity(RadioLauncherTheme5, -1, 1000 * AniSpeed)
}, "ThemeUnlock")
If RadioLauncherTheme5Gray.Opacity < 0.08 Then
ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!")
AniStop("ThemeUnlock")
@@ -437,7 +438,7 @@ Refresh:
End If
End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse LabLauncherTheme11Click.ToolTip.ToString.Contains("点击") Then
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then
If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
@@ -450,7 +451,7 @@ Refresh:
End If
End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
OpenWebsite("https://afdian.net/a/LTCat")
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
PageOtherLeft.TryFeedback()
@@ -661,25 +662,17 @@ Refresh:
#End Region
'公开预览版
'赞助
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.net/a/LTCat")
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
'滑动条
Private Sub SliderLoad()
SliderMusicVolume.GetHintText = Function(Value As Integer)
Return Math.Ceiling(Value * 0.1) & "%"
End Function
SliderLauncherOpacity.GetHintText = Function(Value As Integer)
Return Math.Round(40 + Value * 0.1) & "%"
End Function
SliderLauncherHue.GetHintText = Function(Value As Integer)
Return Value & "°"
End Function
SliderLauncherSat.GetHintText = Function(Value As Integer)
Return Value & "%"
End Function
SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%"
SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherSat.GetHintText = Function(v) v & "%"
SliderLauncherDelta.GetHintText = Function(Value As Integer)
If Value > 90 Then
Return "+" & (Value - 90)
@@ -698,12 +691,8 @@ Refresh:
Return Value - 20
End If
End Function
SliderBackgroundOpacity.GetHintText = Function(Value As Integer)
Return Math.Round(Value * 0.1) & "%"
End Function
SliderBackgroundBlur.GetHintText = Function(Value As Integer)
Return Value & " 像素"
End Function
SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%"
SliderBackgroundBlur.GetHintText = Function(v) v & " 像素"
End Sub
End Class
@@ -60,11 +60,9 @@ Public Class PageSpeedLeft
End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try
SyncLock LoaderTaskbarLock
For Each Loader In LoaderTaskbar.ToList
TaskRefresh(Loader)
Next
End SyncLock
For Each Loader In LoaderTaskbar.ToList
TaskRefresh(Loader)
Next
Catch ex As Exception
Log(ex, "下载管理右栏监视出错", LogLevel.Feedback)
End Try
@@ -94,15 +92,12 @@ Public Class PageSpeedLeft
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = GetExceptionDetail(Loader.Error)
AddHandler Tb.MouseLeftButtonDown, Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
Hint("已复制错误详情!", HintType.Finish)
End Sub
AddHandler Tb.MouseLeftButtonDown,
Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
Hint("已复制错误详情!", HintType.Finish)
End Sub
Card.Children.Add(Tb)
''删除取消按钮
'For Each Element As FrameworkElement In CType(Card.Parent, Panel).Children
' If Element.Name = "BtnCancel" Then AniDispose(CType(Element, MyIconButton), True)
'Next
#End Region
Case LoadState.Finished
#Region "完成,销毁卡片并返回"
@@ -198,11 +193,8 @@ Public Class PageSpeedLeft
AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 由于下载管理卡片关闭,{Loader.Name} 已移出任务列表")
End SyncLock
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 关闭下载管理卡片:{Loader.Name},且移出任务列表")
RunInThread(Sub() Loader.Abort())
End Sub
'如果已经失败,再刷新一次,修改成失败的控件
@@ -61,7 +61,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally
AniControlEnabled -= 1
End Try
@@ -96,7 +96,7 @@
Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try
If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '无需 Else,还没加载刷个鬼的新
If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新
ItemMod.Checked = True
Hint("正在刷新……", Log:=False)
End Sub
@@ -23,8 +23,15 @@
<local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid>
</local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,15" Title=" " MinHeight="40">
<StackPanel Margin="20,38,18,18" Name="PanList" VerticalAlignment="Top" />
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
<StackPanel x:Name="PanFilter" Margin="15,13,0,0" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" Height="28">
<local:MyRadioButton Tag="0" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="全部" x:Name="BtnFilterAll" Checked="True" />
<local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
<local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
<local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
<local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
</StackPanel>
<StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
@@ -8,7 +8,7 @@
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1
SelectedMods.Clear()
RefreshList()
ReloadModList()
ChangeAllSelected(False)
AniControlEnabled -= 1
@@ -16,6 +16,11 @@
If IsLoad Then Exit Sub
IsLoad = True
'调整按钮边距(这玩意儿没法从 XAML 改)
For Each Btn As MyRadioButton In PanFilter.Children
Btn.LabText.Margin = New Thickness(-2, 0, 8, 0)
Next
#If DEBUG Then
BtnManageCheck.Visibility = Visibility.Visible
#End If
@@ -24,9 +29,10 @@
''' <summary>
''' 刷新 Mod 列表。
''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False)
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome()
SearchBox.Text = ""
End If
@@ -37,9 +43,12 @@
End Sub
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McModLoader.State = LoadState.Failed Then
LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
LoaderRun(LoaderFolderRunType.ForceRun)
End If
End Sub
Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean
Return LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", Type)
End Function
#End Region
@@ -53,10 +62,9 @@
''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary>
Private Sub LoadUIFromLoaderOutput()
Dim Mods As List(Of McMod) = McModLoader.Output
Try
'判断应该显示哪一个页面
If Mods.Any() Then
If McModLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed
Else
@@ -64,13 +72,15 @@
PanBack.Visibility = Visibility.Collapsed
Exit Sub
End If
'输出结果
'修改缓存
ModItems.Clear()
For Each ModEntity As McMod In Mods
For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next
'显示结果
Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
RefreshResult(Mods)
RefreshUI()
Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback)
End Try
@@ -114,7 +124,7 @@
ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2)
AddHandler BtnED.Click, AddressOf ED_Click
If sender.Entry.State = McMod.McModState.Unavaliable Then
If sender.Entry.State = McMod.McModState.Unavailable Then
sender.Buttons = {BtnCont, BtnOpen, BtnDelete}
Else
sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
@@ -122,38 +132,134 @@
End Sub
''' <summary>
''' 刷新结果显示。
''' 刷新整个 UI。
''' </summary>
Private Sub RefreshResult(Mods As List(Of McMod))
PanList.Children.Clear()
For Each TargetMod In Mods
PanList.Children.Add(ModItems(TargetMod.RawFileName))
Next
RefreshTitle()
End Sub
''' <summary>
''' 刷新卡片标题。
''' </summary>
Private Sub RefreshTitle()
Dim Mods = PanList.Children.Cast(Of MyLocalModItem).Select(Function(i) i.Entry).ToList
Dim Counter = {0, 0, 0}
For Each ModEntity As McMod In Mods
Counter(ModEntity.State) += 1
Next
Dim TypeList As New List(Of String)
If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled))
If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable))
If Counter(McMod.McModState.Fine) > 0 Then TypeList.Insert(0, If(TypeList.Any, "启用 ", "") & Counter(McMod.McModState.Fine))
If Not IsSearching Then
PanListBack.Title = "Mod 列表 (" & Join(TypeList, ",") & ")"
ElseIf TypeList.Any() Then
PanListBack.Title = "搜索结果 (" & Join(TypeList, ",") & ")"
Public Sub RefreshUI()
If PanList Is Nothing Then Exit Sub
Dim ShowMods = GetShowingMods(True).ToList()
'重新列出列表
AniControlEnabled += 1
If ShowMods.Any() Then
PanList.Visibility = Visibility.Visible
PanList.Children.Clear()
For Each TargetMod In ShowMods
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
PanList.Children.Add(Item)
Next
Else
PanListBack.Title = "无搜索结果"
PanList.Visibility = Visibility.Collapsed
End If
PanList.Visibility = If(Mods.Any(), Visibility.Visible, Visibility.Collapsed)
AniControlEnabled -= 1
SelectedMods = SelectedMods.Where(Function(m) ShowMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
RefreshBars()
End Sub
''' <summary>
''' 刷新顶栏和底栏显示。
''' </summary>
Public Sub RefreshBars()
'-----------------
' 顶部栏
'-----------------
'计数
Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0
Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0
Dim UnavalialeCount As Integer = 0
For Each ModItem In GetShowingMods(False)
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.State.Equals(McMod.McModState.Unavailable) Then UnavalialeCount += 1
Next
'显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterEnabled.Text = $"启用 ({EnabledCount})"
BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterError.Text = $"错误 ({UnavalialeCount})"
BtnFilterError.Visibility = If(Filter = FilterType.Unavailable OrElse UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
'-----------------
' 底部栏
'-----------------
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
PanListBack.Margin = New Thickness(0, 0, 0, If(Selected, 95, 15))
If Selected Then
'仅在数量增加时播放出现/跳跃动画
If BottomBarShownCount >= NewCount Then
BottomBarShownCount = NewCount
Return
Else
BottomBarShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
'不重复播放隐藏动画
If BottomBarShownCount = 0 Then Return
BottomBarShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
BottomBarShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
End Sub
Private BottomBarShownCount As Integer = 0
#End Region
#Region "管理"
@@ -192,11 +298,7 @@
''' 全选。
''' </summary>
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
If SelectedMods.Count < PanList.Children.Count Then
ChangeAllSelected(True)
Else
ChangeAllSelected(False)
End If
ChangeAllSelected(SelectedMods.Count < GetShowingMods(True).Count)
End Sub
''' <summary>
@@ -223,91 +325,19 @@
Else
SelectedMods.Remove(SelectedKey)
End If
'更新下边栏 UI
RefreshBottomBar()
End Sub
'改变下边栏状态
Private ShownCount As Integer = 0
Private Sub RefreshBottomBar()
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
If Selected Then
'仅在数量增加时播放出现/跳跃动画
If ShownCount >= NewCount Then
ShownCount = NewCount
Return
Else
ShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
'不重复播放隐藏动画
If ShownCount = 0 Then Return
ShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
ShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
RefreshBars()
End Sub
'切换所有项的选择状态
Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1
SelectedMods.Clear()
For Each Item As MyLocalModItem In PanList.Children
For Each Item As MyLocalModItem In GetShowingMods(True).Where(Function(m) ModItems.ContainsKey(m.RawFileName)).Select(Function(m) ModItems(m.RawFileName))
Item.Checked = Value
If Value Then SelectedMods.Add(Item.Entry.RawFileName)
Next
AniControlEnabled -= 1
'更新下边栏 UI
RefreshBottomBar()
RefreshBars()
End Sub
Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit
Dim CacheAniControlEnabled = AniControlEnabled
@@ -321,6 +351,75 @@
#End Region
#Region "筛选"
Private _Filter As FilterType = FilterType.All
Private Property Filter As FilterType
Get
Return _Filter
End Get
Set(value As FilterType)
If _Filter = value Then Return
_Filter = value
Select Case value
Case FilterType.All
BtnFilterAll.Checked = True
Case FilterType.Enabled
BtnFilterEnabled.Checked = True
Case FilterType.Disabled
BtnFilterDisabled.Checked = True
Case FilterType.CanUpdate
BtnFilterCanUpdate.Checked = True
Case Else
BtnFilterError.Checked = True
End Select
RefreshUI()
End Set
End Property
Private Enum FilterType As Integer
All = 0
Enabled = 1
Disabled = 2
CanUpdate = 3
Unavailable = 4
End Enum
''' <summary>
''' 获取所有应该显示在 UI 中的 Mod。
''' </summary>
Private Function GetShowingMods(ApplyFilter As Boolean) As IEnumerable(Of McMod)
If McModLoader.Output Is Nothing Then Return New List(Of McMod)
Return If(IsSearching, SearchResult, McModLoader.Output).Where(Function(m) Not ApplyFilter OrElse CanPassFilter(m))
End Function
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As McMod) As Boolean
Select Case Filter
Case FilterType.All
Return True
Case FilterType.Enabled
Return CheckingMod.State = McMod.McModState.Fine
Case FilterType.Disabled
Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate
Return CheckingMod.CanUpdate
Case FilterType.Unavailable
Return CheckingMod.State = McMod.McModState.Unavailable
Case Else
Return False
End Select
End Function
'点击筛选项触发的改变
Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check, BtnFilterError.Check
Filter = sender.Tag
RefreshUI()
End Sub
#End Region
#Region "下边栏"
'启用 / 禁用
@@ -362,7 +461,7 @@
FileSystem.Rename(ModEntity.Path, NewPath)
Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback)
RefreshList(True)
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})")
@@ -371,9 +470,16 @@
'更改 Loader 中的列表
Dim NewModEntity As New McMod(NewPath)
NewModEntity.FromJson(ModEntity.ToJson)
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
If McModLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
End If
If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862
Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity)
SearchResult.Remove(ModEntity)
SearchResult.Insert(IndexOfResult, NewModEntity)
End If
'更改 UI 中的列表
Dim NewItem As MyLocalModItem = McModListItem(NewModEntity)
ModItems(ModEntity.RawFileName) = NewItem
@@ -382,18 +488,21 @@
PanList.Children.RemoveAt(IndexOfUi)
PanList.Children.Insert(IndexOfUi, NewItem)
Next
RefreshTitle() '改变数量显示
If Not IsSuccessful Then
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
If IsSuccessful Then
RefreshBars()
Else
RefreshBottomBar()
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
ReloadModList(True)
End If
LoaderRun(LoaderFolderRunType.UpdateOnly)
End Sub
'更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate))
Dim UpdateList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate).ToList()
If Not UpdateList.Any() Then Return
UpdateMods(UpdateList)
ChangeAllSelected(False)
End Sub
''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
@@ -476,7 +585,14 @@
'结果提示
Select Case Loader.State
Case LoadState.Finished
Hint(If(FinishedFileNames.Count > 1, $"已成功更新 {FinishedFileNames.Count} 个 Mod!", $"已成功更新:{FinishedFileNames.Single}"), HintType.Finish)
Select Case FinishedFileNames.Count
Case 0 '一般是由于 Mod 文件被占用,然后玩家主动取消
Log($"[Mod] 没有 Mod 被成功更新")
Case 1
Hint($"已成功更新 {FinishedFileNames.Single}!", HintType.Finish)
Case Else
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod!", HintType.Finish)
End Select
Case LoadState.Failed
Hint("Mod 更新失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
@@ -484,6 +600,7 @@
Case Else
Exit Sub
End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除:{PathMods}")
UpdatingVersions.Remove(PathMods)
'清理缓存
RunInNewThread(
@@ -498,13 +615,13 @@
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod")
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod:{PathMods}")
UpdatingVersions.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
RefreshList(True)
ReloadModList(True)
Catch ex As Exception
Log(ex, "初始化 Mod 更新失败")
End Try
@@ -513,6 +630,7 @@
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
ChangeAllSelected(False)
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try
@@ -538,7 +656,7 @@
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
RefreshList(True)
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
@@ -548,18 +666,19 @@
SelectedMods.Remove(ModEntity.RawFileName)
'更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.RawFileName)
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi)
Next
RefreshTitle()
RefreshBars()
If Not IsSuccessful Then
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
ReloadModList(True)
ElseIf PanList.Children.Count = 0 Then
RefreshList(True) '删除了全部文件
ReloadModList(True) '删除了全部文件
Else
RefreshBottomBar()
RefreshBars()
End If
'显示结果提示
If Not IsSuccessful Then Exit Sub
@@ -578,11 +697,12 @@
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
RefreshList(True)
ReloadModList(True)
Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback)
RefreshList(True)
ReloadModList(True)
End Try
LoaderRun(LoaderFolderRunType.UpdateOnly)
End Sub
'取消选择
@@ -600,7 +720,7 @@
Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息
If ModEntry.State = McMod.McModState.Unavaliable Then
If ModEntry.State = McMod.McModState.Unavailable Then
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息:" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败")
Return
End If
@@ -694,8 +814,8 @@
Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get
End Property
Private SearchResult As List(Of McMod)
Public Sub SearchRun() Handles SearchBox.TextChanged
ChangeAllSelected(False)
If IsSearching Then
'构造请求
Dim QueryList As New List(Of SearchEntry(Of McMod))
@@ -718,12 +838,9 @@
QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource})
Next
'进行搜索
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35)
RefreshResult(SearchResult.Select(Function(r) r.Item).ToList)
Else
'退出搜索状态
RefreshResult(McModLoader.Output)
SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
End If
RefreshUI()
End Sub
#End Region
@@ -283,17 +283,23 @@
'补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'忽略文件检查提示
If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then
If Setup.Get("LaunchAdvanceAssets") Then
Hint("请先关闭 [设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Info)
Else
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Info)
End If
Exit Sub
End If
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中,请稍候!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
Hint("正在处理中,请稍候!", HintType.Critical)
Exit Sub
Next
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload))
Loader.OnStateChanged =
Sub()
Select Case Loader.State
@@ -282,6 +282,11 @@
If Setup.Get("VersionRamType", Version:=Version) = 2 Then
Return PageSetupLaunch.GetRam(Version, True, Is32BitJava)
End If
'------------------------------------------
' 修改下方代码时需要一并修改 PageSetupLaunch
'------------------------------------------
'使用当前版本的设置
Dim RamGive As Double
If Setup.Get("VersionRamType", Version:=Version) = 0 Then
@@ -297,19 +302,19 @@
'可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.4 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 100
RamTarget2 = 3 + ModCount / 60
RamTarget3 = 6 + ModCount / 30
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
'OptiFine 版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 3
RamTarget3 = 6
RamTarget3 = 5
Else
'普通版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 2.5
RamTarget3 = 4
@@ -317,27 +322,23 @@
Dim RamDelta As Double
'预分配内存,阶段一,0 ~ T1,100%
RamDelta = RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 1, RamDelta)
RamAvailable -= RamDelta / 1 + 0.1
RamGive += Math.Min(RamAvailable, RamDelta)
RamAvailable -= RamDelta
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段二,T1 ~ T2,80%
'预分配内存,阶段二,T1 ~ T2,70%
RamDelta = RamTarget2 - RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 0.8, RamDelta)
RamAvailable -= RamDelta / 0.8 + 0.1
RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
RamAvailable -= RamDelta / 0.7
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段三,T2 ~ T3,60%
'预分配内存,阶段三,T2 ~ T3,40%
RamDelta = RamTarget3 - RamTarget2
RamAvailable = Math.Max(0, RamAvailable - 0.2)
RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
RamAvailable -= RamDelta / 0.6 + 0.2
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段四,T3 ~ T3 * 2,40%
RamDelta = RamTarget3
RamAvailable = Math.Max(0, RamAvailable - 0.3)
RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
RamAvailable -= RamDelta / 0.4 + 0.3
RamAvailable -= RamDelta / 0.4
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段四,T3 ~ T3 * 2,15%
RamDelta = RamTarget3
RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
RamAvailable -= RamDelta / 0.15
If RamAvailable < 0.1 Then GoTo PreFin
PreFin:
'不低于最低值
@@ -351,8 +352,6 @@ PreFin:
RamGive = (Value - 12) * 0.5 + 1.5
ElseIf Value <= 33 Then
RamGive = (Value - 25) * 1 + 8
ElseIf Value <= 41 Then
RamGive = (Value - 33) * 2 + 16
Else
RamGive = (Value - 33) * 2 + 16
End If
@@ -486,6 +485,23 @@ PreFin:
#End Region
#Region "其他设置"
'版本隔离警告
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档,不建议修改这项设置!",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
AniControlEnabled += 1
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
AniControlEnabled -= 1
End If
End Sub
#End Region
#Region "高级设置"
Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged
@@ -38,7 +38,7 @@
<DefineDebug>false</DefineDebug>
<DefineTrace>false</DefineTrace>
<IncrementalBuild>true</IncrementalBuild>
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -55,7 +55,7 @@
<DefineTrace>false</DefineTrace>
<IncrementalBuild>false</IncrementalBuild>
<Optimize>true</Optimize>
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -100,7 +100,7 @@
<SignManifests>false</SignManifests>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -111,7 +111,7 @@
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -129,7 +129,7 @@
</AssemblyOriginatorKeyFile>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DefineConstants>RELEASE,BY_UPDATE</DefineConstants>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
@@ -140,6 +140,11 @@
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<ItemGroup>
<Reference Include="Imazen.WebP, Version=10.0.1.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>Resources\Imazen.WebP.dll</HintPath>
<Private>False</Private>
</Reference>
<Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<Private>False</Private>
@@ -160,6 +165,7 @@
<Reference Include="System.Management" />
<Reference Include="System.Net.Http" />
<Reference Include="System.Numerics" />
<Reference Include="System.ServiceModel" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System" />
@@ -180,6 +186,7 @@
<Compile Include="Controls\MyComboBox.vb" />
<Compile Include="Controls\MyComboBoxItem.vb" />
<Compile Include="Controls\MyCard.vb" />
<Compile Include="Controls\MyImage.vb" />
<Compile Include="Controls\MyPageRight.vb" />
<Compile Include="Controls\MyPageLeft.vb" />
<Compile Include="Controls\MyIconTextButton.xaml.vb">
@@ -250,8 +257,8 @@
<Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb">
<DependentUpon>PageDownloadPack.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLaunch\FormLoginOAuth.xaml.vb">
<DependentUpon>FormLoginOAuth.xaml</DependentUpon>
<Compile Include="Pages\PageLaunch\MyMsgLogin.xaml.vb">
<DependentUpon>MyMsgLogin.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLaunch\PageLoginAuth.xaml.vb">
<DependentUpon>PageLoginAuth.xaml</DependentUpon>
@@ -505,9 +512,9 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageLaunch\FormLoginOAuth.xaml">
<SubType>Designer</SubType>
<Page Include="Pages\PageLaunch\MyMsgLogin.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageLaunch\PageLoginAuth.xaml">
<Generator>MSBuild:Compile</Generator>
@@ -876,32 +883,11 @@
<Resource Include="Images\Heads\bangbang93.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\DoodleHuang.png" />
<Resource Include="Images\Heads\wiki.png" />
</ItemGroup>
<ItemGroup>
<WCFMetadata Include="Connected Services\" />
</ItemGroup>
<ItemGroup>
<COMReference Include="NATUPNPLib">
<Guid>{1C565858-F302-471E-B409-F180AA4ABEC6}</Guid>
<VersionMajor>1</VersionMajor>
<VersionMinor>0</VersionMinor>
<Lcid>0</Lcid>
<WrapperTool>tlbimp</WrapperTool>
<Isolated>False</Isolated>
<EmbedInteropTypes>True</EmbedInteropTypes>
</COMReference>
<COMReference Include="NetFwTypeLib">
<Guid>{58FBCF7C-E7A9-467C-80B3-FC65E8FCCA08}</Guid>
<VersionMajor>1</VersionMajor>
<VersionMinor>0</VersionMinor>
<Lcid>0</Lcid>
<WrapperTool>tlbimp</WrapperTool>
<Isolated>False</Isolated>
<EmbedInteropTypes>True</EmbedInteropTypes>
</COMReference>
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Blocks\OptiFabric.png" />
</ItemGroup>
@@ -922,7 +908,7 @@
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Icons\Disabled.png" />
<Resource Include="Images\Icons\Unavaliable.png" />
<Resource Include="Images\Icons\Unavailable.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\MCBBS.png" />
@@ -933,5 +919,12 @@
<ItemGroup>
<Resource Include="Images\Blocks\NeoForge.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\z0z0r4.png" />
</ItemGroup>
<ItemGroup>
<None Include="Resources\Imazen.WebP.dll" />
<None Include="Resources\libwebp64.dll" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
+157 -156
View File
@@ -4,311 +4,309 @@
你也可以使用 Ctrl + F 快速查找。例如,若需要改变文本颜色,则搜索 “颜色” 即可。 -->
<local:MyCard Title="纯文本" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="每个 local:MyCard 代表一张卡片,你可以添加、删除格式类似的 MyCard 来添加多个卡片。每个 TextBlock 代表一段文本,你可以在 Text 属性中书写任何你想写的内容,也可以自行添加更多的 TextBlock。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" FontSize="11"
Text="你可以通过添加、删除属性修改样式,例如上一行的 FontSize 就会将字号改为 11 号。" />
<TextBlock TextWrapping="Wrap" Margin="20,5,20,0" Foreground="#8C7721"
Text="它还有许多可以调整的属性:上一行的 Margin 调整了边距,Foreground 则会让文字变色。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="卡片、提示条" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<local:MyHint Text="local:MyHint 代表提示条,它默认是警告样式。" />
<local:MyHint Margin="0,8,0,2" IsWarn="False"
<StackPanel Margin="25,40,23,15">
<local:MyHint Text="local:MyHint 代表提示条,它默认是警告样式。" />
<local:MyHint Margin="0,8,0,2" IsWarn="False"
Text="将提示条的 IsWarn 属性改为 False 即可改为提示样式。&#xA;使用左边的那堆字符可以在任意地方手动换行,如果需要使用等号、引号等特殊字符,可以自行百度 XAML 转义字符。" />
<TextBlock TextWrapping="Wrap" Margin="0,6,0,0"
Text="卡片(local:MyCard)的 Title 属性决定了它的标题。&#xA;为卡片添加 CanSwap 属性让它可以被折叠,True 代表是,False 代表否。在此基础上,再使用 IsSwaped 属性调整它是否默认被折叠。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="长宽属性、图片" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" Width="320" HorizontalAlignment="Right"
Text="任意项目都可以添加 Width 与 Height 属性来控制宽高。HorizontalAlignment 属性可以控制对齐:Center 代表居中,Right 代表居右,例如这段文本就被居右了。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,6"
Text="Image 代表图片,你需要在它的 Source 属性中填写一个网址或文件路径,它会从该处获取图片并显示。通常需要使用 Height 限制它的高度。" />
<Image Height="50" HorizontalAlignment="Center" Source="https://zh.minecraft.wiki/images/Grass_Block_JE7_BE6.png?bf67e" />
</StackPanel>
Text="local:MyImage 代表图片,你需要在它的 Source 属性中填写一个网址或文件路径,它会从该处获取图片并显示。通常需要使用 Height 限制它的高度。" />
<local:MyImage Height="50" HorizontalAlignment="Center" Source="https://www.baidu.com/img/flexible/logo/pc/result.png" />
</StackPanel>
</local:MyCard>
<local:MyCard Title="按钮" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="添加 local:MyButton 即可新建一个按钮。你需要限定它的尺寸与位置,并通过 Padding 属性进一步控制它的内边距。" />
<local:MyButton Margin="0,4,0,10" Height="35" HorizontalAlignment="Left" Padding="25,0,25,0"
<local:MyButton Margin="0,4,0,10" Height="35" HorizontalAlignment="Left" Padding="25,0,25,0"
Text="这是一个按钮!一个按钮!" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="你可以修改 ColorType 属性来调整按钮配色:Highlight 代表当前主题色,Red 代表红色。ToolTip 属性还可以让你在鼠标悬浮在上面的时候显示提示文本。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35" ColorType="Highlight"
<local:MyButton Margin="0,4,0,10" Width="250" Height="35" ColorType="Highlight"
Text="把鼠标停在这里别动……" ToolTip="……就能看到这句话!" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="local:MyTextButton 是没有边框的 “纯文本按钮”,其作用与 local:MyButton 一致。" />
<local:MyTextButton Margin="0,8,0,10" HorizontalAlignment="Center"
<local:MyTextButton Margin="0,8,0,10" HorizontalAlignment="Center"
Text="一个精简版的文本按钮" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="按钮可以做到很多事,具体将在 “事件” 部分介绍。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 1:打开网页、弹出窗口" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="将按钮的 EventType 属性设为 打开网页,然后在 EventData 属性中写入网址,即可通过点击按钮打开网页。" />
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开 Minecraft Wiki" EventType="打开网页" EventData="https://zh.minecraft.wiki/" />
<TextBlock TextWrapping="Wrap" Margin="0,10,0,10"
Text="或者将 EventType 属性改为 弹出窗口,然后在 EventData 属性中写入弹窗的标题与内容……" />
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="显示一个弹窗" EventType="弹出窗口" EventData="这是标题|标题与内容以竖线间隔。\n你也可以直接在其中换行。" />
<TextBlock TextWrapping="Wrap" Margin="0,10,0,0"
Text="local:MyTextButton 同样可以设置 EventType 与 EventData 让它具有特定功能。" />
<local:MyTextButton Margin="0,8,0,0" HorizontalAlignment="Center"
<local:MyTextButton Margin="0,8,0,0" HorizontalAlignment="Center"
Text="点击打开知乎" EventType="打开网页" EventData="https://www.zhihu.com/" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 2:启动游戏" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="将 EventType 设置为 启动游戏,EventData 设置为具体的游戏版本,即可通过点击按钮启动游戏。如果当前游戏文件夹没有该版本,则无法启动。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动 Minecraft 1.12.2" EventType="启动游戏" EventData="1.12.2" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" />
<local:MyButton Margin="0,4,0,0" Width="250" Height="35"
<local:MyButton Margin="0,4,0,0" Width="250" Height="35"
Text="启动 1.20.1 并进入 Hypixel" EventType="启动游戏" EventData="1.20.1|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 中填写 \current,表示启动当前被选中的游戏版本,同样可以在后面填写服务器 IP。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动当前选中版本并进入 Hypixel" EventType="启动游戏" EventData="\current|mc.hypixel.net" ToolTip="启动当前版本" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 3:打开文件" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="将 EventType 设置为 打开文件,EventData 设置为文件路径,即可点击打开特定文件或启动程序。" />
<local:MyButton Margin="0,4,0,8" Width="200" Height="35"
<local:MyButton Margin="0,4,0,8" Width="200" Height="35"
Text="打开记事本" EventType="打开文件" EventData="notepad.exe" />
<TextBlock TextWrapping="Wrap" Margin="0,4,0,0"
Text="如果能在 PCL 文件夹中找到该文件,则会优先打开 PCL 文件夹中的文件。当然,你可以使用例如 C:\ 开头的绝对路径。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="此外,PCL 会将文件中的 “花括号 path” 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" />
<local:MyButton Margin="0,4,0,10" Width="200" Height="35"
<local:MyButton Margin="0,4,0,10" Width="200" Height="35"
Text="打开 PCL 日志" EventType="打开文件" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="就像为游戏指定服务器 IP 一样,你也可以在 EventData 的竖线后为程序添加启动参数。" />
<local:MyButton Margin="0,4,0,0" Width="200" Height="35"
<local:MyButton Margin="0,4,0,0" Width="200" Height="35"
Text="定位游戏启动脚本" EventType="打开文件" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xA;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 4:其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock Margin="0,4,0,6" FontWeight="Bold"
<StackPanel Margin="25,40,23,15">
<TextBlock Margin="0,4,0,6" FontWeight="Bold"
Text="EventType 共有以下种类:" />
<TextBlock Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 打开网页、启动游戏、打开文件:已在上方的卡片中介绍" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="查看 PCL 源代码" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/blob/main/Plain%20Craft%20Launcher%202/FormMain.xaml.vb"/>
<TextBlock Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 今日人品、清理垃圾、内存优化、安装整合包:触发对应功能" />
<TextBlock Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 复制文本:将 EventData 中的内容复制到剪贴板" />
<TextBlock Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 刷新主页:点击重新加载主页。如果主页文件为联网更新,这会重新下载主页内容" />
<TextBlock Margin="0,0,0,4"
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
<TextBlock Margin="0,0,0,4"
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件&#xa;      EventData 中也能可选地指定文件名或目标文件夹,格式为:链接|文件名|文件夹" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
<TextBlock Margin="0,4,0,4"
<TextBlock Margin="0,4,0,4"
Text="· 打开帮助:跳转到 EventData 对应的帮助文件(输入相对 Help 文件夹的路径)"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/>
<TextBlock Margin="0,4,0,4"
Text="· 切换页面:强制切换到 PCL 的某一页面(尝试切换到不太对头的页面会出现不可预知的 Bug,使用时请谨慎)&#xa;      EventData 为 页面种类|次要页面种类(PageType|PageSubType,例如 1|1)&#xa;      点击上方的 查看 PCL 源代码 按钮,在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
<TextBlock Margin="0,4,0,4"
Text="· 切换页面:强制切换到 PCL 的某一页面(尝试切换到不太对头的页面会出现不可预知的 Bug)&#xa;      EventData 为 页面种类|次要页面种类(PageType|PageSubType,例如 1|1)&#xa;      点击上方的 查看 PCL 源代码 按钮,在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到下载页面" EventType="切换页面" EventData="1|1"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到启动器设置" EventType="切换页面" EventData="3|2"/>
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="StackPanel 横向布局" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="你需要使用 StackPanel 在一行里塞下多个按钮。你可以仅在这个教学卡片的基础上稍作调整,来实现自己的按钮布局。" />
<!-- 这是第一行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center">
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" ColorType="Highlight"
<!-- 这是第一行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center">
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" ColorType="Highlight"
Text="打开 B 站" EventType="打开网页" EventData="https://www.bilibili.com/" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
</StackPanel>
<!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" ColorType="Red"
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</StackPanel>
<!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" ColorType="Red"
Text="复制召唤命令" EventType="复制文本" EventData="/execute as @a at @s run summon Creeper ~ ~2 ~" ToolTip="这条 Minecraft 命令会在每个玩家头顶召唤一只苦力怕!" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="内存优化" EventType="内存优化" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
</StackPanel>
</StackPanel>
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="列表项 1:基础" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="你也可以使用列表项 “local:MyListItem” 来替代按钮,其使用方式与按钮类似。" />
<local:MyListItem Margin="-5,2,-5,8"
Logo="https://www.baidu.com/favicon.ico" Title="百度" Info="百度一下,你就知道!"
EventType="打开网页" EventData="https://www.baidu.com/" Type="Clickable" />
<local:MyListItem Margin="-5,2,-5,8"
Logo="https://www.baidu.com/favicon.ico" Title="百度" Info="百度一下,你就知道!"
EventType="打开网页" EventData="https://www.baidu.com/" Type="Clickable" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="Logo 属性为列表项的图标,指定的可以是链接也可以是文件路径;Title 是大标题,Info 是可选的小标题(详细信息);Type 如果省略,该列表项则单纯只展示信息,仅当 Type 为 Clickable 才能触发点击效果。"/>
<local:MyListItem Margin="-5,2,-5,8"
<local:MyListItem Margin="-5,2,-5,8"
Logo="pack://application:,,,/images/Blocks/Grass.png"
EventType="打开帮助" EventData="帮助/自定义帮助.json" Type="Clickable" />
EventType="打开帮助" EventData="帮助/自定义帮助.json" Type="Clickable" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="EventType、EventData 与按钮几乎一致,唯一不同的是,列表项不支持联网加载帮助文件。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="列表项 2:内置图片" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="PCL 内置了一些 Minecraft 方块与物品图片,可以直接使用。"/>
<StackPanel Orientation="Horizontal" Margin="10,8,0,15" Height="30">
<!-- 命令方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 圆石 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/>
<!-- 金块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<!-- 草方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<!-- 草径 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<!-- 铁砧 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
<!-- 红石块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/>
<!-- 红石灯(亮) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/>
<!-- 红石灯(灭) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/>
<!-- 鸡蛋 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/>
<!-- 布料(Fabric 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/>
<!-- 狐狸(NeoForge 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/NeoForge.png"/>
</StackPanel>
<StackPanel Orientation="Horizontal" Margin="10,8,0,15" Height="30">
<!-- 命令方块 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 圆石 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/>
<!-- 金块 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<!-- 草方块 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<!-- 草径 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<!-- 铁砧 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
<!-- 红石块 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/>
<!-- 红石灯(亮) -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/>
<!-- 红石灯(灭) -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/>
<!-- 鸡蛋 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/>
<!-- 布料(Fabric 图标) -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/>
<!-- 狐狸(NeoForge 图标) -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/NeoForge.png"/>
</StackPanel>
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="使用时,将上方对应行的 Source 复制到 MyListItem 的 Logo 属性处即可。"/>
<local:MyListItem Margin="-5,0,-5,8"
<local:MyListItem Margin="-5,0,-5,8"
Logo="pack://application:,,,/images/Blocks/CommandBlock.png"
Title="清理垃圾" Info="使用内置的命令方块图片作为 Logo" EventType="清理垃圾" Type="Clickable" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="主题色" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,15"
Text="你可以用类似 {DynamicResource ColorBrush5} 的格式使用 PCL 当前的主题颜色,修改末尾的数字编号以改变颜色浓度。" />
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="8,4">
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="8,4">
<TextBlock TextWrapping="Wrap" Text=" 浓度 1 " Margin="5,0" Background="{DynamicResource ColorBrush1}" Foreground="#FFFFFF" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 2 " Margin="5,0" Background="{DynamicResource ColorBrush2}" Foreground="#FFFFFF" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 3 " Margin="5,0" Background="{DynamicResource ColorBrush3}" Foreground="#FFFFFF" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 4 " Margin="5,0" Background="{DynamicResource ColorBrush4}" Foreground="#FFFFFF" />
</StackPanel>
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="8,4">
</StackPanel>
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="8,4">
<TextBlock TextWrapping="Wrap" Text=" 浓度 5 " Margin="5,0" Background="{DynamicResource ColorBrush5}" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 6 " Margin="5,0" Background="{DynamicResource ColorBrush6}" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 7 " Margin="5,0" Background="{DynamicResource ColorBrush7}" />
<TextBlock TextWrapping="Wrap" Text=" 浓度 8 " Margin="5,0" Background="{DynamicResource ColorBrush8}" />
</StackPanel>
<TextBlock TextWrapping="Wrap" Margin="0,15,0,8" Foreground="{DynamicResource ColorBrush2}" Background="{DynamicResource ColorBrush6}"
</StackPanel>
<TextBlock TextWrapping="Wrap" Margin="0,15,0,8" Foreground="{DynamicResource ColorBrush2}" Background="{DynamicResource ColorBrush6}"
Text="除了字体颜色,你也可以将主题色用于背景色、边框颜色等颜色参数。例如这行字的颜色为浓度 2,背景为浓度 6。" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="替换标记" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在花括号 {} 中写入特定内容,PCL 会在加载时对其进行替换。&#xa;例如,path 会被替换为 PCL 可执行文件所在文件夹({path}),用于在 EventData 中指定特定文件,或是加载图片。" />
<local:MyHint Margin="0,6,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<local:MyHint Margin="0,6,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="你也可以使用替换标记来获取随机内容:cave 会被替换为一条随机的回声洞内容,hint 则是 “你知道吗” 的内容。" />
<TextBlock TextWrapping="Wrap" Margin="10,6,0,5" Foreground="{DynamicResource ColorBrush3}"
<TextBlock TextWrapping="Wrap" Margin="10,6,0,5" Foreground="{DynamicResource ColorBrush3}"
Text="你知道吗:{hint}" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="进阶:Grid 布局" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="如果要实现更复杂的布局,则必须使用 Grid。Grid 可以让按钮们自动适应窗口宽度:随意拉伸 PCL 窗口,按钮大小会自动改变。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="你可以上网查找 “WPF Grid” 的相关教程,这里仅给出一个例子,不作详细介绍。你可以仅在这个教学卡片的基础上稍作调整,来实现自己的按钮布局。" />
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1.6*" MinWidth="200" />
<!-- 第二个按钮的宽度是第一个按钮的 1.6 倍,且至少为 200 -->
<ColumnDefinition Width="150" />
<!-- 如果不打 *,则会占用固定的宽度,也可以写 Auto 来自适应 -->
</Grid.ColumnDefinitions>
<!-- 为按钮添加 Grid.Column 属性指定它所在的列,不要添加 Width 与 HorizontalAlignment 属性 -->
<local:MyButton Grid.Column="0" Margin="0,0,10,0" Height="35" ColorType="Highlight"
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1.6*" MinWidth="200" /> <!-- 第二个按钮的宽度是第一个按钮的 1.6 倍,且至少为 200 -->
<ColumnDefinition Width="150" /> <!-- 如果不打 *,则会占用固定的宽度,也可以写 Auto 来自适应 -->
</Grid.ColumnDefinitions>
<!-- 为按钮添加 Grid.Column 属性指定它所在的列,不要添加 Width 与 HorizontalAlignment 属性 -->
<local:MyButton Grid.Column="0" Margin="0,0,10,0" Height="35" ColorType="Highlight"
Text="打开 B 站" EventType="打开网页" EventData="https://www.bilibili.com/" />
<local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35"
<local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
</Grid>
</StackPanel>
<local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Title="进阶:图标按钮" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<local:MyHint Margin="0,0,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<StackPanel Margin="25,40,23,15">
<local:MyHint Margin="0,0,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="MyIconTextButton 是一种带有自定义矢量图标的按钮变体,它同样支持 EventType 与 EventData 属性。&#xa;通过设置 Logo 属性来控制它的图标,设置 LogoScale 属性还可以调整图标的缩放比例。" />
<local:MyIconTextButton Margin="0,4,0,8" Height="35" HorizontalAlignment="Center"
<local:MyIconTextButton Margin="0,4,0,8" Height="35" HorizontalAlignment="Center"
Text="查看 SVG Path 简介" EventType="打开网页" EventData="https://developer.mozilla.org/zh-CN/docs/Web/SVG/Tutorial/Paths"
LogoScale="1.02" Logo="M1091 0H78C35 0 0 35 0 78v863c0 43 35 78 78 78H1091c43 0 78-35 78-78V78C1170 35 1134 0 1091 0z m-8 87v78H87v-78h994zM87 933V254h994v679H87v0zM724 340l-206 547a43 43 0 0 1-82-31l206-547a43 43 0 0 1 82 30zM369 545l-85 85 85 85a43 43 0 0 1-62 62l-116-116a43 43 0 0 1 0-62l116-116a43 43 0 0 1 62 61z m610-37a43 43 0 0 1 0 62l-116 116a43 43 0 0 1-62 0 43 43 0 0 1 0-62l85-85-85-85a43 43 0 0 1 62-62l116 116z" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="Logo 属性的内容是 SVG Path 的值,你需要使用 SVG 编辑器或者从图标资源网站(如 IconFont)查找它。不要自己写,写不懂的。&#xa;此外,它还有两种 ColorType:Black(默认)和 Highlight。" />
<local:MyIconTextButton Margin="0,4,0,8" Height="35" HorizontalAlignment="Center"
<local:MyIconTextButton Margin="0,4,0,8" Height="35" HorizontalAlignment="Center"
ColorType="Highlight" Text="打开 IconFont" EventType="打开网页" EventData="https://www.iconfont.cn/"
LogoScale="1" Logo="M510 959c-51-31-40-86-74-120-61-63-168-66-231-138C-5 457 196 3 593 70c231 39 407 363 250 592-67 98-198 106-277 213-23 23-11 81-55 83zM176 432c-9 176 240 167 240 9 0-80-72-145-166-111-66 23-71 49-74 101z m509 129c212 59 217-307 0-231-102 36-90 206 0 231z m-213 111c33 7 44-91 9-92-19 19-64 79-9 92z m83 0H575c23-37-8-87-46-92 3 37-11 92 27 92z" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="如果只想要图标,不要文字,还可以使用 MyIconButton。它不能设置 Text 属性,只有一个图标可以按。&#xa;它的 Theme 属性可以设置为 Color(默认)、White、Black、Red。" />
<local:MyIconButton Margin="0,4,0,0" Width="25" Height="25" HorizontalAlignment="Center"
<local:MyIconButton Margin="0,4,0,0" Width="25" Height="25" HorizontalAlignment="Center"
Theme="Black" EventType="弹出窗口" EventData="事件|MyIconButton 当然也支持 EventType 和 EventData——要不然介绍它干啥?"
LogoScale="1" Logo="M149 873c47 47 101 83 162 109 63 26 130 40 199 40 69 0 136-13 199-40 61-25 115-62 162-109s83-101 109-162c26-63 40-130 40-199 0-69-13-136-40-199-25-61-62-115-109-162-46-46-101-83-162-109C648 13 580 0 511 0s-136 13-199 40c-61 25-115 62-162 109s-83 101-109 162C13 375 0 442 0 511s13 136 40 199c25 61 62 115 109 162zM97 511c0-228 185-414 414-414 228 0 414 185 414 414S740 926 511 926c-228 0-414-185-414-414z M539 244c-8-4-17-7-27-7-9 0-19 2-27 7-16 9-27 27-27 47 0 30 24 54 54 54 30 0 54-24 54-54 0-19-10-37-27-47zM566 732v-284c0-30-24-54-54-54-30 0-54 24-54 54v284c0 30 24 54 54 54 30 0 54-24 54-54z" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="如果只想显示一个图标,不想让它是能按的按钮,可以使用 WPF 自带的 Path 等绘图控件,感兴趣的话可以自行搜索。想偷懒也可以把 MyIconButton 的 IsHitTestVisible 属性改为 False……" />
<Path Margin="0,4,0,0" Width="20" Height="20" HorizontalAlignment="Center"
<Path Margin="0,4,0,0" Width="20" Height="20" HorizontalAlignment="Center"
Stretch="Uniform" Fill="{DynamicResource ColorBrush1}"
Data="M149 873c47 47 101 83 162 109 63 26 130 40 199 40 69 0 136-13 199-40 61-25 115-62 162-109s83-101 109-162c26-63 40-130 40-199 0-69-13-136-40-199-25-61-62-115-109-162-46-46-101-83-162-109C648 13 580 0 511 0s-136 13-199 40c-61 25-115 62-162 109s-83 101-109 162C13 375 0 442 0 511s13 136 40 199c25 61 62 115 109 162zM97 511c0-228 185-414 414-414 228 0 414 185 414 414S740 926 511 926c-228 0-414-185-414-414z M539 244c-8-4-17-7-27-7-9 0-19 2-27 7-16 9-27 27-27 47 0 30 24 54 54 54 30 0 54-24 54-54 0-19-10-37-27-47zM566 732v-284c0-30-24-54-54-54-30 0-54 24-54 54v284c0 30 24 54 54 54 30 0 54-24 54-54z" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="进阶:联网自定义主页" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<local:MyHint Margin="0,0,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
<StackPanel Margin="25,40,23,15">
<local:MyHint Margin="0,0,0,10" Text="以下特性于 PCL 2.6.5 (299) 加入,不适用于更早版本的 PCL。" IsWarn="False" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
Text="如果你在尝试制作联网更新的自定义主页,可以查看下方的 GitHub 讨论页。&#xa;你可以根据其中的介绍为主页添加版本号检查以节省流量,也可以通过检查 Referer 和 User Agent 来确定对方的 PCL 版本。" />
<local:MyButton Margin="0,0,0,8" Height="35" HorizontalAlignment="Center" Padding="20,0,20,0"
<local:MyButton Margin="0,0,0,8" Height="35" HorizontalAlignment="Center" Padding="20,0,20,0"
Text="打开 GitHub 讨论页" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/discussions/2528" />
</StackPanel>
</StackPanel>
</local:MyCard>
<!--
@@ -317,9 +315,9 @@
- Width、Height:设置宽度与高度
- ToolTip:设置鼠标指向时的提示文本
- Margin:调整外边距(格式为 左,上,右,下。例如 Margin="0,0,0,2" 即为 2 单位的下边距)
- HorizontalAlignment:设置横向对齐方式,居左:Left、居中:Center、居右:Right、拉伸(默认):Stretch
- VerticalAlignment:设置纵向对齐方式,居上:Top、居中:Center、居下:Bottom、拉伸(默认):Stretch
- IsHitTestVisible:该控件是否响应交互(点击、指向动画等),True 为是(默认),False 为否
- HorizontalAlignment:设置横向对齐方式;居左:Left、居中:Center、居右:Right、拉伸(默认):Stretch
- VerticalAlignment:设置纵向对齐方式;居上:Top、居中:Center、居下:Bottom、拉伸(默认):Stretch
- IsHitTestVisible:该控件是否响应交互(点击、指向动画等);True 为是(默认),False 为否
TextBlock(纯文本):
- Text:设置显示的文本(如果要使用引号等特殊字符,自行百度 XAML 转义)
@@ -328,17 +326,20 @@ TextBlock(纯文本):
- FontWeight:设置为 Bold 时,文字加粗
- Foreground:调整前景颜色(十六进制字符串,例如 #FF010203 代表 ARGB 中的 255,1,2,3。前两位代表不透明度,FF 为全不透明,00 为全透明)
Image(图片):
local:MyImage(图片):
- Source:要显示的图片的网址,或 PCL 内置图片位置
- FallbackSource:当 Source 首次下载失败时,会从该备用地址加载图片
- LoadingSource:正在下载网络图片时显示的本地图片(不支持联网下载);默认为 pack://application:,,,/images/Icons/NoIcon.png
- EnableCache:若图片是联网获取的,是否将图片保存到本地缓存,在 7 天内不再重新下载;True 为是(默认),False 为否
local:MyCard(卡片):
- Title:设置显示的标题文本
- CanSwap:卡片是否可以折叠,True 为是,False 为否
- IsSwaped:卡片是否默认折叠,要求 CanSwap 必须为 True
- HorizontalAlignment:若使用,要求 CanSwap 必须为 False
- UseAnimation:是否在展开等高度改变时触发动画,True 为是(默认),False 为否
- SwapLogoRight:卡片折叠时的箭头是朝下还是朝右,True 为朝右,False 为朝下(默认)
- HasMouseAnimation:是否在鼠标指向时改变卡片颜色,True 为是(默认),False 为否
- UseAnimation:是否在展开等高度改变时触发动画;True 为是(默认),False 为否
- SwapLogoRight:卡片折叠时的箭头是朝下还是朝右;True 为朝右,False 为朝下(默认)
- HasMouseAnimation:是否在鼠标指向时改变卡片颜色;True 为是(默认),False 为否
local:MyHint(提示条):
- Text:设置显示的文本(&#xA; 代表换行)
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large. Load diff
Binary file not shown.
Binary file not shown.
+2 -2
View File
@@ -2,7 +2,7 @@
[![Stars](https://img.shields.io/github/stars/Hex-Dragon/PCL2?style=flat&logo=data:image/svg%2bxml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHZlcnNpb249IjEiIHdpZHRoPSIxNiIgaGVpZ2h0PSIxNiI+PHBhdGggZD0iTTggLjI1YS43NS43NSAwIDAgMSAuNjczLjQxOGwxLjg4MiAzLjgxNSA0LjIxLjYxMmEuNzUuNzUgMCAwIDEgLjQxNiAxLjI3OWwtMy4wNDYgMi45Ny43MTkgNC4xOTJhLjc1MS43NTEgMCAwIDEtMS4wODguNzkxTDggMTIuMzQ3bC0zLjc2NiAxLjk4YS43NS43NSAwIDAgMS0xLjA4OC0uNzlsLjcyLTQuMTk0TC44MTggNi4zNzRhLjc1Ljc1IDAgMCAxIC40MTYtMS4yOGw0LjIxLS42MTFMNy4zMjcuNjY4QS43NS43NSAwIDAgMSA4IC4yNVoiIGZpbGw9IiNlYWM1NGYiLz48L3N2Zz4=&logoSize=auto&label=Stars&labelColor=666666&color=eac54f)](https://github.com/Hex-Dragon/PCL2/)
[![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=666666&color=1a7f37)](https://github.com/Hex-Dragon/PCL2/issues)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.net/@LTCat)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.com/@LTCat)
<br/>
@@ -16,7 +16,7 @@ PCL 的代码绝大多数其实都是几年前学生时代的产物了……那
## 相关内容
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
- [程序下载](https://afdian.net/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [程序下载](https://afdian.com/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
<br/>
Binary file not shown.