Compare commits

...
190 Commits
Author SHA1 Message Date
龙腾猫跃 5bd8ac3870 2.8.3 2024-07-13 14:56:27 +08:00
龙腾猫跃 a3c419e76d 2.8.2 正式版 2024-07-12 01:39:26 +08:00
龙腾猫跃 5436c5ec8a 2.8.2 2024-07-11 20:13:26 +08:00
龙腾猫跃 73a8d60d6d Merge pull request #4175 from youzi-2333/feat-3066
完成 #3066 自动安装 modpack.zip
2024-07-11 20:05:58 +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
乳糖酸菌 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
龙腾猫跃 f264f82b4b Merge pull request #4167 from 3gf8jv4dv/comma-to-halfwidth
Comma fix in `MySkin.xaml.vb` code
2024-07-06 17:04:20 +08:00
3gf8jv4dv 514bd15679 Change a comma to half-width 2024-07-06 03:00:41 +00:00
龙腾猫跃 7b0e925748 2.8.0 2024-07-06 07:18:48 +08:00
龙腾猫跃 1f4d6e3fa1 Merge pull request #4045 from Pigeon0v0/neoforge
NeoForge 支持
2024-07-05 22:03:36 +08:00
龙腾猫跃 f999da7cce 允许在 <100 人的 QQ 群内分发修改后的版本 2024-07-04 22:09:58 +08:00
龙腾猫跃 32f5d09001 Merge pull request #4060 from youzi-2333/event-start-selected
完成 #3997 允许启动当前版本
2024-07-04 20:14:20 +08:00
龙腾猫跃 34e8397ec1 Merge pull request #4155 from youzi-2333/opti-music
只有一首音乐时右键重播
2024-07-04 20:01:47 +08:00
龙腾猫跃 746ba344e1 Merge pull request #4143 from Mxmilu666/main
Fix #3819 #4151
2024-07-04 19:55:33 +08:00
youzi-2333 fca3a2cbb5 🎨 删除多余 Import
……
2024-07-04 15:58:53 +08:00
youzi-2333 e824263992 🚸 只有一首音乐时右键重播 2024-07-04 15:57:43 +08:00
Mxmilu 86a51dea78 Fix #4151 2024-07-03 14:06:06 +08:00
Mxmilu d37572f850 Fix #3819 2024-07-02 21:46:10 +08:00
龙腾猫跃 b766f4d151 Merge pull request #4138 from Deep-Dark-Forest/patch-1
修复追随者披风不能被汉化的 bug
2024-07-02 15:48:53 +08:00
深黑森林 99c0845a1b Update MySkin.xaml.vb 2024-07-02 11:58:17 +08:00
龙腾猫跃 c13f9b199b Merge pull request #4058 from youzi-2333/version-mem-opti
为版本设置添加启动前内存优化
2024-07-02 02:40:47 +08:00
龙腾猫跃 9369759824 Merge pull request #4093 from SALTWOOD/main
简化了 Java 搜索时的一大堆 SearchEntry.Contains
2024-07-02 01:43:03 +08:00
龙腾猫跃 203516509a Merge pull request #3885 from wuyuncheng-26/main
添加 Follower's Cape 的翻译
2024-07-01 22:20:48 +08:00
龙腾猫跃 fec341506b Merge pull request #3999 from PCL-Community/main
单独兼容打开网址 `minecraft://`
2024-07-01 22:17:33 +08:00
Pigeon0v0 7921184a58 chores: 一些判断和命名修改 2024-06-30 21:05:41 +08:00
Pigeon0v0 bec5ddd833 chores: 代码清理 2024-06-30 17:19:34 +08:00
Pigeon0v0 3c44a55b37 refactor: NeoForge BMCLAPI 版本列表(爱来自 bangbang93)
fix: 安装 NeoForge 整合包时的参数初始化不正确
chores: 在低版本(<=1.19)的自动安装界面将不会显示 NeoForge
2024-06-30 15:01:06 +08:00
SALTWOOD 6674533cfb modify: 删除多余的关键词,因为下文已针对其进行全字匹配 2024-06-28 22:20:09 +08:00
Pigeon0v0 4dba7c969c chores: 代码可读性和相关优化 2024-06-28 22:00:01 +08:00
Pigeon0v0 cf43244264 refactor: 合并 Forge 和 NeoForge 部分代码 2024-06-28 09:44:55 +08:00
龙腾猫跃 101cb133fb 明确在 GitHub 上的 Fork 不违反大量使用情形的第三条 2024-06-28 05:20:43 +08:00
Pigeon0v0 a54cfef36a 代码清理 2024-06-27 19:43:39 +08:00
Pigeon0v0 f98578f60d Merge pull request #4 from youzi-2333/pigeon-neoforge
修改一些龙猫的审查
2024-06-27 18:51:21 +08:00
youzi-2333 b61081fad9 👌 修改一些龙猫的审查 2024-06-27 18:30:47 +08:00
Pigeon0v0 1b53489cf3 fix: BMCLAPI 获取支持的 Neo 列表时会意外的包含 1.20
fix: NeoForge 1.20.1 官方源版本列表不能正常解析
2024-06-27 14:09:31 +08:00
Pigeon0v0 ac6ed8d986 chores: Clean up 2024-06-27 08:05:06 +08:00
Pigeon0v0 6efaa09616 fix: 官方源总是 Fallback 到 BMCLAPI 2024-06-27 08:04:09 +08:00
Pigeon0v0 ee10caa84e fix: NeoForge 官方源不可用
chores: 代码清理
2024-06-26 23:55:58 +08:00
Pigeon0v0 2cfa9b2015 feat: NeoForge BMCLAPI 版本列表获取
fix: 之前的排序方法会导致 IDE 警告
2024-06-26 23:43:37 +08:00
Pigeon0v0 707b6eec14 fix: NeoForge 手动安装版本列表不能正常加载(修完了) 2024-06-26 22:13:11 +08:00
Pigeon0v0 3f5c29264f feat(neoforge): NeoForge 官方源版本列表
feat(neoforge): NeoForge Minecraft 版本列表(官方源 Only)
fix: NeoForge 手动安装无法正常加载(只修了一半)
ui: 在自动安装的 NeoForge 卡片中显示最新稳定版和最新测试版
chores: 代码清理
2024-06-26 21:27:08 +08:00
SALTWOOD 4a804cf966 refactor: 简化搜索 Java 时的关键词检测 2024-06-23 18:27:35 +08:00
Pigeon0v0 61ac6270cb fix: 1.20.1 NeoForge 无法安装(Json 路径拼接错误)
fix: NeoForge 版本分类错误
fix: 错误地提示 NeoForge 版本不可使用 Mod
2024-06-22 08:46:10 +08:00
Pigeon0v0 70a6b6a946 chores: 删除调试用信息 2024-06-22 00:23:53 +08:00
Pigeon0v0 7d50ed1ca6 fix: 1.20.1 NeoForge 近期版本无法安装(Json 路径错误) 2024-06-22 00:23:18 +08:00
Pigeon0v0 3bc34160a2 fix: 1.20.1 NeoForge 安装失败(Json 路径错误) 2024-06-21 23:13:52 +08:00
Pigeon0v0 e0ae69660b chores: 界面文本更改,现在安装的是 NeoForge 还是 Forge 更清晰了
fix: 部分早期 Modrinth 的 NeoForge 整合包无法正确识别
2024-06-21 17:00:02 +08:00
Pigeon0v0 f83afdbbc1 fix: 1.20.1 NeoForge 下载地址拼接可能有误(如果版本为 1.20.1 则硬编码以避免问题)
fix: 整合包安装时错误信息文本有误
chores: 代码清理(NeoForge 不需要部分 Forge 逻辑)
fix(未完成): 官方源版本列表获取
2024-06-21 16:38:42 +08:00
youzi-2333 c62e0e2bd8 🍱 修改教学文件 2024-06-20 14:42:32 +08:00
youzi-2333 82dacd7eeb 🐛 修复 {mcv} 被替换的问题 2024-06-19 13:07:32 +08:00
youzi-2333 a32bf0b79e ✨ 完成 #3997
顺便把教学文件也改了……
Discussion: #4002
2024-06-18 18:13:03 +08:00
youzi-2333 dc3804a960 🎨 将内存优化合并到 Select Case
https://github.com/Hex-Dragon/PCL2/pull/4058#discussion_r1643297785
2024-06-18 13:28:19 +08:00
youzi-2333 61c0927baf 🎨 让 ComboChange 接管选择事件
https://github.com/Hex-Dragon/PCL2/pull/4058#discussion_r1643295425
2024-06-18 13:07:29 +08:00
youzi-2333 6e7cf7b481 ✨ 为版本设置添加启动前内存优化 2024-06-18 00:18:36 +08:00
Pigeon0v0 136803f652 fix: 回滚修改,修复版本列表问题 2024-06-16 16:19:28 +08:00
Pigeon0v0 9dab0b8b6b 改一行注释 2024-06-16 15:37:54 +08:00
Pigeon0v0 9c64dc0209 尝试修复 NeoForge 手动安装包列表加载不出的问题,但是失败了 2024-06-16 15:37:00 +08:00
Pigeon0v0 f3079dd619 feat: NeoForge 整合包安装
fix: 部分情况下安装 NeoForge 会失败(DownloadInfo 为空)
2024-06-16 15:29:30 +08:00
Pigeon0v0 66182f2cd0 fix: Icon 显示及其导致的崩溃问题
fix: 1.20.1 NeoForge 下载链接拼接错误
fix: 自动安装界面选择 NeoForge 后使用了 rawVersion 作为版本号
2024-06-16 14:41:16 +08:00
Pigeon0v0 030c49829d Merge pull request #2 from JingHai-Lingyun/neoforge
Small Optimize: Version Name and Icon
2024-06-16 13:22:08 +08:00
Pigeon0v0 c31e3b53b8 Merge branch 'neoforge' into neoforge 2024-06-16 13:21:50 +08:00
Pigeon0v0 d305dd3e43 fix: 版本列表不能正常显示核心 NeoForge 版本
fix: 自动安装页 NeoForge 存在多余的描述
chores: NeoForge Icon 显示,但目前有点小问题
2024-06-16 13:19:17 +08:00
JingHai-Lingyun 27825ed107 Update PageDownloadInstall.xaml.vb
Solve a conflict
2024-06-16 10:32:57 +08:00
Pigeon0v0 f4b1e3ed1a feat: 正式支持 NeoForge 自动安装 2024-06-16 09:44:00 +08:00
Pigeon0v0 0e0335e688 ui: 添加 NeoForge 手动安装 Tab
feat: NeoForge 自动安装 Stage 1
fix: StdVersion 可能错误地包含了 "neoforge-" 前缀
fix: 自动安装选择 NeoForge 时自动生成的核心名称存在重复字符串
2024-06-16 08:52:45 +08:00
Pigeon0v0 d8fe599739 fix: 所有版本都显示为测试版 / 正式版 2024-06-16 07:00:37 +08:00
JingHai-Lingyun 31e391f872 optimize: version name and icon
Now, NeoForge client's info and name looks like the Forge client's behavior
2024-06-16 00:34:42 +08:00
Pigeon0v0 65d21d4f21 Installer 下载和代码清理 2024-06-15 23:57:29 +08:00
Pigeon0v0 655364b06a fix: 一处逻辑判断错误,但未解决版本判断错误的问题 2024-06-15 23:29:53 +08:00
Pigeon0v0 8d9dc4712b fix: NeoForge 版本列表排序,但是抽象实现 2024-06-15 23:12:42 +08:00
Pigeon0v0 e731ef69d4 ui: 显示 NeoForge 版本属性(测试版 / 稳定版) 2024-06-15 22:38:39 +08:00
龙腾猫跃 9b6e92b9eb Merge pull request #4040 from allMagicNB/main
让工作流不会因为没有 Tag 而跳过
2024-06-15 22:05:48 +08:00
Pigeon0v0 7ba79db82c feat(neoforge): 添加了 NeoForge 的安装选项,并支持获取版本列表 2024-06-15 21:34:02 +08:00
allMagic fcc1afff3d 更新 build.yml 2024-06-15 18:27:36 +08:00
allMagic b2e9a4486e 更新 build.yml 2024-06-15 18:26:47 +08:00
allMagic f223ebfed9 更新 build.yml 2024-06-15 18:24:29 +08:00
allMagic 1b186dc6ae 更新 build.yml 2024-06-15 18:15:14 +08:00
allMagic 2c0ecc8100 更新 build.yml 2024-06-15 18:06:52 +08:00
allMagic 7348a6be94 更新 build.yml 2024-06-15 17:08:04 +08:00
allMagic 786f172425 更新 build.yml 2024-06-15 16:59:26 +08:00
allMagic adbcb3399c 更新 build.yml 2024-06-15 16:45:04 +08:00
allMagic 5994b38a4b 更新 build.yml 2024-06-15 16:43:27 +08:00
allMagic a8ea33b3b2 更新 build.yml 2024-06-15 16:35:37 +08:00
allMagic 695fdc9068 更新 build.yml 2024-06-15 16:32:15 +08:00
allMagic e70e904033 更新 build.yml 2024-06-15 16:24:21 +08:00
allMagic 0a2c01d773 Add workflow_dispatch 2024-06-15 16:21:28 +08:00
allMagic d34a28a503 Add Set Hash 2024-06-15 16:11:52 +08:00
JingHai-Lingyun bb1b9d193f Update ModBase.vb 2024-06-14 20:48:54 +08:00
JingHai-Lingyun ac2f29910b 好吧,这并不会出错 2024-06-14 19:47:13 +08:00
龙腾猫跃 f1fedfc785 Merge pull request #4009 from allMagicNB/main
重构编译工作流文件
2024-06-13 19:36:35 +08:00
龙腾猫跃 f8b89be64e Merge pull request #4018 from Silverteal/patch-3
修复 #4013
2024-06-13 19:04:24 +08:00
Silverteal a2b4881d08 Fix #4013 2024-06-13 10:57:44 +08:00
allMagic 5c8888d138 更新 build.yml 2024-06-12 22:11:17 +08:00
allMagic af2787cdb8 更新 build.yml 2024-06-12 22:09:36 +08:00
是小胖呀26andallMagic 1d9c6d8aab Update Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb
Co-authored-by: allMagic <[email protected]>
2024-06-12 07:33:39 +08:00
allMagic 2996df399b 更新 build.yml 2024-06-12 06:11:49 +08:00
是小胖呀26 6b719a45c5 Update MySkin.xaml.vb 2024-06-11 23:33:23 +08:00
allMagic 073f9ef549 更新 build.yml 2024-06-11 22:41:18 +08:00
allMagic ffcb399432 更新 build.yml 2024-06-11 22:36:35 +08:00
allMagic b6ca6dd7dc 更新 build.yml 2024-06-11 22:13:11 +08:00
allMagic 094737ef01 Update build.yml 2024-06-11 22:04:32 +08:00
JingHai-Lingyun eefb8b50a7 又改了改
现在如果给 URL Scheme 传参也能接受了
2024-06-10 13:46:28 +08:00
JingHai-Lingyun 657b5efc2e 写死了单独逻辑
避免有人传了点别的东西进去,现在只有 `minecraft://` 会单独处理
2024-06-10 12:14:35 +08:00
JingHai-Lingyun aa5ff163e6 fix #3985 2024-06-10 12:04:52 +08:00
凌云 a18ccf78d1 fix #3985 2024-06-10 11:48:55 +08:00
allMagic 9e43f9e75c Create build.yml 2024-06-10 10:10:53 +08:00
allMagic 67d954f7e3 Delete .github/workflows/build.yml
既然是重构,直接删了得了
2024-06-10 09:26:24 +08:00
龙腾猫跃 deca6b6302 2.7.4 正式版 2024-06-07 17:47:23 +08:00
龙腾猫跃 94528e36e7 Update LICENCE 2024-06-04 02:41:51 +08:00
龙腾猫跃 c3752d5660 Update LICENCE 2024-06-03 23:26:47 +08:00
龙腾猫跃 f4277104c1 Update LICENCE 2024-06-03 23:19:04 +08:00
龙腾猫跃 cf6ab30891 Merge pull request #3944 from Silverteal/patch-2
修正工作流文件
2024-06-02 17:08:37 +08:00
Silverteal 0703c4d938 Update build.yml 2024-06-02 07:09:31 +08:00
Silverteal 2ee78d8dd1 Merge branch 'main' into patch-2
Signed-off-by: Silverteal <[email protected]>

# Conflicts:
#	.github/workflows/dotnet-desktop.yml
2024-06-02 07:00:24 +08:00
Silverteal 32b6883575 更新 build.yml 2024-06-01 23:21:43 +08:00
Silverteal 59b7fac9d5 Merge pull request #7 from Silverteal/patch-2-patch-1
Patch 2 patch 1
2024-06-01 22:42:43 +08:00
Silverteal b18a5340f2 Update build.yml 2024-06-01 22:32:57 +08:00
Silverteal 3a07beb531 Update build.yml 2024-06-01 21:20:24 +08:00
Silverteal 84b4b3b8e5 Update build.yml 2024-06-01 21:07:56 +08:00
Silverteal 3eacf3ff67 Update build.yml 2024-06-01 21:02:54 +08:00
Silverteal 5697dcf6e1 Merge pull request #6 from Silverteal/patch-2-patch-1
Patch 2 patch 1
2024-06-01 21:01:15 +08:00
Silverteal e4ecc79bc9 Update build.yml 2024-06-01 19:54:17 +08:00
Silverteal 937f947d71 Update build.yml 2024-06-01 19:43:48 +08:00
Silverteal 36a71e035b Update build.yml 2024-06-01 19:28:24 +08:00
Silverteal af3737df1e Update build.yml 2024-06-01 19:04:45 +08:00
Silverteal 941a111749 Update build.yml 2024-06-01 19:01:12 +08:00
Silverteal 3aab7ead7a Update build.yml 2024-06-01 18:57:41 +08:00
Silverteal 3f9ba48749 Update build.yml 2024-06-01 18:54:20 +08:00
Silverteal 27264e16cb Update build.yml 2024-06-01 18:52:50 +08:00
Silverteal 3a1c24a517 Update build.yml, optimize language 2024-06-01 10:12:33 +08:00
Silverteal 2647a9d5f7 Merge pull request #5 from Silverteal/frontiere
Make artifact name friendly and remove pr
2024-06-01 10:07:46 +08:00
Silverteal 331d6ca5f1 Delete .github/workflows/build-pr.yml 2024-06-01 10:05:11 +08:00
Silverteal 9a05dc1e6b Update build.yml 2024-06-01 10:04:19 +08:00
Silverteal 862281c324 Update build.yml 2024-06-01 09:55:17 +08:00
Silverteal 9ba57ab2eb Fix a typo
Signed-off-by: Silverteal <[email protected]>
2024-06-01 07:26:17 +08:00
Silverteal 2ff1ac7254 Update build.yml 2024-06-01 06:47:59 +08:00
Silverteal ddb00d0303 Create build-pr.yml 2024-06-01 06:47:40 +08:00
Silverteal f5653cbd27 Update build.yml 2024-05-31 23:44:04 +08:00
Silverteal 7f6b2938da Update build.yml 2024-05-31 23:29:43 +08:00
Silverteal 85a138092a Update build.yml 2024-05-31 23:28:21 +08:00
Silverteal 5593049913 Update build.yml 2024-05-31 23:23:19 +08:00
Silverteal ccf4e9517d Try Update build.yml again 2024-05-31 23:00:55 +08:00
龙腾猫跃 879fc00d72 Merge pull request #3929 from allMagicNB/main
修改 Actions 的编译参数
2024-05-31 15:47:27 +08:00
Silverteal 8fe6c5c344 Try Update build.yml 2024-05-31 14:51:06 +08:00
Silverteal 7c0beaa7e0 Update and rename dotnet-desktop.yml to build.yml 2024-05-31 14:48:08 +08:00
allMagic f32b671ea1 更新 dotnet-desktop.yml 2024-05-31 06:20:23 +08:00
allMagic 966fa0280f 删除多余参数 2024-05-31 06:14:59 +08:00
龙腾猫跃 b86588e855 Merge pull request #3921 from allMagicNB/Auto-Build
Auto build
2024-05-31 05:23:06 +08:00
allMagic 900970b1e7 Delete the Badge 2024-05-30 19:21:25 +08:00
allMagic d104961365 更新 dotnet-desktop.yml 2024-05-30 06:23:12 +08:00
allMagic 5d19fb8072 Delete the link of the badge 2024-05-29 20:35:07 +08:00
allMagic 01d7df91c8 Delete Install .NET SDK 5 2024-05-29 19:33:59 +08:00
allMagic 30263bafd6 更新 dotnet-desktop.yml 2024-05-29 19:29:33 +08:00
allMagic 3b1862b352 Delete unit test 2024-05-29 19:23:23 +08:00
allMagic 630649a66b change "on:"… 2024-05-29 19:12:02 +08:00
allMagic b8e890c7d6 更新 dotnet-desktop.yml 2024-05-29 13:43:27 +08:00
allMagic d8c967c6fa 更新 dotnet-desktop.yml 2024-05-29 13:19:42 +08:00
allMagic 0996c5d58f 更新 dotnet-desktop.yml 2024-05-29 06:16:51 +08:00
allMagic 159502090a Update README.md 2024-05-28 22:09:35 +08:00
allMagic 3404cefba8 Update dotnet-desktop.yml 2024-05-28 21:57:00 +08:00
allMagic 53fe5c93ce Create dotnet-desktop.yml 2024-05-28 21:53:33 +08:00
allMagic 8d73e7f3ad Delete .github/workflows/dotnet-desktop.yml 2024-05-28 21:48:09 +08:00
allMagic 0cc5759ad9 Update dotnet-desktop.yml 2024-05-28 21:37:57 +08:00
allMagic a75e636789 Create dotnet-desktop.yml 2024-05-28 21:21:53 +08:00
龙腾猫跃 56cb6bc7d9 可编译版本 2024-05-27 01:15:32 +08:00
龙腾猫跃 c23fecfe14 公开更多代码 2024-05-26 23:53:25 +08:00
龙腾猫跃 0811b4f382 公开 ModMain.vb 2024-05-26 17:42:44 +08:00
龙腾猫跃 e1268cefdb 2.7.4 2024-05-25 17:42:12 +08:00
是小胖呀26 fe35f79405 Update MySkin.xaml.vb 2024-05-25 13:22:28 +08:00
是小胖呀26 1895568794 Update MySkin.xaml.vb 2024-05-23 19:58:44 +08:00
龙腾猫跃 0bdef8648f Merge pull request #3883 from Deep-Dark-Forest/main
添加紫色心形披风的汉化
2024-05-23 19:20:42 +08:00
深黑森林 3cbe38d2fb Update MySkin.xaml.vb 2024-05-23 19:03:57 +08:00
龙腾猫跃 adff1a6009 Merge pull request #3850 from xiaoliyuanpp/main
fix #3840
2024-05-23 05:00:57 +08:00
龙腾猫跃 8a1c053be6 Merge pull request #3776 from allMagicNB/fix-#3702
fix #3702
2024-05-23 04:58:27 +08:00
肖力源 35114ed38d Update MySkin.xaml.vb 2024-05-20 19:03:57 +08:00
肖力源 2dc437c8bb 修复#3840 2024-05-18 21:43:32 +08:00
龙腾猫跃 df81f71f9b 2.7.3 正式版 2024-05-17 16:58:33 +08:00
allMagic 7f37c83f52 fix #3702 2024-05-06 18:54:45 +08:00
allMagicNB 1158ff9e78 fix #3702 2024-05-02 21:21:43 +08:00
81 changed files with 5814 additions and 1444 deletions

No files matched your search

+48
View File
@@ -0,0 +1,48 @@
name: Build
on:
push:
paths:
- 'Plain Craft Launcher 2/**'
- '.github/workflows/**'
pull_request:
paths:
- 'Plain Craft Launcher 2/**'
- '.github/workflows/**'
workflow_dispatch:
jobs:
build:
strategy:
matrix:
configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate]
runs-on: windows-latest
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
- name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2
with:
msbuild-architecture: x64
- 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 }}
path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe
+1 -12
View File
@@ -341,15 +341,4 @@ ASALocalRun/
# BeatPulse healthcheck temp database
healthchecksdb
# ------------------------------------------------------------
# 包含主题解锁、加密解密等部分的代码
ModSecret.vb
ModSetup.vb
PageOtherAbout.*
PageOtherTest.*
PageSetupUI.*
# 开发者工具
ModDevelop.vb
# 不公开底层函数库,以免抄袭
ModMain.vb
MaskFiles/
+28 -12
View File
@@ -1,15 +1,31 @@
本文件不是法律文件或开源协议。
龙腾猫跃(下文简称为龙猫)承诺在您遵守本文件指引的情况下,不会追究您的法律责任,但裁量您 “是否遵守本文件指引” 的最终权利由龙猫保留。
本文件仅作为指引您合理使用本存储库内容的指南,不是法律文件或协议。
1、本存储库中的内容以帮助公共研究为目的而公开。
2、在没有附加许可的情况下,龙猫仍然对本存储库的内容保留所有权利,故以下所有允许性表述均无法作出永久性保证。
3、不允许以本存储库的内容作为内容主体创建、发布、传播其衍生作品,且您不可以发布本存储库及其相关作品的修改版。
4、在满足第 3 款,且在可见位置标注内容来源(即本存储库链接)的前提下,您可以使用或引用本存储库的小部分内容或是其实现思路。
5、龙猫可能随时修改本文件,且可能不会提前通知。本文件不是法律文件或开源协议,故本文件的修改不构成与您法律关系的改变。
一、承诺与声明。
——————
  开发者承诺,在您遵守本指南的情况下,不会追究您的法律责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
说人话就是,随便你参考这堆代码的思路,乃至复制一两个函数什么的也可以,别太过火就行,顺便记得声明一下这段是从这里来的。
不过,你不能把它们直接复制下来然后再小修小补,就说这是你自己的东西。也不能把其中一小部分单独抠出来说是你自己的东西。
没有法律顾问,所以这只是明确说明一下,你可以借鉴其中的小部分内容,我也不会且懒得因此找你麻烦。
如果有专业人士愿意帮帮忙把这堆东西写得专业一点我也很乐意……
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。
  如果您基于该存储库进行衍生创作,或合理使用了本存储库中的较大量内容,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
  (三)给出适当的说明,表示这是第三方内容。在 GitHub 上直接进行 Fork 是允许的。
  (四)使用本指南文件作为协议,不得附加额外条款。
  (五)不得分发编译后的可执行文件。唯一的例外是,你可以在明确禁止再次分发的前提下,在小于 100 人的 QQ 群内分发编译后的可执行文件。
————————————
说人话的备注:
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。
如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。
+37
View File
@@ -0,0 +1,37 @@
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.2.32616.157
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Beta|Any CPU = Beta|Any CPU
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {838A572E-025C-4A2B-B682-68732EC0FE76}
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
EndGlobal
+3 -1
View File
@@ -12,7 +12,7 @@ Public Class Application
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", LogLevel.Feedback)
Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
End Try
End Sub
#End If
@@ -103,6 +103,7 @@ Public Class Application
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({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)
@@ -213,6 +214,7 @@ Public Class Application
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
MsJson.Remove(sender.Tag)
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
Case McLoginType.Legacy
'离线
+32 -21
View File
@@ -13,8 +13,26 @@
MainBorder.Child = value
End Set
End Property
Public MainTextBlock As TextBlock
Public MainSwap As Shapes.Path
Private _MainTextBlock As TextBlock
Public Property MainTextBlock As TextBlock
Get
Init() '当父级触发 Loaded 时,本卡片可能尚未触发 Loaded(该事件从父级向子级调用),因此这会是 null。手动触发以确保控件已加载。
Return _MainTextBlock
End Get
Set(value As TextBlock)
_MainTextBlock = value
End Set
End Property
Private _MainSwap As Shapes.Path
Public Property MainSwap As Shapes.Path
Get
Init()
Return _MainSwap
End Get
Set(value As Shapes.Path)
_MainSwap = value
End Set
End Property
'属性
Public Uuid As Integer = GetUuid()
@@ -24,7 +42,7 @@
End Get
Set(value As String)
SetValue(TitleProperty, value)
If MainTextBlock IsNot Nothing Then MainTextBlock.Text = value
If _MainTextBlock IsNot Nothing Then MainTextBlock.Text = value
End Set
End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata(""))
@@ -40,10 +58,11 @@
Children.Add(MainGrid)
End Sub
Private IsLoad As Boolean = False
Private Sub MyCard_Loaded() Handles Me.Loaded
Private Sub Init() Handles Me.Loaded
If IsLoad Then Exit Sub
IsLoad = True
'初次加载限定
If Not Title = "" AndAlso IsNothing(MainTextBlock) Then
If Title <> "" AndAlso MainTextBlock Is Nothing Then
MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
@@ -55,7 +74,6 @@
MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1")
MainGrid.Children.Add(MainSwap)
End If
IsLoad = True
'改变默认的折叠
If IsSwaped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
@@ -80,21 +98,13 @@
'排序
Select Case Type
Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(Left As DlLiteLoaderListEntry, Right As DlLiteLoaderListEntry) As Boolean
Return VersionSortBoolean(Left.Inherit, Right.Inherit)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean
Return VersionSortBoolean(Left.Version, Right.Version)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version)
Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate)
End Select
'控件转换
Select Case Type
@@ -126,9 +136,8 @@
Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
'不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
@@ -153,6 +162,8 @@
Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
Case 12
Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected))
Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else
Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
End Select
@@ -656,9 +656,9 @@
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
If EventType = "打开帮助" Then
If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
Try
Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
End Try
@@ -74,13 +74,13 @@
'添加结束 Invoke
If FinishedInvoke IsNot Nothing Then
AddHandler RealLoader.PreviewFinish,
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub
End If
AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
'隐藏 UI
+105 -55
View File
@@ -10,6 +10,22 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
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 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 323 Then 'Release 2.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
@@ -108,13 +124,41 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
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 开源代码"))
FeatureCount += 11
BugCount += 14
End If
If LastVersion < 325 Then 'Snapshot 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 324 Then 'Snapshot 2.7.3
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
@@ -330,7 +374,7 @@ Public Class FormMain
Setup.Load("UiBackgroundBlur")
Setup.Load("UiLogoType")
Setup.Load("UiHiddenPageDownload")
BackgroundRefresh(False, True)
PageSetupUI.BackgroundRefresh(False, True)
MusicRefreshPlay(False, True)
'扩展按钮
BtnExtraDownload.ShowCheck = AddressOf BtnExtraDownload_ShowCheck
@@ -376,44 +420,46 @@ Public Class FormMain
AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
End Sub, , True)
AaCode(
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
End Sub, , True)
}, "Form Show")
'Timer 启动
AniStart()
TimerMainStart()
'加载池
RunInNewThread(Sub()
'EULA 提示
If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
RunInNewThread(
Sub()
'EULA 提示
If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1
Setup.Set("SystemEula", True)
Case 2
EndProgram(False)
End Select
End If
'启动加载器池
Try
JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
Thread.Sleep(200)
DlClientListMojangLoader.Start(1)
RunCountSub()
ServerLoader.Start(1)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
End Try
'清理自动更新文件
Try
If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
Log(ex, "清理自动更新文件失败")
End Try
End Sub, "Start Loader", ThreadPriority.Lowest)
Case 1
Setup.Set("SystemEula", True)
Case 2
EndProgram(False)
End Select
End If
'启动加载器池
Try
JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
Thread.Sleep(200)
DlClientListMojangLoader.Start(1)
RunCountSub()
ServerLoader.Start(1)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
End Try
'清理自动更新文件
Try
If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
Log(ex, "清理自动更新文件失败")
End Try
End Sub, "Start Loader", ThreadPriority.Lowest)
Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
End Sub
@@ -521,12 +567,13 @@ Public Class FormMain
If SendWarning AndAlso HasDownloadingTask() Then
If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then
'强行结束下载任务
RunInNewThread(Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray
Task.Abort()
Next
End Sub, "强行停止下载任务")
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray
Task.Abort()
Next
End Sub, "强行停止下载任务")
Else
Exit Sub
End If
@@ -542,17 +589,19 @@ Public Class FormMain
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)
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(
Sub()
IsHitTestVisible = False
Top = -10000
ShowInTaskbar = False
End Sub, 210),
AaCode(AddressOf EndProgramForce, 230)
}, "Form Close")
Else
@@ -800,14 +849,14 @@ Public Class FormMain
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.Split(".").Last.ToLower) Then
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub
End If
Next
End If
'自定义主页
Dim Extension As String = FilePath.Split(".").Last.ToLower
Dim Extension As String = FilePath.After(".").ToLower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
@@ -1008,10 +1057,11 @@ Install:
DownloadClient = 4
DownloadOptiFine = 5
DownloadForge = 6
DownloadFabric = 7
DownloadLiteLoader = 8
DownloadMod = 10
DownloadPack = 11
DownloadNeoForge = 7
DownloadFabric = 8
DownloadLiteLoader = 9
DownloadMod = 11
DownloadPack = 12
SetupLaunch = 0
SetupUI = 1
SetupSystem = 2
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

+160 -77
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.3." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.3." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 323 'Release
Public Const VersionCode As Integer = 332 'Release
#Else
Public Const VersionCode As Integer = 324 'Snapshot
Public Const VersionCode As Integer = 331 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -26,7 +26,7 @@ Public Module ModBase
#ElseIf BETA Then
Public Const VersionBranchName As String = "Release"
Public Const VersionBranchCode As String = "50"
#ElseIf DEBUG Then
#Else
Public Const VersionBranchName As String = "Debug"
Public Const VersionBranchCode As String = "100"
#End If
@@ -86,7 +86,7 @@ Public Module ModBase
''' <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>
@@ -595,7 +595,7 @@ Public Module ModBase
Try
Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
parentKey = My.Computer.Registry.CurrentUser
softKey = parentKey.OpenSubKey("Software\PCL", True)
softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
If softKey Is Nothing Then
ReadReg = DefaultValue '不存在则返回默认值
Else
@@ -616,8 +616,8 @@ Public Module ModBase
Try
Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
parentKey = My.Computer.Registry.CurrentUser
softKey = parentKey.OpenSubKey("Software\PCL", True)
If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\PCL") '如果不存在就创建
softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\" & RegFolder) '如果不存在就创建
softKey.SetValue(Key, Value)
Catch ex As Exception
Log(ex, "写入注册表出错:" & Key, If(ShowException, LogLevel.Hint, LogLevel.Developer))
@@ -1016,7 +1016,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
@@ -1257,12 +1257,19 @@ Re:
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
For Each FilePath As String In Temp
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
@@ -1273,10 +1280,17 @@ Re:
For Each str As String In Temp
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
@@ -1451,7 +1465,8 @@ Re:
Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception
Throw New Exception("格式化 json 对象失败:" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data))
Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 json 对象失败:" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
End Try
End Function
@@ -1544,6 +1559,51 @@ Re:
Return Input.All(Function(c) AscW(c) < 128)
End Function
''' <summary>
''' 获取在子字符串之前的部分。
''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(0, Pos)
Else
Return Str
End If
End Function
''' <summary>
''' 获取在子字符串之后的部分。
''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(Pos + Text.Length)
Else
Return Str
End If
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 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))
If StartPos >= 0 Then
StartPos += Before.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
Return Str.Substring(StartPos)
Else
Return Str
End If
End Function
''' <summary>
''' 高速的 StartsWith。
''' </summary>
@@ -1573,12 +1633,26 @@ Re:
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 IndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function IndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
Return Str.IndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 LastIndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 LastIndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 输入 And 字符不会报错的 Val。
@@ -1592,7 +1666,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
'正则
@@ -2005,15 +2082,16 @@ NextElement:
''' 在新的工作线程中执行代码。
''' </summary>
Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
Dim th As New Thread(
Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
th.Start()
Return th
End Function
@@ -2126,7 +2204,9 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
End If
Log("[System] 正在打开网页:" & Url)
Process.Start(Url)
Catch ex As Exception
@@ -2151,25 +2231,27 @@ NextElement:
''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
''' </summary>
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
RunInThread(Sub()
Dim RetryCount As Integer = 0
RunInThread(
Sub()
Dim RetryCount As Integer = 0
Retry:
Try
RunInUi(Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
Try
RunInUi(
Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
End Sub
''' <summary>
@@ -2388,39 +2470,40 @@ Retry:
Private LogList As New StringBuilder
Private LogWritter As StreamWriter
Public Sub LogStart()
RunInNewThread(Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
RunInNewThread(
Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
End Sub
Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
Public Sub LogFlush()
@@ -266,7 +266,7 @@
Public Output As OutputType = Nothing
'获取输入
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing,则会导致 Input Is Nothing 永远失败,因此需要额外判断
If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
+24 -20
View File
@@ -341,14 +341,15 @@ Retry:
Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0
For i = 1 To RequestCount
Dim th As New Thread(Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
Dim th As New Thread(
Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
th.Start()
Threads.Add(th)
Thread.Sleep(i * 250)
@@ -382,7 +383,7 @@ RequestFinished:
Dim Resp As WebResponse = Nothing
Dim Req As HttpWebRequest
Try
Req = WebRequest.Create(New Uri(Url))
Req = WebRequest.Create(Url)
Req.Method = Method
Dim SendData As Byte()
If TypeOf Data Is Byte() Then
@@ -781,7 +782,7 @@ RequestFinished:
''' <summary>
''' 为不需要分割的小文件进行临时存储。
''' </summary>
Private SmailFileCache As List(Of Byte)
Private SmailFileCache As Queue(Of Byte)
''' <summary>
''' 文件的已下载大小。
@@ -1101,7 +1102,7 @@ NotSupportRange:
'创建缓存文件
If IsNoSplit Then
Info.Temp = Nothing
SmailFileCache = New List(Of Byte)
SmailFileCache = New Queue(Of Byte)
Else
Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp"
ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
@@ -1152,9 +1153,15 @@ NotSupportRange:
Info.DownloadDone += RealDataCount
If IsNoSplit Then
If HttpData.Count = RealDataCount Then
SmailFileCache.AddRange(HttpData)
'SmailFileCache.AddRange(HttpData)
For Each B In HttpData
SmailFileCache.Enqueue(B)
Next
Else
SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
'SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
For i = 0 To RealDataCount - 1
SmailFileCache.Enqueue(HttpData(i))
Next
End If
Else
ResultStream.Write(HttpData, 0, RealDataCount)
@@ -1456,7 +1463,9 @@ Retry:
Public Overrides Property Progress As Double
Get
If State >= LoadState.Finished Then Return 1
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
SyncLock FilesLock
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
End SyncLock
Return _Progress
End Get
Set(value As Double)
@@ -1851,15 +1860,10 @@ Retry:
Try
While True
Thread.Sleep(20)
'若已完成,则清空
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock LockFiles
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then Files.Clear() '若已完成,则清空
AllFiles = Files.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
@@ -149,7 +149,7 @@ Public Class ValidateExcept
End Sub
Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts
If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If Str.IndexOfF(Ch, True) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch)
End If
@@ -355,26 +355,3 @@ Fin:
Return ""
End Function
End Class
''' <summary>
''' 敏感词过滤。
''' </summary>
Public Class ValidateFilter
Inherits Validate
Private Shared Excepts As String() = SecretDecrypt(SecretSensitiveWordsRaw).Split("|")
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
'提取无间隔符的字符串
Dim RealStr As String = ""
For Each St In If(Str, "").ToLower
If String.IsNullOrWhiteSpace(St.ToString) OrElse ("!@#$%^&*()_+-={}[]|\;':"",./<>? ~ ·!¥…()—,。、《》?‘;:【】{}" & vbLQ & vbRQ).ToCharArray.Contains(St) Then Continue For
RealStr += St
Next
'检查
For Each Except In Excepts
If RealStr.Contains(Except) Then Return "存在敏感内容!"
Next
Return ""
End Function
End Class
@@ -265,7 +265,7 @@
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0).
Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type
@@ -342,7 +342,7 @@
'搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
@@ -355,12 +355,12 @@
ModLoaders = New List(Of CompModLoaderType)
For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category
'加载器
'加载器
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
'Mod
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪")
@@ -376,7 +376,7 @@
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
'整合包
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
@@ -387,7 +387,7 @@
Case "adventure" : 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("杂项")
@@ -576,9 +576,9 @@
'有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix
Title = TranslatedName.Split(" (").First.Split(" - ").First
Title = TranslatedName.Before(" (").Before(" - ")
Dim Suffix As String = ""
If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last
If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ")
Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
@@ -629,19 +629,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -751,7 +751,7 @@ NoSubtitle:
Case CompType.ResourcePack
'FUTURE: Res
End Select
Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First)
Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/"))
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
@@ -772,7 +772,7 @@ NoSubtitle:
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
@@ -880,7 +880,7 @@ NoSubtitle:
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First.
SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - ").
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
Next
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
@@ -1133,7 +1133,7 @@ Retry:
'描述性信息
''' <summary>
''' 文件描述名(并非文件名,是自定义的字段)。
''' 文件描述名(并非文件名,是自定义的字段)。对很多 Mod,这会给出 Mod 版本号。
''' </summary>
Public DisplayName As String
''' <summary>
@@ -1305,7 +1305,7 @@ Retry:
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1320,6 +1320,7 @@ Retry:
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
@@ -1403,7 +1404,7 @@ Retry:
'辅助函数
Public Overrides Function ToString() As String
Return $"{Id}: {DisplayName}"
Return $"{Id}: {FileName}"
End Function
End Class
@@ -312,16 +312,30 @@ Extracted:
End Function
''' <summary>
''' 输出字符串的前后某些行,并统一行尾为 vbLf (\r)、删除空行。
''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw, vbLf)
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf)
Dim Lines As New List(Of String)
Dim RealHeadLines As Integer = 0, ViewedLines As Integer
For ViewedLines = 0 To Raw.Length - 1
If Lines.Contains(Raw(ViewedLines)) Then Continue For
RealHeadLines += 1
Lines.Add(Raw(ViewedLines))
If RealHeadLines >= HeadLines Then Exit For
Next
Dim RealTailLines = 0
For i = Raw.Length - 1 To ViewedLines Step -1
If Lines.Contains(Raw(i)) Then Continue For
RealTailLines += 1
Lines.Insert(RealHeadLines, Raw(i))
If RealTailLines >= TailLines Then Exit For
Next
Dim Result As New StringBuilder
For i = 0 To Raw.Count - 1
If i < HeadLines OrElse Raw.Count - i < TailLines Then
If Raw(i) = "" Then Continue For
Result.Append(Raw(i) & vbLf)
End If
For Each Line In Lines
If Line = "" Then Continue For
Result.Append(Line)
Result.Append(vbLf)
Next
Return Result.ToString
End Function
@@ -353,6 +367,7 @@ Extracted:
光影或资源包导致OpenGL1282错误
文件或内容校验失败
确定Mod导致游戏崩溃
怀疑Mod导致游戏崩溃
Mod配置文件导致游戏崩溃
ModMixin失败
Mod加载器报错
@@ -398,23 +413,21 @@ Extracted:
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Dim StackLogs As String = LogCrash.Split("System Details").First
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
End If
'Minecraft 日志
If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
Dim Fatals As List(Of String) = RegexSearch(LogMc, "/FATAL] .+?(?=[\n]+\[)")
If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper"))
Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项")
If Fatals.Any Then
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
End If
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
End If
'虚拟机日志
If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Split("Registers:").First.Split("T H R E A D").Last
Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'Mod 名称分析
@@ -502,7 +515,7 @@ Done:
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
@@ -530,6 +543,7 @@ Done:
'Mod 重复安装
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'Mod 缺少前置
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
@@ -556,10 +570,10 @@ Done:
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogLeft = LogCrash.Split("-- MOD").Last
If LogLeft.Contains("Failure message: MISSING") Then
If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
@@ -584,19 +598,9 @@ Done:
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit3()
'游戏日志分析
If LogMc IsNot Nothing Then
'Mixin 崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
@@ -614,6 +618,24 @@ Done:
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
End If
'崩溃报告分析
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))
End If
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit3()
'游戏日志分析
If LogMc IsNot Nothing Then
'极短的程序输出
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc)
@@ -634,9 +656,13 @@ Done:
''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。
''' </summary>
Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String)
ErrorStack = vbLf & If(ErrorStack, "") & vbLf
'进行正则匹配
Dim StackSearchResults As List(Of String) = RegexSearch(If(ErrorStack, "") & vbCrLf, "(?<=\n[^{]+)[a-zA-Z]+\w+\.[a-zA-Z]+[\w\.]+(?=\.[\w\.$]+\.)")
Dim StackSearchResults As New List(Of String)
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈:xxx.xxx.xxxx$xxxx$xxx
StackSearchResults = StackSearchResults.Distinct.ToList
'检查堆栈开头
Dim PossibleStacks As New List(Of String)
@@ -649,7 +675,7 @@ Done:
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
PossibleStacks.Add(Stack.Trim)
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
@@ -666,13 +692,13 @@ NextStack:
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules",
"fastutil", "optifine", "internal", "platform", "override",
"listeners", "scheduler", "minecraft", "transformers", "universal", "multipart", "minecraftforge", "blockentity"
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -712,7 +738,7 @@ NextStack:
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If
Details = Details.Split("¨").Last
Details = Details.After("¨")
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
@@ -795,13 +821,20 @@ NextStack:
End If
End Function
''' <summary>
''' 尝试获取 Mod 名称,若失败则返回原关键字。
''' 尝试从关键字获取 Mod 名称,若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As String) As List(Of String)
Dim RawList As New List(Of String) From {If(Keywords, "")}
If String.IsNullOrEmpty(Keywords) Then Return RawList
Private Function TryAnalyzeModName(Keyword As String) As List(Of String)
Dim RawList As New List(Of String) From {If(Keyword, "")}
If String.IsNullOrEmpty(Keyword) Then Return RawList
Return If(AnalyzeModName(RawList), RawList)
End Function
''' <summary>
''' 尝试从关键字获取 Mod 名称,若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords
Return If(AnalyzeModName(Keywords), Keywords)
End Function
'4:根据原因输出信息
Private OutputFiles As New List(Of String)
@@ -814,7 +847,7 @@ NextStack:
Dim ShowLog As Action =
Sub()
If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key)
ShellOnly("notepad", DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
@@ -911,39 +944,39 @@ NextStack:
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If
Case CrashReason.堆栈分析发现Mod名称
Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h")
Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h")
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h")
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.ModMixin失败
If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着该 Mod 存在 Bug,或与当前环境不兼容。\n\e\h")
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h")
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Else
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
End If
Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h")
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\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
@@ -1028,8 +1061,6 @@ NextStack:
End Select
Next
'整理多个原因
IsHandAnalyze = False
Return Join(Results, "\n\n此外,").
Replace("\n", vbCrLf).
Replace("\h", "").
@@ -1039,7 +1070,7 @@ NextStack:
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
End Function
End Class
@@ -8,9 +8,13 @@
''' </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 文件下载信息")
@@ -220,7 +224,7 @@
End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
Catch ex As Exception
Throw New Exception("版本列表解析失败", ex)
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
End Sub
''' <summary>
@@ -237,7 +241,7 @@
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Minecraft BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -288,6 +292,7 @@
''' </summary>
Public Value As List(Of DlOptiFineListEntry)
End Structure
Public Class DlOptiFineListEntry
''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
@@ -359,29 +364,33 @@
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Try
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("OptiFine 官方源版本列表解析失败(" & Result & ")", ex)
End Try
End Sub
''' <summary>
@@ -407,7 +416,7 @@
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("OptiFine BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -485,15 +494,61 @@
#Region "DlForgeVersion | Forge 版本列表"
Public Class DlForgeVersionEntry
Public MustInherit Class DlForgelikeEntry
Public IsNeoForge As Boolean
''' <summary>
''' 完整的版本名,如 “14.22.1.2478”。
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Version As String
Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary>
''' Forge:MC 版本是否小于 1.13。
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary>
Public VersionName As String
''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。
''' </summary>
Public Inherit As String
End Class
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary>
@@ -511,58 +566,21 @@
''' </summary>
Public Category As String
''' <summary>
''' 版本分支。若无分支则为 Nothing。
''' </summary>
Public Branch As String = Nothing
''' <summary>
''' 是否为新版 Forge。(即为 Minecraft 1.13+)
''' </summary>
Public ReadOnly Property IsNewType As Boolean
Get
Return Version.Split(".")(0) >= 20
End Get
End Property
''' <summary>
''' 构建数。
''' </summary>
Public ReadOnly Property Build As Integer
Get
Dim Version = Me.Version.Split(".")
If Version(0) < 15 Then
Return Version(Version.Count - 1)
Else
Return Version(Version.Count - 1) + 10000
End If
End Get
End Property
''' <summary>
''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
''' </summary>
Public ReadOnly Property FileVersion As String
Get
Return Version & If(Branch Is Nothing, "", "-" & Branch)
End Get
End Property
''' <summary>
''' 即将下载的文件全名。
''' </summary>
Public ReadOnly Property FileName As String
Get
Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
End Get
End Property
''' <summary>
''' 文件扩展名。
''' </summary>
Public ReadOnly Property FileSuffix As String
Get
If Category = "installer" Then
Return "jar"
Else
Return "zip"
End If
End Get
End Property
Public FileVersion As String
Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Version.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'为 DlForgelikeEntry 提供所有信息
IsNeoForge = False
VersionName = Version
Me.Version = New Version(Version)
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
''' <summary>
@@ -596,7 +614,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("没有可用版本")
@@ -620,8 +640,6 @@
'分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02"
@@ -651,13 +669,13 @@
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Catch ex As Exception
Throw New Exception("版本信息提取失败(" & VersionCode & ")", ex)
Throw New Exception("Forge 官方源版本信息提取失败(" & VersionCode & ")", ex)
End Try
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -667,7 +685,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)
@@ -700,20 +720,17 @@
End Select
Next
'获取 Entry
Dim Inherit As String = Loader.Input
Dim Branch As String = Token("branch")
Dim Name As String = Token("version")
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'基础信息获取
Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name}
Dim Entry = New DlForgeVersionEntry(Name, Branch, Loader.Input) With {.Hash = Hash, .Category = Category, .IsRecommended = Recommended = Name}
Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
'添加项
Versions.Add(Entry)
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -721,6 +738,132 @@
#End Region
#Region "DlNeoForgeList | NeoForge 版本列表"
Public Structure DlNeoForgeListResult
''' <summary>
''' 数据来源名称,如“Official”,“BMCLAPI”。
''' </summary>
Public SourceName As String
''' <summary>
''' 是否为官方的实时数据。
''' </summary>
Public IsOfficial As Boolean
''' <summary>
''' 所有版本的列表。已经按从新到老排序。
''' </summary>
Public Value As List(Of DlNeoForgeListEntry)
End Structure
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
Public IsBeta As Boolean
''' <summary>
''' API 使用的原始版本字符串,如 “20.4.30-beta”、“1.20.1-47.1.99”(Legacy)。
''' </summary>
Public ApiName As String
''' <summary>
''' 文件在官网的基础地址,不包含后缀。
''' </summary>
Public ReadOnly Property UrlBase As String
Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get
End Property
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
Version = New Version(ApiName.Before("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
End Class
''' <summary>
''' NeoForge 版本列表,主加载器。
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
}, Loader.IsForceRestarting)
End Select
End Sub
''' <summary>
''' NeoForge 版本列表,官方源。
''' </summary>
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "NeoForge 官方源",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge 官方源版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
''' <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))
'获取版本列表 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)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "BMCLAPI",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge BMCLAPI 版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions
End Function
#End Region
#Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult
@@ -741,6 +884,7 @@
''' </summary>
Public OfficialError As Exception
End Structure
Public Class DlLiteLoaderListEntry
''' <summary>
''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
@@ -820,7 +964,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -848,7 +992,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -906,7 +1050,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -921,7 +1065,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -944,25 +1088,25 @@
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
MojangBase.Replace("https://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
}
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
}
End Function
Public Function DlSourceLibraryGet(MojangBase 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
}
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
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase 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
}
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
}
End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 5
Public JavaListCacheVersion As Integer = 6
''' <summary>
''' 目前所有可用的 Java。
@@ -131,7 +131,9 @@
Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If
Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New Exception("分析详细信息失败,获取的版本为 " & Version.ToString)
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'基于 #3649,在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException
@@ -197,10 +199,15 @@
Setup.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
''' <summary>
''' 防止多个需要 Java 的部分同时要求下载 Java(#3797)。
''' </summary>
Public JavaLock As New Object
''' <summary>
''' 根据要求返回最适合的 Java,若找不到则返回 Nothing。
''' 最小与最大版本在与输入相同时也会通过。
''' 必须在工作线程调用。
''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
''' </summary>
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry
@@ -233,21 +240,25 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
End If
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
UserJava.Check()
@@ -460,8 +471,8 @@ NoUserJava:
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
'5. 最次级版本号更接近 51
@@ -601,22 +612,23 @@ NoUserJava:
'启动检查线程
Dim CheckThreads As New List(Of Thread)
For Each Entry In JavaEntries
Dim CheckThread As New Thread(Sub()
Try
Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString)
SyncLock ListLock
JavaCheckList.Add(Entry)
End SyncLock
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常,将被自动移除", LogLevel.Hint)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
End If
End Try
End Sub)
Dim CheckThread As New Thread(
Sub()
Try
Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString)
SyncLock ListLock
JavaCheckList.Add(Entry)
End SyncLock
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常,将被自动移除", LogLevel.Hint)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
End If
End Try
End Sub)
CheckThreads.Add(CheckThread)
CheckThread.Start()
Next
@@ -657,34 +669,18 @@ Wait:
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
If IsFullSearch OrElse
FolderInfo.Parent.Name.ToLower = "users" OrElse
SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse
SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse
SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse
SearchEntry.Contains("soft") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse
SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse
SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse
SearchEntry.Contains("game") OrElse SearchEntry.Contains("file") OrElse SearchEntry.Contains("data") OrElse
SearchEntry.Contains("jvm") OrElse SearchEntry.Contains("服务") OrElse SearchEntry.Contains("server") OrElse
SearchEntry.Contains("客户") OrElse SearchEntry.Contains("client") OrElse SearchEntry.Contains("整合") OrElse
SearchEntry.Contains("应用") OrElse SearchEntry.Contains("运行") OrElse SearchEntry.Contains("前置") OrElse
SearchEntry.Contains("mojang") OrElse SearchEntry.Contains("官启") OrElse SearchEntry.Contains("新建文件夹") OrElse
SearchEntry.Contains("eclipse") OrElse SearchEntry.Contains("microsoft") OrElse SearchEntry.Contains("hotspot") OrElse
SearchEntry.Contains("runtime") OrElse SearchEntry.Contains("x86") OrElse SearchEntry.Contains("x64") OrElse
SearchEntry.Contains("forge") OrElse SearchEntry.Contains("原版") OrElse SearchEntry.Contains("optifine") OrElse
SearchEntry.Contains("官方") OrElse SearchEntry.Contains("启动") OrElse SearchEntry.Contains("hmcl") OrElse
SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse
SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse
SearchEntry.Contains("version") OrElse SearchEntry.Contains("baka") OrElse SearchEntry.Contains("pcl") OrElse
SearchEntry.Contains("zulu") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127d64ec6") OrElse '官启文件夹
SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名
SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
@@ -113,10 +113,18 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}
If Setup.Get("LaunchArgumentRam") Then
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
'内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Case 1 '开启
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
Case 2 '关闭
End Select
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
@@ -358,7 +366,7 @@ NextInner:
Case McLoginType.Ms
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
Case McLoginType.Legacy
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0)
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Case McLoginType.Nide
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
Case McLoginType.Auth
@@ -368,7 +376,7 @@ NextInner:
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
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.Split("¨")(0)
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Return Nothing
End Function
''' <summary>
@@ -524,7 +532,10 @@ Relogin:
Dim AccessToken As String = MsLoginStep5(Tokens)
Data.Progress = 0.8
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep6(AccessToken)
MsLoginStep6(AccessToken)
Data.Progress = 0.9
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep7(AccessToken)
'输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken)
@@ -540,7 +551,7 @@ Relogin:
SkipLogin:
McLaunchLog("微软登录完成")
Setup.Set("HintBuy", True) '关闭正版购买提示
Data.Progress = 0.95
Data.Progress = 0.98
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
End Sub
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -797,14 +808,14 @@ LoginFinish:
'微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1")
If OsVersion <= New Version(10, 0, 17763, 0) Then
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 或加速器,然后再试。",
"登录完成后,网页会变得完全空白,把那个空白网页的网址复制到下面的框中就行了!" & 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
@@ -813,7 +824,7 @@ SystemBrowser:
Else
Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If
Hint("网页登录已完成,你现在可以关闭浏览器上的那个网页了", HintType.Finish)
Hint("网页登录成功,你可以关闭浏览器啦!", HintType.Finish)
Else
'Windows 10 登录
Dim ReturnCode As String = Nothing
@@ -926,12 +937,18 @@ SystemBrowser:
Try
Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
If ex.Message.Contains("2148916233") Then
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 Xbox 账户。" & vbCrLf &
"如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then
OpenWebsite("https://www.minecraft.net/")
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Message.Contains("2148916227") Then
MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup")
End If
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请尝试使用加速器或 VPN。", "登录失败", "我知道了")
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -979,29 +996,46 @@ SystemBrowser:
Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken
End Function
'微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep6(AccessToken As String) As String()
'微软登录步骤 6:验证微软账号是否持有 MC,这也会刷新 XGP
Private Sub MsLoginStep6(AccessToken As String)
McLaunchLog("开始微软登录步骤 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}})
Try
Dim ResultJson As JObject = GetJson(Result)
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select
Throw New Exception("$$")
End If
Catch ex As Exception
Log(ex, "微软登录第 6 步异常:" & Result)
Throw
End Try
End Sub
'微软登录步骤 7:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep7(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 7")
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}})
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 6 步汇报 429")
Log(ex, "微软登录第 7 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 6 步汇报 404")
RunInNewThread(Sub()
Select Case MyMsgBox("你可能没有创建 Minecraft 玩家档案、Xbox Game Pass 已到期,或者还没有购买 Minecraft。" & vbCrLf &
"请先使用官方启动器登录一次,之后即可使用 PCL 登录。", "登录失败", "创建档案", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select
End Sub, "Login Failed: Create Profile")
Log(ex, "微软登录第 7 步汇报 404")
RunInNewThread(
Sub()
Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
Else
Throw
@@ -1046,8 +1080,8 @@ SystemBrowser:
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
End Select
Return Uuid
@@ -1168,65 +1202,68 @@ SystemBrowser:
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
End If
'选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Exit Sub
End If
SyncLock JavaLock
'无合适的 Java
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 21, 0, 0) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7
If Not JavaDownloadConfirm("Java 7") Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101"
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 MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
Else
JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If
'选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Exit Sub
End If
'开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode)
Try
JavaLoader.Start(JavaCode, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
Loop
Finally
JavaLoader.Abort() '确保取消时中止 Java 下载
End Try
'无合适的 Java
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 21, 0, 0) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7
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 MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
Else
JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java,已取消启动!", HintType.Critical)
Throw New Exception("$$")
End If
'开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode)
Try
JavaLoader.Start(JavaCode, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
Loop
Finally
JavaLoader.Abort() '确保取消时中止 Java 下载
End Try
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java,已取消启动!", HintType.Critical)
Throw New Exception("$$")
End If
End SyncLock
End Sub
#End Region
@@ -1239,25 +1276,40 @@ SystemBrowser:
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
Dim BaseDir As String = GetJavaWrapperDir()
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper"))
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug)
Try
File.Delete(WrapperPath)
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex As Exception
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成")
WrapperPath = BaseDir & "\JavaWrapper2.jar"
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
End Try
End If
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息")
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
If (Path & "PCL").IsASCII() Then
Return Path & "PCL"
ElseIf 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
@@ -1341,7 +1393,7 @@ SystemBrowser:
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
@@ -1609,7 +1661,8 @@ NextVersion:
GameSize = New Size(875 - 2, 540 - 2)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
End If
@@ -1808,13 +1861,14 @@ NextVersion:
'1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none", If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本(包含 MC 1.1)的 McCodeMain 可能为 -1
'将最后两位改为大写,前面的部分保留
RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper
End If
If CurrentLang = RequiredLang Then
McLaunchLog($"当前语言为 {CurrentLang},无需修改")
McLaunchLog($"需要的语言为 {RequiredLang},当前语言为 {CurrentLang},无需修改")
Else
WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存
WriteIni(SetupFileAddress, "lang", RequiredLang)
@@ -1,4 +1,6 @@
Public Module ModMinecraft
Imports System.IO.Compression
Public Module ModMinecraft
#Region "文件夹"
@@ -149,7 +151,7 @@
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 27
Public Const McVersionCacheVersion As Integer = 30
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -288,7 +290,7 @@
Public ReadOnly Property Modable As Boolean
Get
If Not IsLoaded Then Load()
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse Version.HasNeoForge OrElse
DisplayType = McVersionCardType.API '#223
End Get
End Property
@@ -343,7 +345,7 @@
End If
Next
End If
'从 Forge Arguments 中获取版本号
'从 Forge / NeoForge Arguments 中获取版本号
If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then
Dim Mark As Boolean = False
For Each Argument In JsonObject("arguments")("game")
@@ -391,6 +393,29 @@
_Version.McName = JsonObject("jar").ToString
GoTo VersionSearchFinish
End If
'从 jar 文件的 version.json 中获取版本号
If File.Exists(Path & Name & ".jar") Then
Try
Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson IsNot Nothing Then
Using VersionJsonStream As New StreamReader(VersionJson.Open)
Dim VersionJsonObj As JObject = GetJson(VersionJsonStream.ReadToEnd)
If VersionJsonObj("id") IsNot Nothing Then
Dim VersionId As String = VersionJsonObj("id").ToString
If VersionId.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash,虽然我没发现
_Version.McName = VersionId
Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号:" & VersionId)
GoTo VersionSearchFinish
End If
End If
End Using
End If
End Using
Catch ex As Exception
Log(ex, "从版本 jar 中的 version.json 获取版本号失败")
End Try
End If
'非准确的版本判断警告
Log("[Minecraft] 无法完全确认 MC 版本号的版本:" & Name)
'从文件夹名中获取
@@ -690,8 +715,8 @@ Recheck:
'OptiFine
If RealJson.Contains("optifine") Then
State = McVersionState.OptiFine
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
Version.HasOptiFine = True
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
End If
'LiteLoader
If RealJson.Contains("liteloader") Then
@@ -702,14 +727,20 @@ Recheck:
'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对
If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then
State = McVersionState.Fabric
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
Version.HasFabric = True
ElseIf RealJson.Contains("minecraftforge") Then
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
ElseIf RealJson.Contains("minecraftforge") AndAlso Not RealJson.Contains("net.neoforge") Then
State = McVersionState.Forge
Version.HasForge = True
Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本")
Version.HasForge = True
ElseIf RealJson.Contains("net.neoforge") Then
'1.20.1 JSON 范例:"--fml.forgeVersion", "47.1.99"
'1.20.2+ JSON 范例:"--fml.neoForgeVersion", "20.6.119-beta"
State = McVersionState.NeoForge
Version.HasNeoForge = True
Version.NeoForgeVersion = If(RegexSeek(RealJson, "(?<=orgeVersion"",[^""]*?"")[^""]+(?="",)"), "未知版本")
End If
Version.IsApiLoaded = True
End Select
@@ -727,6 +758,8 @@ ExitDataLoad:
Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge
Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.NeoForge
Logo = PathImage & "Blocks/NeoForge.png"
Case McVersionState.Fabric
Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine
@@ -755,7 +788,7 @@ ExitDataLoad:
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
@@ -788,6 +821,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader)
WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionNeoForge", Version.NeoForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain)
@@ -827,6 +861,7 @@ ExitDataLoad:
OptiFine
Old
Forge
NeoForge
LiteLoader
Fabric
End Enum
@@ -878,6 +913,17 @@ ExitDataLoad:
''' </summary>
Public ForgeVersion As String = ""
'NeoForge
''' <summary>
''' 该版本是否安装了 NeoForge。
''' </summary>
Public HasNeoForge As Boolean = False
''' <summary>
''' NeoForge 版本号,如 21.0.2-beta、47.1.79。
''' </summary>
Public NeoForgeVersion As String = ""
'Fabric
''' <summary>
@@ -904,6 +950,7 @@ ExitDataLoad:
Public Overrides Function ToString() As String
ToString = ""
If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion)
If HasNeoForge Then ToString += ", NeoForge" & If(NeoForgeVersion = "未知版本", "", " " & NeoForgeVersion)
If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion)
If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion)
If HasLiteLoader Then ToString += ", LiteLoader"
@@ -930,15 +977,15 @@ ExitDataLoad:
Else
Throw New Exception("无效的 Fabric 版本:" & ForgeVersion)
End If
ElseIf HasForge Then
If ForgeVersion = "未知版本" Then Return 0
Dim SubVersions = ForgeVersion.Split(".")
ElseIf HasForge OrElse HasNeoForge Then
If ForgeVersion = "未知版本" AndAlso NeoForgeVersion = "未知版本" Then Return 0
Dim SubVersions = If(HasForge, ForgeVersion.Split("."), NeoForgeVersion.Split("."))
If SubVersions.Length = 4 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3))
ElseIf SubVersions.Length = 3 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2))
Else
Throw New Exception("无效的 Forge 版本:" & ForgeVersion)
Throw New Exception("无效的 Neo/Forge 版本:" & ForgeVersion)
End If
ElseIf HasOptiFine Then
If OptiFineVersion = "未知版本" Then Return 0
@@ -1034,7 +1081,7 @@ ExitDataLoad:
Dim Path As String = Loader.Input
Try
'初始化
McVersionList.Clear()
McVersionList = New Dictionary(Of McVersionCardType, List(Of McVersion))
'检测缓存是否需要更新
Dim FolderList As New List(Of String)
@@ -1075,10 +1122,10 @@ Reload:
'改变当前选择的版本
OnLoaded:
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '不能判断 Count = 0,这在只有错误版本时导致了误判
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
If Not SavedSelection = "" Then
If SavedSelection <> "" Then
For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList
For Each Version As McVersion In Card.Value
If Version.Name = SavedSelection AndAlso Not Version.State = McVersionState.Error Then
@@ -1150,6 +1197,7 @@ OnLoaded:
Dim VersionInfo As New McVersionInfo With {
.FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""),
.ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""),
.NeoForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionNeoForge", ""),
.OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""),
.HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False),
.SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1),
@@ -1158,9 +1206,10 @@ OnLoaded:
.McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1),
.IsApiLoaded = True
}
VersionInfo.HasFabric = VersionInfo.FabricVersion.Count > 1
VersionInfo.HasForge = VersionInfo.ForgeVersion.Count > 1
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Count > 1
VersionInfo.HasFabric = VersionInfo.FabricVersion.Any()
VersionInfo.HasForge = VersionInfo.ForgeVersion.Any()
VersionInfo.HasNeoForge = VersionInfo.NeoForgeVersion.Any()
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Any()
Version.Version = VersionInfo
End If
@@ -1190,7 +1239,7 @@ OnLoaded:
End Try
Next
ResultVersionList.Add(CardType, VersionList)
If VersionList.Any Then ResultVersionList.Add(CardType, VersionList)
Next
Return ResultVersionList
Catch ex As Exception
@@ -1200,10 +1249,14 @@ OnLoaded:
End Function
Private Function McVersionListLoadNoCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion))
Dim VersionList As New List(Of McVersion)
Dim ResultVersionList As New Dictionary(Of McVersionCardType, 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
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
Continue For
End If
If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
Continue For
@@ -1223,6 +1276,9 @@ OnLoaded:
Version.Load()
Next
#End Region
Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion))
#Region "将版本分类到各个卡片"
Try
@@ -1236,12 +1292,12 @@ OnLoaded:
Next
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
'预先筛选出愚人节的版本
'预先筛选出愚人节和错误的版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error)
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool)
'筛选 API 版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.NeoForge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
'将老版本预先分类入不常用,只剩余原版、快照、OptiFine
Dim VersionUseful As New List(Of McVersion)
@@ -1347,9 +1403,7 @@ OnLoaded:
Next
If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot)
'按版本号排序
Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left As McVersion, Right As McVersion)
Return Left.Version.McCodeMain > Right.Version.McCodeMain
End Function)
Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain)
'回设
If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot)
ResultVersionList(McVersionCardType.OriginalLike) = NewList
@@ -1357,43 +1411,47 @@ OnLoaded:
'不常用版本:按发布时间新旧排序,如果不可用则按名称排序
If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then
ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), Function(Left As McVersion, Right As McVersion)
Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
If LeftYear > 2000 AndAlso RightYear > 2000 Then
If LeftYear <> RightYear Then
Return LeftYear > RightYear
Else
Return Left.ReleaseTime > Right.ReleaseTime
End If
ElseIf LeftYear > 2000 AndAlso RightYear < 2000 Then
Return True
ElseIf LeftYear < 2000 AndAlso RightYear > 2000 Then
Return False
Else
Return Left.Name > Right.Name
End If
End Function)
ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish),
Function(Left As McVersion, Right As McVersion)
Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
If LeftYear > 2000 AndAlso RightYear > 2000 Then
If LeftYear <> RightYear Then
Return LeftYear > RightYear
Else
Return Left.ReleaseTime > Right.ReleaseTime
End If
ElseIf LeftYear > 2000 AndAlso RightYear < 2000 Then
Return True
ElseIf LeftYear < 2000 AndAlso RightYear > 2000 Then
Return False
Else
Return Left.Name > Right.Name
End If
End Function)
End If
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), Function(Left As McVersion, Right As McVersion)
Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName)
If Basic <> 0 Then
Return Basic > 0
Else
If Left.Version.HasFabric Xor Right.Version.HasFabric Then
Return Left.Version.HasFabric
ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then
Return Left.Version.HasForge
ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then
Return Left.Version.SortCode > Right.Version.SortCode
Else
Return Left.Name > Right.Name
End If
End If
End Function)
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
Function(Left As McVersion, Right As McVersion)
Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName)
If Basic <> 0 Then
Return Basic > 0
Else
If Left.Version.HasFabric Xor Right.Version.HasFabric Then
Return Left.Version.HasFabric
ElseIf Left.Version.HasNeoForge Xor Right.Version.HasNeoForge Then
Return Left.Version.HasNeoForge
ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then
Return Left.Version.HasForge
ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then
Return Left.Version.SortCode > Right.Version.SortCode
Else
Return Left.Name > Right.Name
End If
End If
End Function)
End If
#End Region
@@ -1417,17 +1475,7 @@ OnLoaded:
''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param>
''' <param name="CardType">卡片的名称。</param>
Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), ByRef Target As Dictionary(Of McVersionCardType, List(Of McVersion)), Formula As McVersionState(), CardType As McVersionCardType)
'将某种版本筛选出来
Dim KeepList As New List(Of McVersion)
For Each Version As McVersion In VersionList
For Each Type As Integer In Formula
If Type = Version.State Then
KeepList.Add(Version)
GoTo NextVersion
End If
Next
NextVersion:
Next
Dim KeepList = VersionList.Where(Function(v) Formula.Contains(v.State)).ToList
'加入版本列表,并从剩余中删除
If KeepList.Any Then
Target.Add(CardType, KeepList)
@@ -1443,13 +1491,8 @@ NextVersion:
''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param>
''' <param name="KeepList">传入需要增加入的列表。</param>
Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), Formula As McVersionState(), ByRef KeepList As List(Of McVersion))
For Each Version As McVersion In VersionList
For Each Type As McVersionState In Formula
If Type <> Version.State Then Continue For
KeepList.Add(Version) : Exit For
Next
NextVersion:
Next
KeepList.AddRange(VersionList.Where(Function(v) Formula.Contains(v.State)))
'加入版本列表,并从剩余中删除
If KeepList.Any Then
For Each Version As McVersion In KeepList
VersionList.Remove(Version)
@@ -1632,7 +1675,7 @@ NextVersion:
Return _Url
End Get
Set(value As String)
'孤儿 Forge 作者喜欢把没有的 URL 写个空字符串
'孤儿 Forge 作者喜欢把没有 URL 的写个空字符串
_Url = If(String.IsNullOrWhiteSpace(value), Nothing, value)
End Set
End Property
@@ -1649,15 +1692,6 @@ NextVersion:
End Get
End Property
''' <summary>
''' 原 Json 中 Name 项最后一部分的版本号。
''' </summary>
Public ReadOnly Property Version As String
Get
Dim Splited = OriginalName.Split(":")
Return Splited(Splited.Count - 1)
End Get
End Property
''' <summary>
''' 原 Json 中的 Name 项。
''' </summary>
Public OriginalName As String
@@ -1738,7 +1772,7 @@ NextVersion:
'根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then
If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
@@ -1823,13 +1857,14 @@ NextVersion:
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End If
@@ -1863,15 +1898,25 @@ NextVersion:
'去重
Dim ResultArray As New Dictionary(Of String, McLibToken)
Dim GetVersion =
Function(Token As McLibToken) As String
'测试例:
'D:\Minecraft\test\libraries\net\neoforged\mergetool\2.0.0\mergetool-2.0.0-api.jar
'D:\Minecraft\test\libraries\org\apache\commons\commons-collections4\4.2\commons-collections4-4.2.jar
'D:\Minecraft\test\libraries\com\google\guava\guava\31.1-jre\guava-31.1-jre.jar
Return GetFolderNameFromPath(GetPathFromFullPath(Token.LocalPath))
End Function
For i = 0 To BasicArray.Count - 1
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString
If ResultArray.ContainsKey(Key) Then
If BasicArray(i).Version <> ResultArray(Key).Version AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)}")
Dim BasicArrayVersion As String = GetVersion(BasicArray(i))
Dim ResultArrayVersion As String = GetVersion(ResultArray(Key))
If BasicArrayVersion <> ResultArrayVersion AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion})")
ResultArray.Add(Key & GetUuid(), BasicArray(i))
Else
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)},已忽略其中之一")
If VersionSortBoolean(BasicArray(i).Version, ResultArray(Key).Version) Then
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion}),已忽略其中之一")
If VersionSortBoolean(BasicArrayVersion, ResultArrayVersion) Then
ResultArray(Key) = BasicArray(i)
End If
End If
@@ -1931,6 +1976,7 @@ NextVersion:
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 登录转接
@@ -1980,8 +2026,13 @@ NextVersion:
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("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then
Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
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/").
Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven"))
End If
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
@@ -887,11 +887,11 @@ Finished:
ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim Hash = ModEntry.ModrinthHash
If Cache.ContainsKey(Hash) Then
ModEntry.FromJson(Cache(Hash))
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next
@@ -923,21 +923,16 @@ Finished:
Throw
End Try
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 3
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
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim McVersions As New List(Of String) From {TargetMcVersion.McName}
Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
@@ -948,7 +943,7 @@ Finished:
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}")
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
@@ -991,8 +986,8 @@ Finished:
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -1001,11 +996,11 @@ Finished:
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}")
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"}
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"}
Entry.UpdateFile = UpdateFile
End If
Next
@@ -1073,7 +1068,7 @@ Finished:
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配
If McVersion <> IndexVersion 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
@@ -1136,10 +1131,19 @@ Finished:
If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash) = Entry.ToJson()
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)))
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
#If DEBUG Then
''' <summary>
@@ -25,6 +25,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 +36,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("/")
@@ -183,6 +183,7 @@ Retry:
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
@@ -194,16 +195,25 @@ Retry:
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)
End Try
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Try
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
NeoForgeVersion = Id.Replace("neoforge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Split("-")(1)
FabricVersion = Id.Replace("fabric-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
@@ -271,19 +281,23 @@ Retry:
'建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断是资源包还是 Mod
Dim IsResourcePack As Boolean
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String
If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
File.FileName.EndsWithF(".jar", True) Then
TargetFolder = "mods"
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks"
Else
TargetFolder = "shaderpacks"
End If
Else
IsResourcePack = False
TargetFolder = "mods"
End If
'实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -301,6 +315,7 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
@@ -368,6 +383,7 @@ Retry:
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower
@@ -376,6 +392,9 @@ Retry:
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
@@ -447,6 +466,7 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
@@ -676,6 +696,8 @@ Retry:
Request.MinecraftName = Component("version")
Case "net.minecraftforge"
Request.ForgeVersion = Component("version")
Case "net.neoforged"
Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
@@ -772,6 +794,7 @@ Retry:
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
@@ -348,6 +348,7 @@
'崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……")
FeedbackInfo()
RunInNewThread(Sub()
Try
Thread.Sleep(2000)
@@ -195,6 +195,7 @@ RetryStart:
Private Shared Swiping As Boolean = False
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除(#3824)
'开始滑动
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Index
@@ -204,6 +205,7 @@ RetryStart:
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
End Sub
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除(#3824)
'结束滑动
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
Swiping = False
@@ -0,0 +1,3 @@
Public Module ModDevelop
End Module
+33 -24
View File
@@ -21,28 +21,38 @@
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
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Else
Data(0) = McVersionCurrent.Name
End If
End If
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
@@ -73,8 +83,8 @@
Case "切换页面"
FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
Case "导入整合包"
RunInThread(Sub() ModpackInstall())
Case "导入整合包", "安装整合包"
RunInUi(Sub() ModpackInstall())
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
@@ -101,8 +111,7 @@
'网页确认
If RelativeUrl.StartsWithF("http", True) Then
If RunInUi() Then
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性!")
End If
'获取文件名
Dim RawFileName As String
+878
View File
@@ -0,0 +1,878 @@
Imports System.Windows.Interop
Imports System.Windows.Threading
Public Module ModMain
#Region "弹出提示"
''' <summary>
''' 提示信息的种类。
''' </summary>
Public Enum HintType
''' <summary>
''' 信息,通常是蓝色的“i”。
''' </summary>
''' <remarks></remarks>
Info
''' <summary>
''' 已完成,通常是绿色的“√”。
''' </summary>
''' <remarks></remarks>
Finish
''' <summary>
''' 错误,通常是红色的“×”。
''' </summary>
''' <remarks></remarks>
Critical
End Enum
Private Structure HintMessage
Public Text As String
Public Type As HintType
Public Log As Boolean
End Structure
''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary>
Private HintWaiting As List(Of HintMessage) = If(HintWaiting, New List(Of HintMessage))
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New List(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
Private Sub HintTick()
Try
'Tag 存储了:{ 是否可以重用, Uuid }
If Not HintWaiting.Any() Then Exit Sub
Do While HintWaiting.Any
''清除空提示
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
' HintWaiting.RemoveAt(0)
' Continue Do
'End If
Dim CurrentHint = HintWaiting(0)
'去回车
CurrentHint.Text = CurrentHint.Text.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
'超量提示直接忽略
If FrmMain.PanHint.Children.Count >= 20 Then GoTo EndHint
'检查是否有重复提示
Dim DoubleStack As Border = Nothing
For Each stack As Border In FrmMain.PanHint.Children
If stack.Tag(0) AndAlso CType(stack.Child, TextBlock).Text = CurrentHint.Text Then DoubleStack = stack
Next
'获取渐变颜色
Dim TargetColor0, TargetColor1 As MyColor
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)
Case HintType.Finish
TargetColor0 = New MyColor(33, 177, 33)
TargetColor1 = New MyColor(29, 160, 29)
Case Else 'HintType.Critical
TargetColor0 = New MyColor(255, 53, 11)
TargetColor1 = New MyColor(255, 43, 0)
End Select
If Not IsNothing(DoubleStack) Then
'有重复提示,且该提示的进入动画已播放
If Not AniIsRun("Hint Show " & DoubleStack.Tag(1)) Then
AniStop("Hint Hide " & DoubleStack.Tag(1))
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
AniStart({
AaX(DoubleStack, -12 - DoubleStack.Margin.Left, 50,, New AniEaseOutFluent),
AaX(DoubleStack, -8, 50, 50, New AniEaseInFluent),
AaX(DoubleStack, 8, 50, 100, New AniEaseOutFluent),
AaX(DoubleStack, -8, 50, 150, New AniEaseInFluent),
AaDouble(Sub(i)
Percent += i
Dim Gradient As LinearGradientBrush = DoubleStack.Background
Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
End Sub, 0.7, 250),
AaX(DoubleStack, -50, 200, Delay, New AniEaseInFluent),
AaOpacity(DoubleStack, -1, 150, Delay),
AaCode(Sub() DoubleStack.Tag(0) = False, Delay),
AaHeight(DoubleStack, -26, 100,, New AniEaseOutFluent, True),
AaCode(Sub() FrmMain.PanHint.Children.Remove(DoubleStack), , True)
}, "Hint Hide " & DoubleStack.Tag(1))
End If
Else
'准备控件
Dim NewHintControl As New Border With {.Tag = {True, GetUuid()}, .Margin = New Thickness(-70, 0, 20, 0), .Opacity = 0, .Height = 0, .HorizontalAlignment = HorizontalAlignment.Left, .CornerRadius = New CornerRadius(0, 6, 6, 0)}
NewHintControl.Background = New LinearGradientBrush(New GradientStopCollection(New List(Of GradientStop) From {
New GradientStop(TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 0),
New GradientStop(TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 1)}), 90)
NewHintControl.Child = New TextBlock With {.TextTrimming = TextTrimming.CharacterEllipsis, .FontSize = 13, .Text = CurrentHint.Text, .Foreground = New MyColor(255, 255, 255), .Margin = New Thickness(33, 5, 8, 5)}
'AddHandler NewHintControl.MouseLeftButtonDown, AddressOf HideAllHint
FrmMain.PanHint.Children.Add(NewHintControl)
'控件动画
Dim Animations As New List(Of AniData)
If FrmMain.PanHint.Children.Count > 1 Then
'已有提示
Animations.Add(AaHeight(NewHintControl, 26, 150, , New AniEaseOutFluent))
Else
'是唯一提示
NewHintControl.Height = 26
End If
'开始动画
Animations.AddRange({
AaX(NewHintControl, 30, 400, , New AniEaseOutElastic(AniEasePower.Weak)),
AaX(NewHintControl, 20, 200, , New AniEaseOutFluent),
AaOpacity(NewHintControl, 1, 100),
AaDouble(Sub(i)
Percent += i
Dim Gradient As LinearGradientBrush = NewHintControl.Background
Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
End Sub, 0.7, 250, 100)
})
AniStart(Animations, "Hint Show " & NewHintControl.Tag(1))
'结束动画
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
AniStart({
AaX(NewHintControl, -50, 200, Delay, New AniEaseInFluent),
AaOpacity(NewHintControl, -1, 150, Delay),
AaCode(Sub() NewHintControl.Tag(0) = False, Delay),
AaHeight(NewHintControl, -26, 100,, New AniEaseOutFluent, True),
AaCode(Sub() FrmMain.PanHint.Children.Remove(NewHintControl), , True)
}, "Hint Hide " & NewHintControl.Tag(1))
End If
'结束处理
EndHint:
If CurrentHint.Log Then Log("[UI] 弹出提示:" & CurrentHint.Text)
HintWaiting.RemoveAt(0)
Loop
Catch ex As Exception
Log(ex, "显示弹出提示失败", LogLevel.Normal)
End Try
End Sub
Private Sub HideAllHint()
For Each Control As Border In FrmMain.PanHint.Children
Control.IsHitTestVisible = False
AniStart({
AaX(Control, -50, 200, , New AniEaseInFluent),
AaOpacity(Control, -1, 150, , New AniEaseInFluent),
AaCode(Sub() Control.Tag(0) = False),
AaHeight(Control, -26, 100,, New AniEaseOutFluent, True),
AaCode(Sub() FrmMain.PanHint.Children.Remove(Control), , True)
}, "Hint Hide " & Control.Tag(1))
Next
End Sub
#End Region
#Region "弹窗"
''' <summary>
''' 存储弹窗信息的转换器。
''' </summary>
Public Class MyMsgBoxConverter
Public Type As MyMsgBoxType
Public Title As String
Public Text As String
''' <summary>
''' 输入框模式:文本框的文本;选择模式:需要放进去的 List(Of MyListItem)。
''' </summary>
Public Content As Object
''' <summary>
''' 仅输入框模式:输入验证规则。
''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate)
''' <summary>
''' 仅输入框模式:提示文本。
''' </summary>
Public HintText As String = ""
''' <summary>
''' 有多个按钮时,是否给第一个按钮加高亮。
''' </summary>
Public HighLight As Boolean
Public Button1 As String = "确定"
Public Button2 As String = ""
Public Button3 As String = ""
''' <summary>
''' 点击第一个按钮将执行该方法,不关闭弹窗。
''' </summary>
Public Button1Action As Action = Nothing
''' <summary>
''' 点击第二个按钮将执行该方法,不关闭弹窗。
''' </summary>
Public Button2Action As Action = Nothing
''' <summary>
''' 点击第三个按钮将执行该方法,不关闭弹窗。
''' </summary>
Public Button3Action As Action = Nothing
Public IsWarn As Boolean = False
Public ForceWait As Boolean = False
Public WaitFrame As New DispatcherFrame(True)
''' <summary>
''' 弹窗是否已经关闭。
''' </summary>
Public IsExited As Boolean = False
''' <summary>
''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮,则为 Nothing。
''' </summary>
Public Result As Object
End Class
Public Enum MyMsgBoxType
Text
[Select]
Input
End Enum
''' <summary>
''' 显示弹窗,返回点击按钮的编号(从 1 开始)。
''' </summary>
''' <param name="Title">弹窗的标题。</param>
''' <param name="Caption">弹窗的内容。</param>
''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为空。</param>
''' <param name="Button3">显示的第三个按钮,默认为空。</param>
''' <param name="Button1Action">点击第一个按钮将执行该方法,不关闭弹窗。</param>
''' <param name="Button2Action">点击第二个按钮将执行该方法,不关闭弹窗。</param>
''' <param name="Button3Action">点击第三个按钮将执行该方法,不关闭弹窗。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
Public Function MyMsgBox(Caption As String, Optional Title As String = "提示",
Optional Button1 As String = "确定", Optional Button2 As String = "", Optional Button3 As String = "",
Optional IsWarn As Boolean = False, Optional HighLight As Boolean = True, Optional ForceWait As Boolean = False,
Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
WaitingMyMsgBox.Add(Converter)
If RunInUi() Then
'若为 UI 线程,立即执行弹窗刻, 避免快速(连点器)点击时多次弹窗
MyMsgBoxTick()
End If
If Button2.Length > 0 OrElse ForceWait Then
'若有多个按钮则开始等待
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
'主窗体尚未加载,用老土的弹窗来替代
WaitingMyMsgBox.Remove(Converter)
If Button2.Length > 0 Then
Dim RawResult As MsgBoxResult = MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Select Case RawResult
Case MsgBoxResult.Yes
Converter.Result = 1
Case MsgBoxResult.No
Converter.Result = 2
Case MsgBoxResult.Cancel
Converter.Result = 3
End Select
Else
MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Converter.Result = 1
End If
Log("[Control] 主窗体加载完成前出现意料外的等待弹窗:" & Button1 & "," & Button2 & "," & Button3, LogLevel.Debug)
Else
Try
FrmMain.DragStop()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
ComponentDispatcher.PopModal()
End Try
End If
Log("[Control] 普通弹框返回:" & If(Converter.Result, "null"))
Return Converter.Result
Else
'不进行等待,直接返回
Return 1
End If
End Function
''' <summary>
''' 显示输入框并返回输入的文本。若点击第二个按钮,则返回 Nothing。
''' </summary>
''' <param name="Title">弹窗的标题。</param>
''' <param name="ValidateRules">文本框的输入检测。</param>
''' <param name="Text">弹窗的介绍文本。</param>
''' <param name="DefaultInput">文本框的默认内容。</param>
''' <param name="HintText">文本框的提示内容。</param>
''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
Public Function MyMsgBoxInput(Title As String, Optional Text As String = "", Optional DefaultInput As String = "", Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Text = Text, .HintText = HintText, .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter)
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
ComponentDispatcher.PopModal()
End Try
Log("[Control] 输入弹框返回:" & If(Converter.Result, "null"))
Return Converter.Result
End Function
''' <summary>
''' 显示选择框并返回选择的第几项(从 0 开始)。若点击第二个按钮,则返回 Nothing。
''' </summary>
''' <param name="Title">弹窗的标题。</param>
''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为空。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter)
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame)
Finally
ComponentDispatcher.PopModal()
End Try
Log("[Control] 选择弹框返回:" & If(Converter.Result, "null"))
Return Converter.Result
End Function
''' <summary>
''' 等待显示的弹窗。
''' </summary>
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
Public Sub MyMsgBoxTick()
Try
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Exit Sub
If FrmMain.PanMsg.Children.Count > 0 Then
'弹窗中
FrmMain.PanMsg.Visibility = Visibility.Visible
ElseIf WaitingMyMsgBox.Any Then
'没有弹窗,显示一个等待的弹窗
FrmMain.PanMsg.Visibility = Visibility.Visible
Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
Case MyMsgBoxType.Input
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Select
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
End Select
WaitingMyMsgBox.RemoveAt(0)
Else
'没有弹窗,没有等待的弹窗
If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
End Try
End Sub
#End Region
#Region "页面声明"
'在最后进行页面声明,避免颜色尚未加载完毕
'窗体声明
Public FrmMain As FormMain
Public FrmStart As SplashScreen
'页面声明(出于单元测试考虑,初始化页面已转入 FormMain 中)
Public FrmLaunchLeft As PageLaunchLeft
Public FrmLaunchRight As PageLaunchRight
Public FrmSelectLeft As PageSelectLeft
Public FrmSelectRight As PageSelectRight
Public FrmSpeedLeft As PageSpeedLeft
Public FrmSpeedRight As PageSpeedRight
'联机页面声明
Public FrmLinkLeft As PageLinkLeft
Public FrmLinkIoi As PageLinkIoi
Public FrmLinkHiper As PageLinkHiper
Public FrmLinkHelp As PageOtherHelpDetail
Public FrmLinkFeedback As PageLinkFeedback
'下载页面声明
Public FrmDownloadLeft As PageDownloadLeft
Public FrmDownloadInstall As PageDownloadInstall
Public FrmDownloadClient As PageDownloadClient
Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack
'设置页面声明
Public FrmSetupLeft As PageSetupLeft
Public FrmSetupLaunch As PageSetupLaunch
Public FrmSetupUI As PageSetupUI
Public FrmSetupSystem As PageSetupSystem
Public FrmSetupLink As PageSetupLink
'其他页面声明
Public FrmOtherLeft As PageOtherLeft
Public FrmOtherHelp As PageOtherHelp
Public FrmOtherAbout As PageOtherAbout
Public FrmOtherTest As PageOtherTest
'登录页面声明
Public FrmLoginLegacy As PageLoginLegacy
Public FrmLoginNide As PageLoginNide
Public FrmLoginNideSkin As PageLoginNideSkin
Public FrmLoginAuth As PageLoginAuth
Public FrmLoginAuthSkin As PageLoginAuthSkin
Public FrmLoginMs As PageLoginMs
Public FrmLoginMsSkin As PageLoginMsSkin
'版本设置页面声明
Public FrmVersionLeft As PageVersionLeft
Public FrmVersionOverall As PageVersionOverall
Public FrmVersionMod As PageVersionMod
Public FrmVersionModDisabled As PageVersionModDisabled
Public FrmVersionSetup As PageVersionSetup
'资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail
#End Region
#Region "帮助"
Public Class HelpEntry
'基础
''' <summary>
''' 显示标题。
''' </summary>
Public Title As String
''' <summary>
''' 显示描述。
''' </summary>
Public Desc As String
''' <summary>
''' 检索关键字。
''' </summary>
Public Search As String
''' <summary>
''' 用于分类的标签列表。
''' </summary>
Public Types As List(Of String)
'显示(可选)
''' <summary>
''' 帮助项的自定义图标。可能为 Nothing。
''' </summary>
Public Logo As String = Nothing
''' <summary>
''' 是否显示在搜索结果。默认为 True。
''' </summary>
Public ShowInSearch As Boolean = True
''' <summary>
''' 是否在公开版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
''' </summary>
Public ShowInPublic As Boolean = True
''' <summary>
''' 是否在快照版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
''' </summary>
Public ShowInSnapshot As Boolean = True
'动作
''' <summary>
''' 是否为 “执行事件”。
''' </summary>
Public IsEvent As Boolean
Public EventType As String
Public EventData As String
''' <summary>
''' 若非执行事件,其对应的 .xaml 本地文件内容。
''' </summary>
Public XamlContent As String
'转换
''' <summary>
''' 从文件初始化 HelpEntry 对象,失败会抛出异常。
''' </summary>
Public Sub New(FilePath As String)
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息
If JsonData("Title") IsNot Nothing Then
Title = JsonData("Title")
Else
Throw New ArgumentException("未找到 Title 项")
End If
Desc = If(JsonData("Description"), "")
Search = If(JsonData("Keywords"), "")
Logo = JsonData("Logo") '为保持 Nothing,不要加 If
ShowInSearch = If(JsonData("ShowInSearch"), ShowInSearch)
ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
Types = New List(Of String)
For Each NameOfType In If(JsonData("Types"), GetJson("[]"))
Types.Add(NameOfType)
Next
'加载事件信息
If If(JsonData("IsEvent"), False) Then
EventType = JsonData("EventType")
If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
EventData = If(JsonData("EventData"), "")
IsEvent = True
Else
Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml")
If File.Exists(XamlAddress) Then
XamlContent = ReadFile(XamlAddress)
IsEvent = False
Else
Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件(" & XamlAddress & ")")
End If
End If
End Sub
''' <summary>
''' 获取该 HelpEntry 对应的 MyListItem。
''' </summary>
Public Function ToListItem() As MyListItem
Return SetToListItem(New MyListItem)
End Function
''' <summary>
''' 将属性设置入一个现有的 ListItem。
''' </summary>
Public Function SetToListItem(Item As MyListItem) As MyListItem
Dim Logo As String
If IsEvent Then
If EventType = "弹出窗口" Then
Logo = PathImage & "Blocks/GrassPath.png"
Else
Logo = PathImage & "Blocks/CommandBlock.png"
End If
Else
Logo = PathImage & "Blocks/Grass.png"
End If
'设置属性
With Item
.SnapsToDevicePixels = True
.Title = Title
.Info = Desc
.Logo = If(Me.Logo, Logo)
.Height = 42
.Type = MyListItem.CheckType.Clickable
.Tag = Me
.EventType = Nothing
.EventData = Nothing
End With
'项目的点击事件
AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
Return Item
End Function
End Class
Public HelpLoader As New LoaderTask(Of Integer, List(Of HelpEntry))("Help Page", AddressOf HelpLoad,, ThreadPriority.BelowNormal)
Private ReadOnly HelpLoadLock As New Object
''' <summary>
''' 初始化帮助列表对象。
''' </summary>
Private Sub HelpLoad(Loader As LoaderTask(Of Integer, List(Of HelpEntry)))
SyncLock HelpLoadLock '避免重复解压文件导致出错
Try
'解压内置文件
HelpTryExtract()
'遍历文件
Dim FileList As New List(Of String)
Try
Dim IgnoreList As New List(Of String)
'读取自定义文件
If Directory.Exists(Path & "PCL\Help\") Then
For Each File In EnumerateFiles(Path & "PCL\Help\")
Select Case File.Extension.ToLower
Case ".helpignore"
'加载忽略列表
Log("[Help] 发现 .helpignore 文件:" & File.FullName)
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
Dim RealString As String = Line.Before("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString)
Next
Case ".json"
FileList.Add(File.FullName)
End Select
Next
End If
Log("[Help] 已扫描 PCL 文件夹下的帮助文件,目前总计 " & FileList.Count & " 条")
'读取自带文件
For Each File In EnumerateFiles(PathTemp & "Help")
'跳过非 json 文件与以 . 开头的文件夹
If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
'检查忽略列表
Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
For Each Ignore In IgnoreList
If RegexCheck(RealPath, Ignore) Then
If ModeDebug Then Log("[Help] 已忽略 " & RealPath & ":" & Ignore)
GoTo NextFile
End If
Next
FileList.Add(File.FullName)
NextFile:
Next
Log("[Help] 已扫描缓存文件夹下的帮助文件,目前总计 " & FileList.Count & " 条")
Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
End Try
If Loader.IsAborted Then Exit Sub
'将文件实例化
Dim Dict As New List(Of HelpEntry)
For Each FilePath As String In FileList
Try
Dim Entry As New HelpEntry(FilePath)
Dict.Add(Entry)
If ModeDebug Then Log("[Help] 已加载的帮助条目:" & Entry.Title & " ← " & FilePath)
Catch ex As Exception
Log(ex, "初始化帮助条目失败(" & FilePath & ")", LogLevel.Msgbox)
End Try
Next
'回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsAborted Then Exit Sub
Loader.Output = Dict
Catch ex As Exception
Log(ex, "帮助列表初始化失败")
Throw
End Try
End SyncLock
End Sub
''' <summary>
''' 尝试解压内置帮助文件。
''' </summary>
Public Sub HelpTryExtract()
If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help")
Directory.CreateDirectory(PathTemp & "Help")
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8)
Setup.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
End If
End Sub
''' <summary>
''' 对帮助文件约定的替换标记进行处理,如果遇到需要转义的字符会进行转义。
''' </summary>
Public Function HelpArgumentReplace(Xaml As String) As String
Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomHint()), "\{hint\}")
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomCave()), "\{cave\}")
Return Result
End Function
#End Region
#Region "愚人节"
Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1
Public IsAprilGiveup As Boolean = False
Private AprilSpeed As New Vector(0, 0)
Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
Private AprilDistance As Integer = 0
Private Sub TimerFool()
Try
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Exit Sub
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Exit Sub
'计算是否空闲
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
If MousePos = AprilMousePosLast Then
AprilIdieCount += 1
Else
AprilMousePosLast = MousePos
AprilIdieCount = 0
End If
'计算躲避移动
Dim Direction As Vector
Dim Distance As Double
Dim ButtonWidth = FrmLaunchLeft.BtnLaunch.ActualWidth / 2, ButtonHeight = FrmLaunchLeft.BtnLaunch.ActualHeight / 2
Dim Vec As Vector = FrmMain.lastMouseArg.GetPosition(FrmLaunchLeft.BtnLaunch) - New Vector(ButtonWidth, ButtonHeight)
Dim Dir As New Vector(Vec.X, Vec.Y)
Dir.Normalize()
Direction = -Dir
Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度
'计算回归移动
If AprilIdieCount >= 64 * 5 Then
Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
Acc -= Back * 0.0005
Back.Normalize()
Acc -= Back * 0.15
End If
End If
'回到边界
Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
If Relative.X < -ButtonWidth * 2 Then
FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
AprilSpeed.X -= 80
If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
End If
ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
AprilSpeed.X += 80
If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
End If
ElseIf Relative.Y < -ButtonHeight * 2 Then
FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
AprilSpeed.Y -= 25
If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
End If
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
AprilSpeed.Y += 25
If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
End If
End If
'移动
AprilSpeed = AprilSpeed * 0.8 + Acc
Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
If SpeedValue < 0.01 Then Exit Sub
AprilSpeed.Normalize()
AprilSpeed *= SpeedValue
AprilDistance += SpeedValue
FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X
FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y
'大小改变
FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
'放弃提示
If AprilDistance > 4000 Then
AprilDistance = -4000
Select Case RandomInteger(0, 3)
Case 0
Hint("放弃吧!只需要点一下右下角的小白旗……")
Case 1
Hint("看到右下角的那面小白旗了吗?")
Case 2
Hint("这里建议点一下右下角的小白旗投降呢.jpg")
Case 3
Hint("右下角的小白旗永远等着你……")
End Select
End If
Catch ex As Exception
Log(ex, "愚人节移动出错", LogLevel.Feedback)
End Try
End Sub
#End Region
#Region "系统"
''' <summary>
''' 把某个 PCL 窗口拖到最前面。
''' </summary>
Public Sub ShowWindowToTop(Handle As IntPtr)
Try
PostMessage(Handle, 400 * 16 + 2, 0, 0)
SetForegroundWindow(Handle) '不在这里放不行,神秘 WinAPI,建议别动
Catch ex As Exception
Log(ex, "设置窗口置顶失败", LogLevel.Hint)
End Try
End Sub
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
#End Region
Public DragControl = Nothing
Private Timer4Count As Integer = 0
Private Timer150Count As Integer = 0
Private Sub TimerMain()
Try
#Region "每 50ms 执行一次的代码"
HintTick()
MyMsgBoxTick()
FrmMain.DragTick()
LoaderTaskbarProgressRefresh()
If ThemeDontClick = 2 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "短程主时钟执行异常", LogLevel.Assert)
End Try
Timer4Count += 1
If Timer4Count = 4 Then
Timer4Count = 0
Try
#Region "每 250ms 执行一次的代码"
If ThemeNow = 12 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "中程主时钟执行异常", LogLevel.Debug)
End Try
End If
Timer150Count += 1
If Timer150Count = 150 Then
Timer150Count = 0
Try
#Region "每 7.5s 执行一次的代码"
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
'以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
RunInUi(Sub()
If Not FrmMain.Hidden Then
If FrmMain.Top < -9000 Then FrmMain.Top = 100
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
End If
End Sub)
#End Region
Catch ex As Exception
Log(ex, "长程主时钟执行异常", LogLevel.Assert)
End Try
End If
End Sub
Public Sub TimerMainStart()
RunInNewThread(
Sub()
Try
Do While True
RunInUiWait(AddressOf TimerMain)
Thread.Sleep(50 * 0.98)
Loop
Catch ex As Exception
Log(ex, "程序主时钟出错", LogLevel.Feedback)
End Try
End Sub, "Timer Main")
If Not IsAprilEnabled Then Exit Sub
RunInNewThread(
Sub()
Try
Dim LastTime = My.Computer.Clock.TickCount
Do While True
If LastTime <> My.Computer.Clock.TickCount Then
LastTime = My.Computer.Clock.TickCount
RunInUiWait(AddressOf TimerFool)
End If
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "愚人节主时钟出错", LogLevel.Feedback)
End Try
End Sub, "Timer Main Fool")
End Sub
End Module
+31 -19
View File
@@ -1,6 +1,4 @@
Imports System.Security.Cryptography
Public Module ModMusic
Public Module ModMusic
#Region "播放列表"
@@ -71,16 +69,25 @@ Public Module ModMusic
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键播放,右键播放下一曲。"
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
@@ -117,13 +124,14 @@ Public Module ModMusic
''' </summary>
Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then
Hint("播放列表中仅有一首歌曲!")
MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
MusicRefreshUI()
End If
MusicRefreshUI()
End Sub
#End Region
@@ -199,13 +207,15 @@ Public Module ModMusic
''' </summary>
Public Function MusicPause() As Boolean
If MusicState = MusicStates.Play Then
RunInThread(Sub()
MusicNAudio.Pause()
MusicRefreshUI()
Log("[Music] 已暂停播放")
End Sub)
RunInThread(
Sub()
Log("[Music] 已暂停播放")
MusicNAudio?.Pause()
MusicRefreshUI()
End Sub)
Return True
Else
Log($"[Music] 无需暂停播放,当前状态为 {MusicState}")
Return False
End If
End Function
@@ -214,13 +224,15 @@ Public Module ModMusic
''' </summary>
Public Function MusicResume() As Boolean
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Log($"[Music] 无需继续播放,当前状态为 {MusicState}")
Return False
Else
RunInThread(Sub()
MusicNAudio.Play()
MusicRefreshUI()
Log("[Music] 已恢复播放")
End Sub)
RunInThread(
Sub()
Log("[Music] 已恢复播放")
MusicNAudio?.Play()
MusicRefreshUI()
End Sub)
Return True
End If
End Function
+282
View File
@@ -0,0 +1,282 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net
Imports System.Reflection
Imports System.Security.Cryptography
Friend Module ModSecret
#Region "杂项"
'在开源内容的注册表键与普通内容的注册表键隔离
Public Const RegFolder As String = "PCLDebug"
Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'确保 .NET Framework 版本
Try
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
Catch ex As UriFormatException '修复 #3555
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
End Try
'检测当前文件夹权限
Try
Directory.CreateDirectory(Path & "PCL")
Catch ex As Exception
MsgBox($"PCL 无法创建 PCL 文件夹({Path & "PCL"}),请尝试:" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel)
End Try
If Not CheckPermission(Path & "PCL") Then
MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel)
End If
'开源版本提示
MyMsgBox($"该版本中不包含以下特性:
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中)
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
End Sub
''' <summary>
''' 获取设备标识码。
''' </summary>
Friend Function SecretGetUniqueAddress() As String
Return "0000-0000-0000-0000"
End Function
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
End Sub
''' <summary>
''' 打码字符串中的 AccessToken。
''' </summary>
Friend Function SecretFilter(Raw As String, FilterChar As Char) As String
'打码 "accessToken " 后的内容
If Raw.Contains("accessToken ") Then
For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
Next
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken Is Nothing OrElse AccessToken.Length < 10 OrElse Not Raw.ContainsF(AccessToken, True) OrElse
McLoginLoader.Output.Uuid = McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Return Raw
Else
Return Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
End Function
#End Region
#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
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 的访问
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
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 的访问
End Sub
#End Region
#Region "字符串加解密"
''' <summary>
''' 获取八位密钥。
''' </summary>
Private Function SecretKeyGet(Key As String) As String
Return "00000000"
End Function
''' <summary>
''' 加密字符串。
''' </summary>
Friend Function SecretEncrypt(SourceString As String, Optional Key As String = "") As String
Key = SecretKeyGet(Key)
Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
Dim des As New DESCryptoServiceProvider
Using MS As New MemoryStream
Dim inData As Byte() = Encoding.UTF8.GetBytes(SourceString)
Using cs As New CryptoStream(MS, des.CreateEncryptor(btKey, btIV), CryptoStreamMode.Write)
cs.Write(inData, 0, inData.Length)
cs.FlushFinalBlock()
Return Convert.ToBase64String(MS.ToArray())
End Using
End Using
End Function
''' <summary>
''' 解密字符串。
''' </summary>
Friend Function SecretDecrypt(SourceString As String, Optional Key As String = "") As String
Key = SecretKeyGet(Key)
Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
Dim des As New DESCryptoServiceProvider
Using MS As New MemoryStream
Dim inData As Byte() = Convert.FromBase64String(SourceString)
Using cs As New CryptoStream(MS, des.CreateDecryptor(btKey, btIV), CryptoStreamMode.Write)
cs.Write(inData, 0, inData.Length)
cs.FlushFinalBlock()
Return Encoding.UTF8.GetString(MS.ToArray())
End Using
End Using
End Function
#End Region
#Region "主题"
Public Color1 As New MyColor(52, 61, 74)
Public Color2 As New MyColor(11, 91, 203)
Public Color3 As New MyColor(19, 112, 243)
Public Color4 As New MyColor(72, 144, 245)
Public Color5 As New MyColor(150, 192, 249)
Public Color6 As New MyColor(213, 230, 253)
Public Color7 As New MyColor(222, 236, 253)
Public Color8 As New MyColor(234, 242, 254)
Public ColorBg0 As New MyColor(150, 192, 249)
Public ColorBg1 As New MyColor(190, Color7)
Public ColorGray1 As New MyColor(64, 64, 64)
Public ColorGray2 As New MyColor(115, 115, 115)
Public ColorGray3 As New MyColor(140, 140, 140)
Public ColorGray4 As New MyColor(166, 166, 166)
Public ColorGray5 As New MyColor(204, 204, 204)
Public ColorGray6 As New MyColor(235, 235, 235)
Public ColorGray7 As New MyColor(240, 240, 240)
Public ColorGray8 As New MyColor(245, 245, 245)
Public ColorSemiTransparent As New MyColor(1, Color8)
Public ThemeNow As Integer = -1
Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As Object = 0
Public ThemeDontClick As Integer = 0
Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
Hint("该版本中不包含主题功能……")
End Sub
Public Sub ThemeRefreshMain()
RunInUi(
Sub()
If Not FrmMain.IsLoaded Then Exit Sub
'顶部条背景
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
If ThemeNow = 5 Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 15)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
ElseIf Not (ThemeNow = 12 OrElse ThemeDontClick = 2) Then
If TypeOf ColorHueTopbarDelta Is Integer Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
End If
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)})
FrmMain.PanTitle.Background = Brush
End If
'主页面背景
If Setup.Get("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 20, Math.Min(60, ColorSat) * 0.5, 80)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.9, 90)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 20, Math.Min(60, ColorSat) * 0.5, 80)})
FrmMain.PanForm.Background = Brush
Else
FrmMain.PanForm.Background = New MyColor(245, 245, 245)
End If
FrmMain.PanForm.Background.Freeze()
End Sub)
End Sub
Public Sub ThemeCheckAll(EffectSetup As Boolean)
End Sub
Public Function ThemeCheckOne(Id As Integer) As Boolean
Return True
End Function
Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
Return False
End Function
Public Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Return False
End Function
Public Function DonateCodeInput() As Boolean?
Return Nothing
End Function
#End Region
#Region "更新"
Public IsUpdateStarted As Boolean = False
Public IsUpdateWaitingRestart As Boolean = False
Public Sub UpdateCheckByButton()
Hint("该版本中不包含更新功能……")
End Sub
Public Sub UpdateStart(BaseUrl As String, Slient As Boolean, Optional ReceivedKey As String = Nothing, Optional ForceValidated As Boolean = False)
End Sub
Public Sub UpdateRestart(TriggerRestartAndByEnd As Boolean)
End Sub
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
End Sub
#End Region
#Region "联网通知"
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
#End Region
End Module
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.7.3.0")>
<Assembly: AssemblyFileVersion("2.7.3.0")>
<Assembly: AssemblyVersion("2.8.3.0")>
<Assembly: AssemblyFileVersion("2.8.3.0")>
<Assembly: NeutralResourcesLanguage("")>
File diff suppressed because it is too large. Load diff
@@ -87,7 +87,7 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -177,17 +177,18 @@
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -197,7 +198,7 @@
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'Mod 下载;整合包另存为
'Mod、资源包下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
@@ -211,10 +212,10 @@
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
@@ -230,7 +231,7 @@
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
@@ -260,10 +261,11 @@
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
Dim SelectedVersion = SuitableVersions.OrderBy(
Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
@@ -275,7 +277,7 @@
If Project.TranslatedName = Project.RawName Then
FileName = File.FileName
Else
Dim ChineseName As String = Project.TranslatedName.Split(" (").First.Split(" - ").First.
Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
@@ -299,7 +301,7 @@
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
@@ -33,7 +33,7 @@
' PanMain.Children.Insert(0, CardWarn)
'End If
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 Forge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -55,10 +55,6 @@
Card.StackInstall()
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadForge(sender.Tag)
End Sub
'介绍栏
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://files.minecraftforge.net")
@@ -20,6 +20,8 @@
<StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" />
<Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
@@ -60,26 +62,6 @@
<TextBlock VerticalAlignment="Center" Text="返回" Grid.Column="3" Foreground="{StaticResource ColorBrushGray4}" />
</Grid>
</local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,15,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
<StackPanel Name="PanOptiFine" />
</StackPanel>
<Grid x:Name="PanOptiFineInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgOptiFine" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/GrassPath.png" />
<TextBlock x:Name="LabOptiFine" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="Forge" Height="40" Margin="0,15,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" />
<Grid x:Name="PanForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -98,6 +80,24 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="NeoForge" Height="40" Margin="0,15,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
<Grid x:Name="PanNeoForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgNeoForge" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/NeoForge.png" />
<TextBlock x:Name="LabNeoForge" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="Fabric" Height="40" Margin="0,15,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
<Grid x:Name="PanFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -134,6 +134,26 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,15,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
<StackPanel Name="PanOptiFine" />
</StackPanel>
<Grid x:Name="PanOptiFineInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgOptiFine" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/GrassPath.png" />
<TextBlock x:Name="LabOptiFine" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="OptiFabric" Height="40" Margin="0,15,0,0" x:Name="CardOptiFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" />
<Grid x:Name="PanOptiFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -177,6 +197,7 @@
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadNeoForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadLiteLoader" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" />
@@ -10,6 +10,7 @@
DlOptiFineListLoader.Start()
DlLiteLoaderListLoader.Start()
DlFabricListLoader.Start()
DlNeoForgeListLoader.Start()
'重载预览
TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")}
@@ -26,6 +27,7 @@
LoadLiteLoader.State = DlLiteLoaderListLoader
LoadFabric.State = DlFabricListLoader
LoadFabricApi.State = DlFabricApiLoader
LoadNeoForge.State = DlNeoForgeListLoader
LoadOptiFabric.State = DlOptiFabricLoader
End Sub
@@ -51,6 +53,7 @@
CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True
CardNeoForge.IsSwaped = True
CardFabric.IsSwaped = True
CardFabricApi.IsSwaped = True
CardOptiFabric.IsSwaped = True
@@ -80,32 +83,36 @@
AniStart({
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10),
AaCode(Sub()
PanBack.ScrollToHome()
TextSelectName.Validate()
OptiFine_Loaded()
LiteLoader_Loaded()
Forge_Loaded()
Fabric_Loaded()
FabricApi_Loaded()
OptiFabric_Loaded()
SelectReload()
End Sub, After:=True),
AaCode(
Sub()
PanBack.ScrollToHome()
TextSelectName.Validate()
OptiFine_Loaded()
LiteLoader_Loaded()
Forge_Loaded()
NeoForge_Loaded()
Fabric_Loaded()
FabricApi_Loaded()
OptiFabric_Loaded()
SelectReload()
End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub()
PanMinecraft.Visibility = Visibility.Collapsed
PanBack.IsHitTestVisible = True
'初始化 Binding
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True)
AaCode(
Sub()
PanMinecraft.Visibility = Visibility.Collapsed
PanBack.IsHitTestVisible = True
'初始化 Binding
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnNeoForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardNeoForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True)
}, "FrmDownloadInstall SelectPageSwitch", True)
End Sub
Public Sub ExitSelectPage()
@@ -213,6 +220,26 @@
End If
End Sub
'NeoForge
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private Sub SetNeoForgeInfoShow(IsShow As String)
If PanNeoForgeInfo.Tag = IsShow Then Exit Sub
PanNeoForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 100, 90)
}, "SetNeoForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 100)
}, "SetNeoForgeInfoShow")
End If
End Sub
'Fabric
Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String)
@@ -277,7 +304,7 @@
''' <summary>
''' 重载已选择的项目的显示。
''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True
'主预览
@@ -305,20 +332,25 @@
LabOptiFine.Foreground = ColorGray1
End If
'LiteLoader
Dim LiteLoaderError As String = LoadLiteLoaderGetError()
CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠
SetLiteLoaderInfoShow(CardLiteLoader.IsSwaped)
If SelectedLiteLoader Is Nothing Then
BtnLiteLoaderClear.Visibility = Visibility.Collapsed
ImgLiteLoader.Visibility = Visibility.Collapsed
LabLiteLoader.Text = If(LiteLoaderError, "点击选择")
LabLiteLoader.Foreground = ColorGray4
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then
CardLiteLoader.Visibility = Visibility.Collapsed
Else
BtnLiteLoaderClear.Visibility = Visibility.Visible
ImgLiteLoader.Visibility = Visibility.Visible
LabLiteLoader.Text = SelectedLiteLoader.Inherit
LabLiteLoader.Foreground = ColorGray1
CardLiteLoader.Visibility = Visibility.Visible
Dim LiteLoaderError As String = LoadLiteLoaderGetError()
CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠
SetLiteLoaderInfoShow(CardLiteLoader.IsSwaped)
If SelectedLiteLoader Is Nothing Then
BtnLiteLoaderClear.Visibility = Visibility.Collapsed
ImgLiteLoader.Visibility = Visibility.Collapsed
LabLiteLoader.Text = If(LiteLoaderError, "点击选择")
LabLiteLoader.Foreground = ColorGray4
Else
BtnLiteLoaderClear.Visibility = Visibility.Visible
ImgLiteLoader.Visibility = Visibility.Visible
LabLiteLoader.Text = SelectedLiteLoader.Inherit
LabLiteLoader.Foreground = ColorGray1
End If
End If
'Forge
Dim ForgeError As String = LoadForgeGetError()
@@ -333,63 +365,116 @@
Else
BtnForgeClear.Visibility = Visibility.Visible
ImgForge.Visibility = Visibility.Visible
LabForge.Text = SelectedForge.Version
LabForge.Text = SelectedForge.VersionName
LabForge.Foreground = ColorGray1
End If
'Fabric
Dim FabricError As String = LoadFabricGetError()
CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricError IsNot Nothing Then CardFabric.IsSwaped = True
SetFabricInfoShow(CardFabric.IsSwaped)
If SelectedFabric Is Nothing Then
BtnFabricClear.Visibility = Visibility.Collapsed
ImgFabric.Visibility = Visibility.Collapsed
LabFabric.Text = If(FabricError, "点击选择")
LabFabric.Foreground = ColorGray4
'NeoForge
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) <= 19 Then
CardNeoForge.Visibility = Visibility.Collapsed
Else
BtnFabricClear.Visibility = Visibility.Visible
ImgFabric.Visibility = Visibility.Visible
LabFabric.Text = SelectedFabric.Replace("+build", "")
LabFabric.Foreground = ColorGray1
CardNeoForge.Visibility = Visibility.Visible
Dim NeoForgeError As String = LoadNeoForgeGetError()
CardNeoForge.MainSwap.Visibility = If(NeoForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If NeoForgeError IsNot Nothing Then CardNeoForge.IsSwaped = True
SetNeoForgeInfoShow(CardNeoForge.IsSwaped)
If SelectedNeoForge Is Nothing Then
BtnNeoForgeClear.Visibility = Visibility.Collapsed
ImgNeoForge.Visibility = Visibility.Collapsed
LabNeoForge.Text = If(NeoForgeError, "点击选择")
LabNeoForge.Foreground = ColorGray4
Else
BtnNeoForgeClear.Visibility = Visibility.Visible
ImgNeoForge.Visibility = Visibility.Visible
LabNeoForge.Text = SelectedNeoForge.VersionName
LabNeoForge.Foreground = ColorGray1
End If
End If
'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed
Else
CardFabric.Visibility = Visibility.Visible
Dim FabricError As String = LoadFabricGetError()
CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricError IsNot Nothing Then CardFabric.IsSwaped = True
SetFabricInfoShow(CardFabric.IsSwaped)
If SelectedFabric Is Nothing Then
BtnFabricClear.Visibility = Visibility.Collapsed
ImgFabric.Visibility = Visibility.Collapsed
LabFabric.Text = If(FabricError, "点击选择")
LabFabric.Foreground = ColorGray4
Else
BtnFabricClear.Visibility = Visibility.Visible
ImgFabric.Visibility = Visibility.Visible
LabFabric.Text = SelectedFabric.Replace("+build", "")
LabFabric.Foreground = ColorGray1
End If
End If
'FabricApi
Dim FabricApiError As String = LoadFabricApiGetError()
CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True
SetFabricApiInfoShow(CardFabricApi.IsSwaped)
If SelectedFabricApi Is Nothing Then
BtnFabricApiClear.Visibility = Visibility.Collapsed
ImgFabricApi.Visibility = Visibility.Collapsed
LabFabricApi.Text = If(FabricApiError, "点击选择")
LabFabricApi.Foreground = ColorGray4
If SelectedFabric Is Nothing Then
CardFabricApi.Visibility = Visibility.Collapsed
Else
BtnFabricApiClear.Visibility = Visibility.Visible
ImgFabricApi.Visibility = Visibility.Visible
LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim
LabFabricApi.Foreground = ColorGray1
CardFabricApi.Visibility = Visibility.Visible
Dim FabricApiError As String = LoadFabricApiGetError()
CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True
SetFabricApiInfoShow(CardFabricApi.IsSwaped)
If SelectedFabricApi Is Nothing Then
BtnFabricApiClear.Visibility = Visibility.Collapsed
ImgFabricApi.Visibility = Visibility.Collapsed
LabFabricApi.Text = If(FabricApiError, "点击选择")
LabFabricApi.Foreground = ColorGray4
Else
BtnFabricApiClear.Visibility = Visibility.Visible
ImgFabricApi.Visibility = Visibility.Visible
LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim
LabFabricApi.Foreground = ColorGray1
End If
End If
'OptiFabric
Dim OptiFabricError As String = LoadOptiFabricGetError()
CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True
SetOptiFabricInfoShow(CardOptiFabric.IsSwaped)
If SelectedOptiFabric Is Nothing Then
BtnOptiFabricClear.Visibility = Visibility.Collapsed
ImgOptiFabric.Visibility = Visibility.Collapsed
LabOptiFabric.Text = If(OptiFabricError, "点击选择")
LabOptiFabric.Foreground = ColorGray4
If SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then
CardOptiFabric.Visibility = Visibility.Collapsed
Else
BtnOptiFabricClear.Visibility = Visibility.Visible
ImgOptiFabric.Visibility = Visibility.Visible
LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Foreground = ColorGray1
CardOptiFabric.Visibility = Visibility.Visible
Dim OptiFabricError As String = LoadOptiFabricGetError()
CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True
SetOptiFabricInfoShow(CardOptiFabric.IsSwaped)
If SelectedOptiFabric Is Nothing Then
BtnOptiFabricClear.Visibility = Visibility.Collapsed
ImgOptiFabric.Visibility = Visibility.Collapsed
LabOptiFabric.Text = If(OptiFabricError, "点击选择")
LabOptiFabric.Foreground = ColorGray4
Else
BtnOptiFabricClear.Visibility = Visibility.Visible
ImgOptiFabric.Visibility = Visibility.Visible
LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Foreground = ColorGray1
End If
End If
'主警告
HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed)
If SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing Then
HintFabricAPI.Visibility = Visibility.Visible
Else
HintFabricAPI.Visibility = Visibility.Collapsed
End If
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
HintOptiFabric.Visibility = Visibility.Visible
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Visible
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
Else
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso
(SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then
HintModOptiFine.Visibility = Visibility.Visible
Else
HintModOptiFine.Visibility = Visibility.Collapsed
End If
'结束
IsReloading = False
@@ -404,6 +489,7 @@
SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing
SelectedForge = Nothing
SelectedNeoForge = Nothing
SelectedFabric = Nothing
SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing
@@ -419,7 +505,10 @@
Name += "-Fabric " & SelectedFabric.Replace("+build", "")
End If
If SelectedForge IsNot Nothing Then
Name += "-Forge_" & SelectedForge.Version
Name += "-Forge_" & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Name += "-NeoForge_" & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader"
@@ -438,7 +527,10 @@
Info += ", Fabric " & SelectedFabric.Replace("+build", "")
End If
If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.Version
Info += ", Forge " & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Info += ", NeoForge " & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader"
@@ -457,6 +549,8 @@
Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/NeoForge.png"
ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then
@@ -594,6 +688,7 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFineGetError() As String
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容
@@ -629,10 +724,12 @@
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
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
VersionSortInteger(Forge.Version.Split(".").Last, OptiFine.RequiredForgeVersion) >= 0)
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
Return Forge.Version.Revision >= OptiFine.RequiredForgeVersion
End If
End Function
'限制展开
@@ -655,11 +752,12 @@
Next
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Versions = Sort(Versions,
Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
'可视化
PanOptiFine.Children.Clear()
For Each Version In Versions
@@ -676,6 +774,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded()
Forge_Loaded()
NeoForge_Loaded()
CardOptiFine.IsSwaped = True
SelectReload()
End Sub
@@ -685,6 +784,7 @@
CardOptiFine.IsSwaped = True
e.Handled = True
Forge_Loaded()
NeoForge_Loaded()
SelectReload()
End Sub
@@ -770,6 +870,7 @@
Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
@@ -799,16 +900,15 @@
If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList
Versions = Sort(Versions, Function(a, b) a.Version > b.Version).Where(
Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList()
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
@@ -836,6 +936,67 @@
#End Region
#Region "NeoForge 列表"
''' <summary>
''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadNeoForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本"
If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message
If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then
Return Nothing
Else
Return "没有可用版本"
End If
End Function
'限制展开
Private Sub CardNeoForge_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardNeoForge.PreviewSwap
If LoadNeoForgeGetError() IsNot Nothing Then e.Handled = True
End Sub
''' <summary>
''' 尝试重新可视化 NeoForge 版本列表。
''' </summary>
Private Sub NeoForge_Loaded() Handles LoadNeoForge.StateChanged
Try
'获取版本列表
If DlNeoForgeListLoader.State <> LoadState.Finished Then Exit Sub
Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = SelectedMinecraftId).ToList
If Not Versions.Any() Then Exit Sub
'可视化
PanNeoForge.Children.Clear()
NeoForgeDownloadListItemPreload(PanNeoForge, Versions, AddressOf NeoForge_Selected, False)
For Each Version In Versions
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", LogLevel.Feedback)
End Try
End Sub
'选择与清除
Private Sub NeoForge_Selected(sender As MyListItem, e As EventArgs)
SelectedNeoForge = sender.Tag
CardNeoForge.IsSwaped = True
OptiFine_Loaded()
SelectReload()
End Sub
Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp
SelectedNeoForge = Nothing
CardNeoForge.IsSwaped = True
e.Handled = True
OptiFine_Loaded()
SelectReload()
End Sub
#End Region
#Region "Fabric 列表"
''' <summary>
@@ -847,7 +1008,7 @@
For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
Return Nothing
End If
Next
@@ -909,12 +1070,12 @@
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a)
For Each Part As String In DisplayName.Split("]")(0).TrimStart("[").Split("/")
For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/")
If Part = MinecraftVersion Then Return True
Next
'将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(DisplayName.Split("]")(0), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(MinecraftVersion.Split("]")(0), "[a-z/]+|[0-9/]+")
Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+")
'对每段进行判断
Dim i As Integer = 0
While True
@@ -1034,6 +1195,7 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
@@ -1079,7 +1241,8 @@
PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected))
Next
'自动选择 OptiFabric
If Not AutoSelectedOptiFabric Then
If Not AutoSelectedOptiFabric AndAlso
Not (SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15")) Then '1.14~15 不自动选择
AutoSelectedOptiFabric = True
Log($"[Download] 已自动选择 OptiFabric:{CType(PanOptiFabric.Children(0), MyListItem).Title}")
OptiFabric_Selected(PanOptiFabric.Children(0), Nothing)
@@ -1111,7 +1274,7 @@
End Sub
Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf &
"因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
@@ -1127,6 +1290,7 @@
.MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine,
.ForgeEntry = SelectedForge,
.NeoForgeEntry = SelectedNeoForge,
.FabricVersion = SelectedFabric,
.FabricApi = SelectedFabricApi,
.OptiFabric = SelectedOptiFabric,
@@ -43,39 +43,47 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem x:Name="ItemNeoForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="NeoForge"
LogoScale="0.95" Logo="M544.6 921.2l-23.7 32.6c14.1 10.2 33.3 10.2 47.5 0l-23.7-32.6zM114.6 608.5l-23.9 32.5 0.2 0.1 23.6-32.6z m-12.0-38.0l38.3 12.7v-0.2l-38.3-12.4z m49.2-152.6l-38.4-12.4 38.4 12.4zM250.2 114.4l-37.6-14.6a40.2 40.2 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.0 29.9 0.2-0.2-27.2-29.7z m11.7-4.5V63.0v40.4z m11.7 4.5l28.0-29.0a40.5 40.5 0 0 0-0.8-0.8l-27.2 29.8z m4.4 7.3l-38.6 11.7a40.5 40.5 0 0 0 0.2 0.7l38.3-12.4zM381.0 417.7l-38.4 12.5a40.3 40.3 0 0 0 38.4 27.8v-40.3z m327.0 0v40.3c17.5 0 32.9-11.2 38.4-27.8L708.1 417.7z m98.5-303.3l-37.6-14.6a38.4 38.4 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.1 29.9 0.1-0.2-27.2-29.7z m11.7-4.5v0z m11.7 4.5l28.0-29.0a38.4 38.4 0 0 0-0.8-0.8l-27.2 29.8z m4.3 7.3l-38.6 11.7a47.5 47.5 0 0 0 0.2 0.7l38.4-12.4z m98.5 303.3l-38.4 12.4 0.1 0.5 38.2-12.9z m51.2 151.9l38.7-11.3a34.5 34.5 0 0 0-0.5-1.6l-38.1 12.9z m-37.8 5.2l-430.0 312.6 47.5 65.3 429.9-312.6-47.5-65.3z m-382.5 312.6L138.3 575.8l-47.5 65.3L520.9 953.9l47.3-65.3zM138.5 576a6.4 6.4 0 0 1 2.3 3.2l-76.9 24.5c4.7 14.9 14.1 28.0 26.7 37.3l47.8-65.0z m2.3 3.2a6.4 6.4 0 0 1 0 4.0L64.1 557.9a74.3 74.3 0 0 0-0.2 45.8l76.9-24.5z m0 3.7l49.2-152.6-76.8-24.8L64.0 558.2l76.8 24.8z m49.2-152.5l98.5-303.3-76.8-25.0L113.3 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9L227.6 78.0a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6A57.7 57.7 0 0 0 266.4 63.0v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.3 57.3 0 0 0-15.0-24.5l-56.1 58.0z m-5.8-9.2l98.4 302.5 76.8-25.0-98.5-302.5-76.8 25.0z m136.8 330.4H708.1V377.5H381.2v80.7z m365.4-27.8l98.5-303.3-76.8-25.0L669.6 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9l-54.1-59.9a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6a57.7 57.7 0 0 0-38.9-15.1v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.4 57.4 0 0 0-14.9-24.5l-56.1 58.0z m-5.8-9.2l98.5 303.3 76.8-25.0-98.5-303.3-76.8 25.0z m98.6 303.8l51.2 151.9 76.5-25.8-51.2-151.9-76.5 25.8z m50.7 150.2a6.5 6.5 0 0 1 0.1-4.0l75.6 28.1c5.5-14.9 6.2-31.3 1.6-46.7l-77.5 22.6z m0.1-4.0a6.4 6.4 0 0 1 2.4-3.2l43.8 67.8c13.4-8.7 23.6-21.5 29.2-36.4l-75.6-28.1z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="7" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="8" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="9" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="10" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
<local:MyIconButton Tag="9" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="11" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="12" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="12" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel>
</local:MyPageLeft>
@@ -10,7 +10,7 @@
''' <summary>
''' 勾选事件改变页面。
''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -31,6 +31,9 @@
Case FormMain.PageSubType.DownloadForge
If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge
Return FrmDownloadForge
Case FormMain.PageSubType.DownloadNeoForge
If FrmDownloadNeoForge Is Nothing Then FrmDownloadNeoForge = New PageDownloadNeoForge
Return FrmDownloadNeoForge
Case FormMain.PageSubType.DownloadLiteLoader
If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader
Return FrmDownloadLiteLoader
@@ -69,17 +72,19 @@
FrmMain.PageRight = Target
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit()
AniStart({
AaCode(Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
AaCode(
Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
End Sub
#End Region
@@ -91,6 +96,7 @@
DlClientListLoader.Start(IsForceRestart:=True)
DlOptiFineListLoader.Start(IsForceRestart:=True)
DlForgeListLoader.Start(IsForceRestart:=True)
DlNeoForgeListLoader.Start(IsForceRestart:=True)
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
DlFabricListLoader.Start(IsForceRestart:=True)
DlFabricApiLoader.Start(IsForceRestart:=True)
@@ -117,6 +123,9 @@
Case FormMain.PageSubType.DownloadForge
DlForgeListLoader.Start(IsForceRestart:=True)
ItemForge.Checked = True
Case FormMain.PageSubType.DownloadNeoForge
DlNeoForgeListLoader.Start(IsForceRestart:=True)
ItemNeoForge.Checked = True
Case FormMain.PageSubType.DownloadLiteLoader
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
ItemLiteLoader.Checked = True
@@ -154,12 +163,14 @@
ItemOptiFine.Visibility = Visibility.Visible
ItemFabric.Visibility = Visibility.Visible
ItemForge.Visibility = Visibility.Visible
ItemNeoForge.Visibility = Visibility.Visible
ItemLiteLoader.Visibility = Visibility.Visible
RunInThread(Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
'折叠手动安装
Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp
@@ -170,14 +181,16 @@
LabHand.Visibility = Visibility.Collapsed
ItemClient.Visibility = Visibility.Collapsed
ItemOptiFine.Visibility = Visibility.Collapsed
ItemNeoForge.Visibility = Visibility.Collapsed
ItemFabric.Visibility = Visibility.Collapsed
ItemForge.Visibility = Visibility.Collapsed
ItemLiteLoader.Visibility = Visibility.Collapsed
RunInThread(Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
End Class
@@ -38,7 +38,7 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 LiteLoader 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -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" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -40,12 +40,14 @@
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
@@ -89,11 +91,12 @@
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] Mod 切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
#Region "搜索"
@@ -0,0 +1,27 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadNeoForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.19+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
EventType="打开网页" EventData="https://neoforged.net/" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 NeoForge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,34 @@
Public Class PageDownloadNeoForge
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlNeoForgeListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict = DlNeoForgeListLoader.Output.Value.GroupBy(Function(d) d.Inherit).OrderByDescending(Function(g) g.Key).
ToDictionary(Function(g) g.Key, Function(g) g.ToList())
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlNeoForgeListEntry)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 13}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
End Class
@@ -13,7 +13,7 @@
'归类
Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry))
Dict.Add("快照版本", New List(Of DlOptiFineListEntry))
For VersionCode As Integer = 30 To 0 Step -1
For VersionCode As Integer = 50 To 0 Step -1
Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry))
Next
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
@@ -42,14 +42,10 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 OptiFine 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadOptiFine(sender.Tag)
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/")
End Sub
@@ -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" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -39,12 +39,14 @@
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
@@ -93,7 +93,7 @@ Public Class FormLoginOAuth
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch)
FrmMain.Focus()
End Sub
Private Sub HintSwitch_Click(sender As Object, e As EventArgs) Handles HintSwitch.Click
Private Sub HintSwitch_Click() Handles HintSwitch.Click
IsSwitch = True
Close()
End Sub
@@ -241,7 +241,7 @@ 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", "樱花披风"}
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Follower's", "追随者披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -21,6 +21,19 @@
'加载版本
RunInNewThread(
Sub()
''自动整合包安装:准备
'Dim PackInstallPath As String = Nothing
'If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
'If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
'If PackInstallPath IsNot Nothing Then
' Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
' If Not Directory.Exists(Path & ".minecraft\") Then
' Directory.CreateDirectory(Path & ".minecraft\")
' Directory.CreateDirectory(Path & ".minecraft\versions\")
' McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
' End If
' Setup.Set("LaunchFolderSelect", "$.minecraft\")
'End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +48,21 @@
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
''自动整合包安装
'If PackInstallPath IsNot Nothing Then
' If ModpackInstall(PackInstallPath) Then
' Log("[Launch] 自动安装整合包成功:" & PackInstallPath)
' File.Delete(PackInstallPath)
' Else
' Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
' 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.StartsWith(PathMcFolder) AndAlso 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, ",没有有效版本", ":" & 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
@@ -400,7 +417,7 @@ Finish:
ElseIf Setup.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""}
Else
Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Split("¨")(0), "")}
Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")}
End If
Case 3
Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")}
@@ -619,7 +636,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
@@ -27,15 +27,16 @@
''' 刷新自定义主页。
''' </summary>
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
RunInNewThread(
Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub
Private Sub RefreshReal()
Dim Content As String = ""
@@ -97,6 +98,10 @@ Download:
Log("[Page] 主页预设:每日整合包推荐")
Url = "https://pclsub.sodamc.com/"
GoTo Download
Case 5
Log("[Page] 主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file"
GoTo Download
End Select
End Select
RunInUi(Sub() LoadContent(Content))
@@ -106,16 +111,17 @@ Download:
'联网获取自定义主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化
Try
'获取版本校验地址
Dim VersionAddress As String
If Task.Input.Contains(".xaml") Then
VersionAddress = Task.Input.Replace(".xaml", ".xaml.ini")
If Address.Contains(".xaml") Then
VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else
VersionAddress = Task.Input.Split("?").First
VersionAddress = Address.Before("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version"
If Task.Input.Contains("?") Then VersionAddress += Task.Input.Split("?").Last
If Address.Contains("?") Then VersionAddress += Address.After("?")
End If
'校验版本
Dim Version As String = ""
@@ -136,9 +142,9 @@ Download:
End Try
'实际下载
If NeedDownload Then
Dim FileContent As String = NetGetCodeByRequestRetry(Task.Input)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Task.Input}")
Setup.Set("CacheSavedPageUrl", Task.Input)
Dim FileContent As String = NetGetCodeByRequestRetry(Address)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
End If
@@ -146,11 +152,10 @@ Download:
Refresh()
Catch ex As Exception
If Setup.Get("CacheSavedPageVersion") = "" Then
Log(ex, $"联网下载自定义主页失败({Task.Input})", LogLevel.Msgbox)
Log(ex, $"联网下载自定义主页失败({Address})", LogLevel.Msgbox)
Else
Log(ex, $"联网下载自定义主页失败({Task.Input})")
Log(ex, $"联网下载自定义主页失败({Address})")
End If
Task.Input = ""
End Try
End Sub
@@ -199,7 +204,7 @@ Download:
End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI,最终内容长度:{Content.Count}")
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Try
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
@@ -208,6 +213,7 @@ Download:
GoTo Refresh '防止 SyncLock 死锁
End If
End Try
Log($"[Page] 实例化:加载自定义主页 UI 完成")
End SyncLock
Return
Refresh:
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Split("¨")(0)
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(0).Trim
ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim
End If
End If
IsFirstLoad = False
@@ -71,9 +71,9 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")))
OpenWebsite(If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")))
Else
Dim Website As String = If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
Dim Website As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If
End Sub
@@ -26,7 +26,7 @@ Public Class PageLoginLegacy
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0).Trim
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim
End If
End If
IsReloaded = True
@@ -39,14 +39,15 @@
Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")}
Dim Result As McLoginMs = Nothing
RunInUiWait(Sub()
If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then
Result = New McLoginMs
Else
Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem
Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title}
End If
End Sub)
RunInUiWait(
Sub()
If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then
Result = New McLoginMs
Else
Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem
Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title}
End If
End Sub)
Return Result
End Function
''' <summary>
@@ -67,39 +68,43 @@
ComboAccounts.IsEnabled = False
BtnLogin.IsEnabled = False
BtnLogin.Text = "0%"
RunInNewThread(Sub()
Try
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
Do While McLoginMsLoader.State = LoadState.Loading
RunInUi(Sub() BtnLogin.Text = Math.Round(McLoginMsLoader.Progress * 100) & "%")
Thread.Sleep(50)
Loop
If McLoginMsLoader.State = LoadState.Finished Then
RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True))
ElseIf McLoginMsLoader.State = LoadState.Aborted Then
Throw New ThreadInterruptedException
ElseIf McLoginMsLoader.Error Is Nothing Then
Throw New Exception("未知错误!")
Else
Throw New Exception(McLoginMsLoader.Error.Message, McLoginMsLoader.Error)
End If
Catch ex As ThreadInterruptedException
Hint("已取消登录!")
Catch ex As Exception
If ex.Message = "$$" Then
ElseIf ex.Message.StartsWith("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Critical)
Else
Log(ex, "微软登录尝试失败", LogLevel.Msgbox)
End If
Finally
RunInUi(Sub()
ComboAccounts.IsEnabled = True
BtnLogin.IsEnabled = True
BtnLogin.Text = "登录"
End Sub)
End Try
End Sub, "Ms Login")
RunInNewThread(
Sub()
Try
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
Do While McLoginMsLoader.State = LoadState.Loading
RunInUi(Sub() BtnLogin.Text = Math.Round(McLoginMsLoader.Progress * 100) & "%")
Thread.Sleep(50)
Loop
If McLoginMsLoader.State = LoadState.Finished Then
RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True))
ElseIf McLoginMsLoader.State = LoadState.Aborted Then
Throw New ThreadInterruptedException
ElseIf McLoginMsLoader.Error Is Nothing Then
Throw New Exception("未知错误!")
Else
Throw New Exception(McLoginMsLoader.Error.Message, McLoginMsLoader.Error)
End If
Catch ex As ThreadInterruptedException
Hint("已取消登录!")
Catch ex As Exception
If ex.Message = "$$" Then
ElseIf ex.Message.StartsWith("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Critical)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请尝试在 [设置 → 启动器] 中关闭 [验证 SSL 证书] 然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
Else
Log(ex, "正版登录尝试失败", LogLevel.Msgbox)
End If
Finally
RunInUi(
Sub()
ComboAccounts.IsEnabled = True
BtnLogin.IsEnabled = True
BtnLogin.Text = "登录"
End Sub)
End Try
End Sub, "Ms Login")
End Sub
End Class
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginNideEmail").ToString.Split("¨")(0)
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(0).Trim
ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim
End If
End If
IsFirstLoad = False
@@ -149,9 +149,6 @@ Public Class PageLinkIoi
''' 检查某个玩家名是否合法。
''' </summary>
Private Shared Function IsPlayerNameValid(Name As String) As Boolean
For Each ValidateRule As Validate In {New ValidateNullOrWhiteSpace, New ValidateLength(0, 20), New ValidateFilter}
If Not String.IsNullOrEmpty(ValidateRule.Validate(Name)) Then Return False
Next
Return True
End Function
@@ -0,0 +1,505 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageOtherAbout"
PanScroll="{Binding ElementName=PanBack}" RenderOptions.BitmapScalingMode="LowQuality">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10" Grid.IsSharedSizeScope="True">
<local:MyCard Margin="0,15" Title="关于">
<Grid Margin="21,40,21,16">
<Grid.RowDefinitions>
<RowDefinition Height="45" />
<RowDefinition Height="45" />
</Grid.RowDefinitions>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="40" />
<ColumnDefinition />
<ColumnDefinition Width="150" />
</Grid.ColumnDefinitions>
<local:MyListItem IsHitTestVisible="False" Title="龙腾猫跃" Margin="-5,0,15,0" Info="Plain Craft Launcher 的作者!" Grid.Row="0" Grid.Column="1" />
<local:MyListItem IsHitTestVisible="False" Title="Plain Craft Launcher 2" Margin="-5,0,15,0" Info="当前版本:%VERSION%(%VERSIONCODE%.%BRANCH%)" Grid.Row="1" Grid.Column="1" x:Name="ItemAboutPcl" />
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/Logo.png" Grid.Row="1" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/LTCat.jpg" Grid.Row="0" Margin="3">
<Image.Clip>
<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="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="特别鸣谢">
<Grid Margin="21,40,21,16">
<Grid.RowDefinitions>
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
<RowDefinition Height="45" />
</Grid.RowDefinitions>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="40" />
<ColumnDefinition />
<ColumnDefinition Width="150" />
</Grid.ColumnDefinitions>
<local:MyListItem Title="bangbang93" Margin="-5,0,15,0" IsHitTestVisible="False" Info="提供 BMCLAPI 镜像源和 Forge 安装工具,详见 https://bmclapi.bangbang93.com" Grid.Row="0" Grid.Column="1" />
<local:MyButton x:Name="BtnAboutBmclapi" Text="赞助镜像源" Grid.Row="0" Grid.Column="2" Height="35" />
<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="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" />
<local:MyListItem Title="PCL 内群的各位" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="感谢内群的沙雕网友们这么久以来对我和 PCL 的支持与鼓励!" Grid.Row="7" Grid.Column="1" />
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/bangbang93.png" Grid.Row="0" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/wiki.png" Grid.Row="1" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/00ll00.png" Grid.Row="2" Margin="3">
<Image.Clip>
<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.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/Patrick.png" Grid.Row="4" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/Hao_Tian.jpg" Grid.Row="5" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/MCBBS.png" Grid.Row="6" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/PCL2.png" Grid.Row="7" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
</Grid>
</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" />
<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="雷霆" />
<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="猫羽喵" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<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="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>
</StackPanel>
</local:MyCard>
<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 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" />
<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" />
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="许可与版权声明" IsSwaped="True" CanSwap="True">
<Grid Margin="25,42,23,4">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="20" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<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" />
<local:MyButton Grid.Row="1" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/00ll00/java_launch_wrapper" />
<local:MyButton Grid.Row="1" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/00ll00/java_launch_wrapper?tab=MIT-1-ov-file#readme" />
<TextBlock Grid.Row="2" Grid.Column="0" Text="Newtonsoft.Json" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="2" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2007 James Newton-King&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
<local:MyButton Grid.Row="3" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://www.newtonsoft.com/json" />
<local:MyButton Grid.Row="3" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://opensource.org/licenses/MIT" />
<TextBlock Grid.Row="4" Grid.Column="0" Text="NAudio" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="4" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2015 Mark Heath ([email protected])&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
<local:MyButton Grid.Row="5" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/naudio/NAudio" />
<local:MyButton Grid.Row="5" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/naudio/NAudio/blob/master/license.txt" />
<TextBlock Grid.Row="6" Grid.Column="0" Text="Ookii.Dialogs" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="6" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2009 Sven Groot (Ookii.org)" TextWrapping="Wrap" />
<local:MyButton Grid.Row="7" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://www.ookii.org/Software/Dialogs/" />
<local:MyButton Grid.Row="7" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/caioproiete/ookii-dialogs-wpf/blob/master/LICENSE" />
<TextBlock Grid.Row="8" Grid.Column="0" Text="Iconmonstr" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="8" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2019 iconmonstr (Alexander Kahlkopf)" TextWrapping="Wrap" />
<local:MyButton Grid.Row="9" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://iconmonstr.com/" />
<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"
EventType="打开网页" EventData="https://www.iconfont.cn/" />
</Grid>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,40 @@
Public Class PageOtherAbout
Private Shadows IsLoaded As Boolean = False
Private Sub PageOtherAbout_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'重复加载部分
PanBack.ScrollToHome()
'非重复加载部分
If IsLoaded Then Exit Sub
IsLoaded = True
ItemAboutPcl.Info = ItemAboutPcl.Info.Replace("%VERSION%", VersionDisplayName).Replace("%VERSIONCODE%", VersionCode).Replace("%BRANCH%", VersionBranchCode)
#If DEBUG Then
BtnDonateDonate.Visibility = Visibility.Collapsed
BtnDonateOutput.Visibility = Visibility.Visible
#End If
End Sub
Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click
OpenWebsite("https://afdian.net/a/bangbang93")
End Sub
Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click
OpenWebsite("https://www.mcmod.cn")
End Sub
Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click
ClipboardSet(UniqueAddress)
End Sub
Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput()
End Sub
#If DEBUG Then
Private Sub BtnDonateOutput_Click(sender As Object, e As EventArgs) Handles BtnDonateOutput.Click
DonateCodeGenerate()
End Sub
#End If
End Class
@@ -0,0 +1,12 @@
<local:MyPageRight x:Class="PageOtherTest"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
xmlns:sys="clr-namespace:System;assembly=mscorlib"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<TextBlock Text="为便于维护,开源内容中不包含百宝箱功能……" HorizontalAlignment="Center" FontSize="15" Height="30" VerticalAlignment="Center" />
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,27 @@
Public Class PageOtherTest
Public Shared Sub StartCustomDownload(Url As String, FileName As String, Optional Folder As String = Nothing)
Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub Jrrp()
Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub RubbishClear()
Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub MemoryOptimize(ShowHint As Boolean)
If ShowHint Then Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub MemoryOptimizeInternal()
End Sub
Public Shared Function GetRandomCave() As String
Return "为便于维护,开源内容中不包含百宝箱功能……"
End Function
Public Shared Function GetRandomHint() As String
Return "为便于维护,开源内容中不包含百宝箱功能……"
End Function
Public Shared Function GetRandomPresetHint() As String
Return "为便于维护,开源内容中不包含百宝箱功能……"
End Function
End Class
@@ -295,7 +295,7 @@
For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then
Name = Folders(i).ToString.Split(">")(0)
Name = Folders(i).ToString.Before(">")
Folders.RemoveAt(i)
Exit For
End If
@@ -320,7 +320,7 @@
For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then
'Name = Folders(i).ToString.Split(">")(0)
'Name = Folders(i).ToString.Before(">")
Folders.RemoveAt(i)
Exit For
End If
@@ -38,17 +38,21 @@
CardName = "常规版本"
Case McVersionCardType.API
Dim IsForgeExists As Boolean = False
Dim IsNeoForgeExists As Boolean = False
Dim IsFabricExists As Boolean = False
Dim IsLiteExists As Boolean = False
For Each Version As McVersion In Card.Value
If Version.Version.HasFabric Then IsFabricExists = True
If Version.Version.HasLiteLoader Then IsLiteExists = True
If Version.Version.HasForge Then IsForgeExists = True
If Version.Version.HasNeoForge Then IsNeoForgeExists = True
Next
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) > 1 Then
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then
CardName = "可安装 Mod"
ElseIf IsForgeExists Then
CardName = "Forge 版本"
ElseIf IsNeoForgeExists Then
CardName = "NeoForge 版本"
ElseIf IsLiteExists Then
CardName = "LiteLoader 版本"
Else
@@ -210,8 +214,8 @@
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub
'修改此代码时,同时修改 PageVersionOverall 中的代码
Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion)
'修改此代码时,同时修改 PageVersionOverall 中的代码
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder
@@ -0,0 +1,692 @@
Public Class ModSetup
''' <summary>
''' 设置的更新号。
''' </summary>
Public Const VersionSetup As Integer = 1
''' <summary>
''' 设置列表。
''' </summary>
Private ReadOnly SetupDict As New Dictionary(Of String, SetupEntry) From {
{"Identify", New SetupEntry("", Source:=SetupSource.Registry)},
{"HintDownloadThread", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintNotice", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintDownload", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintInstallBack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintHide", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintHandInstall", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintBuy", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintClearRubbish", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintUpdateMod", New SetupEntry(False, Source:=SetupSource.Registry)},
{"TestSetupReader", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"SystemEula", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLaunchCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLastVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestBetaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestAlphaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemSetupVersionReg", New SetupEntry(VersionSetup, Source:=SetupSource.Registry)},
{"SystemSetupVersionIni", New SetupEntry(VersionSetup)},
{"SystemHelpVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"SystemDebugMode", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemDebugAnim", New SetupEntry(9, Source:=SetupSource.Registry)},
{"SystemDebugDelay", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemDebugSkipCopy", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemSystemCache", New SetupEntry("", Source:=SetupSource.Registry)},
{"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)},
{"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageVersion", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheMsOAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsProfileJson", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheMsName", 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)},
{"CacheNideName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideUsername", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNidePass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheNideServer", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthAccess", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthClient", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthUuid", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthUsername", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthPass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerServer", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheAuthServerRegister", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"CacheDownloadFolder", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheJavaListVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LoginRemember", New SetupEntry(True, Source:=SetupSource.Registry, Encoded:=True)},
{"LoginLegacyName", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginMsJson", New SetupEntry("{}", Source:=SetupSource.Registry, Encoded:=True)}, '{UserName: OAuthToken, ...}
{"LoginNideEmail", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginNidePass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginAuthEmail", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginAuthPass", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"LoginType", New SetupEntry(McLoginType.Legacy, Source:=SetupSource.Registry)},
{"LoginPageType", New SetupEntry(0)},
{"LaunchSkinID", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchSkinType", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LaunchSkinSlim", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LaunchVersionSelect", New SetupEntry("")},
{"LaunchFolderSelect", New SetupEntry("")},
{"LaunchFolders", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchArgumentTitle", New SetupEntry("")},
{"LaunchArgumentInfo", New SetupEntry("PCL")},
{"LaunchArgumentJavaSelect", New SetupEntry("", Source:=SetupSource.Registry)},
{"LaunchArgumentJavaAll", New SetupEntry("[]", Source:=SetupSource.Registry)},
{"LaunchArgumentIndie", New SetupEntry(0)},
{"LaunchArgumentVisible", New SetupEntry(5, Source:=SetupSource.Registry)},
{"LaunchArgumentPriority", New SetupEntry(1, Source:=SetupSource.Registry)},
{"LaunchArgumentWindowWidth", New SetupEntry(854)},
{"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")},
{"LaunchAdvanceGame", New SetupEntry("")},
{"LaunchAdvanceRun", New SetupEntry("")},
{"LaunchAdvanceRunWait", New SetupEntry(True)},
{"LaunchAdvanceAssets", New SetupEntry(False)},
{"LaunchAdvanceJava", New SetupEntry(False)},
{"LaunchRamType", New SetupEntry(0)},
{"LaunchRamCustom", New SetupEntry(15)},
{"LinkEula", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LinkName", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertTime", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkHiperCertWarn", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkIoiVersion", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolHelpChinese", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadThread", New SetupEntry(63, Source:=SetupSource.Registry)},
{"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)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateReleaseLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"ToolUpdateSnapshotLast", New SetupEntry("", Source:=SetupSource.Registry)},
{"UiLauncherTransparent", New SetupEntry(600)}, '避免与 PCL1 设置冲突(UiLauncherOpacity)
{"UiLauncherHue", New SetupEntry(180)},
{"UiLauncherSat", New SetupEntry(80)},
{"UiLauncherDelta", New SetupEntry(90)},
{"UiLauncherLight", New SetupEntry(20)},
{"UiLauncherTheme", New SetupEntry(0)},
{"UiLauncherThemeGold", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherThemeHide", New SetupEntry("0|1|2|3|4", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherThemeHide2", New SetupEntry("0|1|2|3|4", Source:=SetupSource.Registry, Encoded:=True)},
{"UiLauncherLogo", New SetupEntry(True)},
{"UiLauncherEmail", New SetupEntry(False)},
{"UiBackgroundColorful", New SetupEntry(True)},
{"UiBackgroundOpacity", New SetupEntry(1000)},
{"UiBackgroundBlur", New SetupEntry(0)},
{"UiBackgroundSuit", New SetupEntry(0)},
{"UiCustomType", New SetupEntry(0)},
{"UiCustomPreset", New SetupEntry(0)},
{"UiCustomNet", New SetupEntry("")},
{"UiLogoType", New SetupEntry(1)},
{"UiLogoText", New SetupEntry("")},
{"UiLogoLeft", New SetupEntry(False)},
{"UiMusicVolume", New SetupEntry(500)},
{"UiMusicStop", New SetupEntry(False)},
{"UiMusicStart", New SetupEntry(False)},
{"UiMusicRandom", New SetupEntry(True)},
{"UiMusicAuto", New SetupEntry(True)},
{"UiHiddenPageDownload", New SetupEntry(False)},
{"UiHiddenPageLink", New SetupEntry(False)},
{"UiHiddenPageSetup", New SetupEntry(False)},
{"UiHiddenPageOther", New SetupEntry(False)},
{"UiHiddenFunctionSelect", New SetupEntry(False)},
{"UiHiddenFunctionHidden", New SetupEntry(False)},
{"UiHiddenSetupLaunch", New SetupEntry(False)},
{"UiHiddenSetupUi", New SetupEntry(False)},
{"UiHiddenSetupLink", New SetupEntry(False)},
{"UiHiddenSetupSystem", New SetupEntry(False)},
{"UiHiddenOtherHelp", New SetupEntry(False)},
{"UiHiddenOtherFeedback", New SetupEntry(False)},
{"UiHiddenOtherVote", New SetupEntry(False)},
{"UiHiddenOtherAbout", New SetupEntry(False)},
{"UiHiddenOtherTest", New SetupEntry(False)},
{"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)},
{"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Version)},
{"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionServerNide", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Version)}
}
#Region "基础"
Private Enum SetupSource
Normal
Registry
Version
End Enum
Private Class SetupEntry
Public Encoded As Boolean
Public DefaultValue
Public DefaultValueEncoded
Public Value
Public Source As SetupSource
'加载状态:0/未读取 1/已读取未处理 2/已处理
Public State As Byte = 0
Public Type
Public Sub New(Value, Optional Source = SetupSource.Normal, Optional Encoded = False)
Me.DefaultValue = Value
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value)
Me.Encoded = Encoded
Me.Value = Value
Me.Source = Source
Type = If(Value, New Object).GetType
End Sub
End Class
''' <summary>
''' 改变某个设置项的值。
''' </summary>
Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
[Set](Key, Value, SetupDict(Key), ForceReload, Version)
End Sub
Private Sub [Set](Key As String, Value As Object, E As SetupEntry, ForceReload As Boolean, Version As McVersion)
Try
Value = CTypeDynamic(Value, E.Type)
If E.State = 2 Then
'如果已应用,且值相同,则无需再次更改
If E.Value = Value AndAlso Not ForceReload Then Exit Sub
Else
'如果未应用,则直接更改并应用
If E.Source <> SetupSource.Version Then E.State = 2
End If
'设置新值
E.Value = Value
'写入值
If E.Encoded Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & UniqueAddress)
Catch ex As Exception
Log(ex, "加密设置失败:" & Key, LogLevel.Developer)
End Try
End If
Select Case E.Source
Case SetupSource.Normal
WriteIni("Setup", Key, Value)
Case SetupSource.Registry
WriteReg(Key, Value)
Case SetupSource.Version
If Version Is Nothing Then
Throw New Exception("更改版本设置 " & Key & " 时未提供目标版本")
Else
WriteIni(Version.Path & "PCL\Setup.ini", Key, Value)
End If
End Select
'应用
'例如 VersionServerLogin 要求在设置之后再引发事件
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {Value})
Catch ex As Exception
Log(ex, "设置设置项时出错(" & Key & ", " & Value & ")", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 应用某个设置项的值。
''' </summary>
Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
Return Load(Key, SetupDict(Key), ForceReload, Version)
End Function
Private Function Load(Key As String, E As SetupEntry, ForceReload As Boolean, Version As McVersion)
'如果已经应用过,则什么也不干
If E.State = 2 AndAlso Not ForceReload Then Return E.Value
'读取,应用并设置状态
Read(Key, E, Version)
If E.Source <> SetupSource.Version Then E.State = 2
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {E.Value})
Return E.Value
End Function
''' <summary>
''' 获取某个设置项的值。
''' </summary>
Public Function [Get](Key As String, Optional Version As McVersion = Nothing)
If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key) With {.Source = Key}
Return [Get](Key, SetupDict(Key), Version)
End Function
Private Function [Get](Key As String, E As SetupEntry, Version As McVersion)
'获取强制值
Dim Force As String = ForceValue(Key)
If Force IsNot Nothing Then
E.Value = CTypeDynamic(Force, E.Type)
E.State = 1
End If
'如果尚未读取过,则读取
If E.State = 0 Then
Read(Key, E, Version)
If E.Source <> SetupSource.Version Then E.State = 1
End If
'返回现在的值
Return E.Value
End Function
''' <summary>
''' 初始化某个设置项的值。
''' </summary>
Public Sub Reset(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
Dim E As SetupEntry = SetupDict(Key)
[Set](Key, E.DefaultValue, E, ForceReload, Version)
End Sub
Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion)
Try
If Not E.State = 0 Then Exit Sub
Dim SourceValue As String '先用 String 储存,避免类型转换
Select Case E.Source
Case SetupSource.Normal
SourceValue = ReadIni("Setup", Key, E.DefaultValueEncoded)
Case SetupSource.Registry
SourceValue = ReadReg(Key, E.DefaultValueEncoded)
Case Else 'SetupSource.Version
If Version Is Nothing Then
Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本")
Else
SourceValue = ReadIni(Version.Path & "PCL\Setup.ini", Key, E.DefaultValueEncoded)
End If
End Select
If E.Encoded Then
If SourceValue.Equals(E.DefaultValueEncoded) Then
SourceValue = E.DefaultValue
Else
Try
SourceValue = SecretDecrypt(SourceValue, "PCL" & UniqueAddress)
Catch ex As Exception
Log(ex, "解密设置失败:" & Key, LogLevel.Developer)
SourceValue = E.DefaultValue
Setup.Set(Key, E.DefaultValue, True)
End Try
End If
End If
E.Value = CTypeDynamic(SourceValue, E.Type)
Catch ex As Exception
Log(ex, "读取设置失败:" & Key, LogLevel.Hint)
E.Value = CTypeDynamic(E.DefaultValue, E.Type)
End Try
End Sub
'对部分设置强制赋值
Private Function ForceValue(Key As String) As String
#If BETA Then
If Key = "UiLauncherTheme" Then Return "0"
#End If
If Key = "UiHiddenPageLink" Then Return True
If Key = "UiHiddenSetupLink" Then Return True
Return Nothing
End Function
#End Region
#Region "Launch"
'切换选择
Public Sub LaunchVersionSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 版本:" & Value)
WriteIni(PathMcFolder & "PCL.ini", "Version", If(IsNothing(McVersionCurrent), "", McVersionCurrent.Name))
End Sub
Public Sub LaunchFolderSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 文件夹:" & Value.ToString.Replace("$", Path))
PathMcFolder = Value.ToString.Replace("$", Path)
End Sub
'游戏内存
Public Sub LaunchRamType(Type As Integer)
If FrmSetupLaunch Is Nothing Then Exit Sub
FrmSetupLaunch.RamType(Type)
End Sub
'离线皮肤
Public Sub LaunchSkinType(Value As Integer)
RunInUi(Sub()
If Not IsNothing(FrmSetupLaunch) Then
Select Case Value
Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 3 '正版
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Visible
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
Case 4 '自定义
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Visible
End Select
FrmSetupLaunch.CardSkin.TriggerForceResize()
End If
PageLaunchLeft.SkinLegacy.Start()
End Sub)
End Sub
Public Sub LaunchSkinID(Value As String)
PageLaunchLeft.SkinLegacy.Start()
End Sub
#End Region
#Region "Tool"
Public Sub ToolDownloadThread(Value As Integer)
NetTaskThreadLimit = Value + 1
End Sub
Public Sub ToolDownloadCert(Value As Boolean)
Net.ServicePointManager.ServerCertificateValidationCallback =
If(Value, Nothing, New Net.Security.RemoteCertificateValidationCallback(Function() True))
End Sub
Public Sub ToolDownloadSpeed(Value As Integer)
If Value <= 14 Then
NetTaskSpeedLimitHigh = (Value + 1) * 0.1 * 1024 * 1024L
ElseIf Value <= 31 Then
NetTaskSpeedLimitHigh = (Value - 11) * 0.5 * 1024 * 1024L
ElseIf Value <= 41 Then
NetTaskSpeedLimitHigh = (Value - 21) * 1024 * 1024L
Else
NetTaskSpeedLimitHigh = -1
End If
End Sub
#End Region
#Region "UI"
'启动器
Public Sub UiLauncherTransparent(Value As Integer)
FrmMain.Opacity = Value / 1000 + 0.4
End Sub
#If Not BETA Then
Public Sub UiLauncherTheme(Value As Integer)
ThemeRefresh(Value)
End Sub
#End If
Public Sub UiBackgroundColorful(Value As Boolean)
ThemeRefresh()
End Sub
'背景图片
Public Sub UiBackgroundOpacity(Value As Integer)
FrmMain.ImgBack.Opacity = Value / 1000
End Sub
Public Sub UiBackgroundBlur(Value As Integer)
If Value = 0 Then
FrmMain.ImgBack.Effect = Nothing
Else
FrmMain.ImgBack.Effect = New Effects.BlurEffect With {.Radius = Value + 1}
End If
FrmMain.ImgBack.Margin = New Thickness(-(Value + 1) / 1.8)
End Sub
Public Sub UiBackgroundSuit(Value As Integer)
If IsNothing(FrmMain.ImgBack.Background) Then Exit Sub
Dim Width As Double = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
Dim Height As Double = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
If Value = 0 Then
'智能:当图片较小时平铺,较大时适应
If Width < FrmMain.PanMain.ActualWidth / 2 AndAlso Height < FrmMain.PanMain.ActualHeight / 2 Then
Value = 4 '平铺
Else
Value = 2 '适应
End If
End If
CType(FrmMain.ImgBack.Background, ImageBrush).TileMode = TileMode.None
CType(FrmMain.ImgBack.Background, ImageBrush).Viewport = New Rect(0, 0, 1, 1)
CType(FrmMain.ImgBack.Background, ImageBrush).ViewportUnits = BrushMappingMode.RelativeToBoundingBox
Select Case Value
Case 1 '居中
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Center
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Center
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
FrmMain.ImgBack.Width = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
FrmMain.ImgBack.Height = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
Case 2 '适应
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Stretch
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Stretch
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.UniformToFill
FrmMain.ImgBack.Width = Double.NaN
FrmMain.ImgBack.Height = Double.NaN
Case 3 '拉伸
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Stretch
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Stretch
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.Fill
FrmMain.ImgBack.Width = Double.NaN
FrmMain.ImgBack.Height = Double.NaN
Case 4 '平铺
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Stretch
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Stretch
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
CType(FrmMain.ImgBack.Background, ImageBrush).TileMode = TileMode.Tile
CType(FrmMain.ImgBack.Background, ImageBrush).Viewport = New Rect(0, 0, CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width, CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height)
CType(FrmMain.ImgBack.Background, ImageBrush).ViewportUnits = BrushMappingMode.Absolute
FrmMain.ImgBack.Width = Double.NaN
FrmMain.ImgBack.Height = Double.NaN
Case 5 '左上
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Left
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Top
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
FrmMain.ImgBack.Width = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
FrmMain.ImgBack.Height = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
Case 6 '右上
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Right
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Top
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
FrmMain.ImgBack.Width = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
FrmMain.ImgBack.Height = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
Case 7 '左下
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Left
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Bottom
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
FrmMain.ImgBack.Width = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
FrmMain.ImgBack.Height = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
Case 8 '右下
FrmMain.ImgBack.HorizontalAlignment = HorizontalAlignment.Right
FrmMain.ImgBack.VerticalAlignment = VerticalAlignment.Bottom
CType(FrmMain.ImgBack.Background, ImageBrush).Stretch = Stretch.None
FrmMain.ImgBack.Width = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
FrmMain.ImgBack.Height = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
End Select
End Sub
'主页
Public Sub UiCustomType(Value As Integer)
If FrmSetupUI Is Nothing Then Exit Sub
Select Case Value
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
Case 1 '本地
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
FrmSetupUI.HintCustom.EventType = ""
FrmSetupUI.HintCustom.EventData = ""
Case 2 '联网
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
FrmSetupUI.HintCustom.EventType = "打开网页"
FrmSetupUI.HintCustom.EventData = "https://github.com/Hex-Dragon/PCL2/discussions/2528"
Case 3 '预设
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Visible
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
End Select
FrmSetupUI.CardCustom.TriggerForceResize()
End Sub
'顶部栏
Public Sub UiLogoType(Value As Integer)
Select Case Value
Case 0 '无
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Visible
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 1 '默认
FrmMain.ShapeTitleLogo.Visibility = Visibility.Visible
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Case 2 '文本
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Visible
FrmMain.ImageTitleLogo.Visibility = Visibility.Collapsed
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Visible
FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
End If
Setup.Load("UiLogoText", True)
Case 3 '图片
FrmMain.ShapeTitleLogo.Visibility = Visibility.Collapsed
FrmMain.LabTitleLogo.Visibility = Visibility.Collapsed
FrmMain.ImageTitleLogo.Visibility = Visibility.Visible
If Not IsNothing(FrmSetupUI) Then
FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png")
Catch ex As Exception
FrmMain.ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", LogLevel.Msgbox)
End Try
End Select
Setup.Load("UiLogoLeft", True)
If Not IsNothing(FrmSetupUI) Then FrmSetupUI.CardLogo.TriggerForceResize()
End Sub
Public Sub UiLogoText(Value As String)
FrmMain.LabTitleLogo.Text = Value
End Sub
Public Sub UiLogoLeft(Value As Boolean)
FrmMain.PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Value AndAlso (Setup.Get("UiLogoType") = 0), 0, 1), GridUnitType.Star)
End Sub
'功能隐藏
Public Sub UiHiddenPageLink(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageDownload(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageSetup(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenPageOther(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenFunctionSelect(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenFunctionHidden(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupLaunch(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupUi(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupLink(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenSetupSystem(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherHelp(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherFeedback(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherVote(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherAbout(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
Public Sub UiHiddenOtherTest(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
#End Region
#Region "System"
'调试选项
Public Sub SystemDebugMode(Value As Boolean)
ModeDebug = Value
End Sub
Public Sub SystemDebugAnim(Value As Integer)
AniSpeed = If(Value >= 30, 200, MathClamp(Value * 0.1 + 0.1, 0.1, 3))
End Sub
#End Region
#Region "Version"
'游戏内存
Public Sub VersionRamType(Type As Integer)
If FrmVersionSetup Is Nothing Then Exit Sub
FrmVersionSetup.RamType(Type)
End Sub
'服务器
Public Sub VersionServerLogin(Type As Integer)
If FrmVersionSetup Is Nothing Then Exit Sub
'为第三方登录清空缓存以更新描述
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "")
If PageVersionLeft.Version Is Nothing Then Exit Sub
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
#End Region
End Class
@@ -81,7 +81,7 @@
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="Plain Craft Launcher 2" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角">
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -206,10 +206,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49)
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If
'设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -259,7 +257,6 @@
End If
If RamTextLeft <> Left Then
RamTextLeft = Left
'If AniControlEnabled = 0 Then
Select Case Left
Case 0
AniStart({
@@ -280,22 +277,6 @@
AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100)
}, "SetupLaunch Ram TextLeft")
End Select
'Else
' Select Case Left
' Case 0
' LabRamUsed.Opacity = 0
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0
' Case 1
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0.7
' Case 2
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 1
' LabRamUsedTitle.Opacity = 0.7
' End Select
'End If
End If
'右侧
Dim Right As Integer
@@ -404,15 +385,14 @@ 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 - 41) * 4 + 32
RamGive = (Value - 33) * 2 + 16
End If
End If
'若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive)
Return RamGive
'封顶 32G
Return Math.Min(32, RamGive)
End Function
#End Region
@@ -557,8 +537,8 @@ PreFin:
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化耗时较长,这会拖慢游戏的启动过程,建议仅在电脑内存不充裕时开启此选项。" & vbCrLf &
"如果你在使用机械硬盘,这还可能会导致一小段时间的严重卡顿。" &
If MyMsgBox("内存优化会显著延长启动耗时,建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘,这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
@@ -28,7 +28,6 @@
<local:ValidateNullable />
<local:ValidateNullOrWhiteSpace />
<local:ValidateLength Max="20" />
<local:ValidateFilter />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
@@ -58,7 +58,7 @@
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="在进行连接时,检查 SSL 证书是否正常。&#xa;进行验证会提高安全性,但疑似会导致少部分玩家的微软登录失败。" />
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -156,7 +156,7 @@
PageOtherAbout.CopyUniqueAddress()
End Sub
Private Sub BtnSystemUnlock_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemUnlock.Click
PageOtherAbout.DonateCodeInput()
DonateCodeInput()
End Sub
'调试模式
@@ -0,0 +1,295 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageSetupUI"
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="基础" x:Name="CardLauncher">
<Grid Margin="25,40,25,17">
<StackPanel>
<Grid Margin="0,0,0,6">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name1" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="30" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,20,0" />
<local:MySlider Grid.ColumnSpan="5" x:Name="SliderLauncherOpacity" Tag="UiLauncherTransparent" MaxValue="600" ValueByKey="10" Grid.Column="1" />
<TextBlock Grid.Row="1" VerticalAlignment="Center" Name="LabLauncherHue" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调" Margin="0,10,20,0" />
<local:MySlider Grid.Row="1" Grid.Column="1" x:Name="SliderLauncherHue" Tag="UiLauncherHue" Visibility="Collapsed" MaxValue="360" ValueByKey="10" Margin="0,10,0,0" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" Name="LabLauncherDelta" Visibility="Collapsed" HorizontalAlignment="Left" Text="色调渐变" Margin="0,10,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="1" x:Name="SliderLauncherDelta" Tag="UiLauncherDelta" Visibility="Collapsed" MaxValue="180" ValueByKey="5" Margin="0,10,0,0" />
<TextBlock Grid.Row="1" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherSat" Visibility="Collapsed" HorizontalAlignment="Left" Text="饱和度" Margin="0,10,20,0" />
<local:MySlider Grid.Row="1" Grid.Column="4" x:Name="SliderLauncherSat" Tag="UiLauncherSat" Visibility="Collapsed" MaxValue="100" ValueByKey="5" Margin="0,10,0,0" />
<TextBlock Grid.Row="2" Grid.Column="3" VerticalAlignment="Center" Name="LabLauncherLight" Visibility="Collapsed" HorizontalAlignment="Left" Text="亮度" Margin="0,10,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="4" x:Name="SliderLauncherLight" Tag="UiLauncherLight" Visibility="Collapsed" MaxValue="40" ValueByKey="5" Margin="0,10,0,0" />
</Grid>
<Grid x:Name="PanLauncherTheme" Height="90" Margin="0,0,0,7">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name1" />
<ColumnDefinition />
<ColumnDefinition />
<ColumnDefinition />
<ColumnDefinition />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition />
<RowDefinition />
<RowDefinition />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主题" Margin="0,0,20,0" />
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="隐藏主题" Margin="0,0,20,0" Grid.Row="1" />
<local:MyRadioBox Grid.Column="1" Grid.Row="0" Text="龙猫蓝" x:Name="RadioLauncherTheme0" Tag="UiLauncherTheme/0" />
<local:MyRadioBox Grid.Column="2" Grid.Row="0" Text="甜柠青" x:Name="RadioLauncherTheme1" Tag="UiLauncherTheme/1" />
<local:MyRadioBox Grid.Column="3" Grid.Row="0" Text="小草绿" x:Name="RadioLauncherTheme2" Tag="UiLauncherTheme/2" />
<local:MyRadioBox Grid.Column="4" Grid.Row="0" Text="菠萝黄" x:Name="RadioLauncherTheme3" Tag="UiLauncherTheme/3" />
<local:MyRadioBox Grid.Column="5" Grid.Row="0" Text="橡木棕" x:Name="RadioLauncherTheme4" Tag="UiLauncherTheme/4" />
<local:MyRadioBox Grid.Column="1" Grid.Row="1" Text="玄素黑" x:Name="RadioLauncherTheme5" Tag="UiLauncherTheme/5" Opacity="0" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="1" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme5Gray" IsEnabled="False" Opacity="1" />
<TextBlock Grid.Column="1" Grid.Row="1" x:Name="LabLauncherTheme5Unlock" Background="{StaticResource ColorBrushSemiTransparent}" ToolTip="灰色是个谎言" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="2" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme12" Tag="UiLauncherTheme/12" IsEnabled="False" ToolTip="滑稽树上滑稽果,滑稽树下你和我,滑稽之日搞事情,欢乐多又多" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="3" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme6" Tag="UiLauncherTheme/6" IsEnabled="False" ToolTip="99 次重逢的喜悦" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="4" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme7" Tag="UiLauncherTheme/7" IsEnabled="False" ToolTip="072 101 108 112 032 068 101 118 032 048 046 052 046 052" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="5" Grid.Row="1" Text="???" x:Name="RadioLauncherTheme13" Tag="UiLauncherTheme/13" IsEnabled="False" ToolTip="这就是传说中的欧皇了吧" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="1" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme8" Tag="UiLauncherTheme/8" IsEnabled="False" ToolTipService.Placement="Bottom" />
<TextBlock Grid.Column="1" Grid.Row="2" x:Name="LabLauncherTheme8Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="2" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme9" Tag="UiLauncherTheme/9" IsEnabled="False" ToolTipService.Placement="Bottom" />
<TextBlock Grid.Column="2" Grid.Row="2" x:Name="LabLauncherTheme9Copy" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="3" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme10" Tag="UiLauncherTheme/10" IsEnabled="False" ToolTip="进行一次正版登录,支持正版游戏!" ToolTipService.ShowOnDisabled="True" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="4" Grid.Row="2" Text="???" x:Name="RadioLauncherTheme11" Tag="UiLauncherTheme/11" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="右键打开解密游戏入口" />
<TextBlock Grid.Column="4" Grid.Row="2" x:Name="LabLauncherTheme11Click" Background="{StaticResource ColorBrushSemiTransparent}" ToolTipService.Placement="Bottom" />
<local:MyRadioBox Grid.Column="5" Grid.Row="2" Text="自定义" x:Name="RadioLauncherTheme14" Tag="UiLauncherTheme/14" IsEnabled="False" ToolTipService.Placement="Bottom" ToolTip="需要解锁五个隐藏主题" ToolTipService.ShowOnDisabled="True" />
</Grid>
<local:MyCheckBox Text="打开启动器时显示 PCL 图标" Margin="-1,0,0,1" Height="22" x:Name="CheckLauncherLogo" Tag="UiLauncherLogo" />
</StackPanel>
<Border Background="#CCCCCCCC" Margin="-5,22,-5,-5" CornerRadius="4" Name="PanLauncherHide" Visibility="Collapsed">
<StackPanel HorizontalAlignment="Center" VerticalAlignment="Center">
<TextBlock Text="需要小小赞助一下作者,才能修改主题颜色(悲)……" FontSize="15" Margin="0,2,0,0" />
<local:MyButton Height="35" x:Name="BtnLauncherDonate" MinWidth="150" Text="支持作者" Padding="13,0" HorizontalAlignment="Center" Margin="0,9,0,0" ColorType="Highlight" />
</StackPanel>
</Border>
</Grid>
</local:MyCard>
<local:MyCard x:Name="CardBackground" Margin="0,0,0,15" Title="背景图片">
<StackPanel Margin="25,40,25,20">
<Grid x:Name="PanBackgroundSuit" Height="28" Margin="0,0,0,10" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自适应方式" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboBackgroundSuit" Tag="UiBackgroundSuit" Grid.Column="1">
<local:MyComboBoxItem Content="智能" IsSelected="True" ToolTip="当图片较小时选择平铺,较大时选择适应" />
<local:MyComboBoxItem Content="居中" />
<local:MyComboBoxItem Content="适应" ToolTip="拉伸图片并保持长宽比不变,直至填满整个窗口" />
<local:MyComboBoxItem Content="拉伸" ToolTip="拉伸图片使其恰好填满整个窗口,很可能会导致长宽比的改变" />
<local:MyComboBoxItem Content="平铺" />
<local:MyComboBoxItem Content="居于左上" />
<local:MyComboBoxItem Content="居于右上" />
<local:MyComboBoxItem Content="居于左下" />
<local:MyComboBoxItem Content="居于右下" />
</local:MyComboBox>
</Grid>
<Grid x:Name="PanBackgroundOpacity" Height="22" Margin="0,0,0,7" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="不透明度" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderBackgroundOpacity" Tag="UiBackgroundOpacity" MaxValue="1000" ValueByKey="10" Grid.Column="1" />
</Grid>
<Grid x:Name="PanBackgroundBlur" Height="22" Margin="0,0,0,10" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="背景模糊" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderBackgroundBlur" Tag="UiBackgroundBlur" MaxValue="40" Grid.Column="1" ToolTip="较强的模糊会导致启动器严重掉帧,请谨慎使用。&#13;不建议在制作整合包时开启模糊,以确保 PCL 在低性能电脑上可以流畅运行。" />
</Grid>
<local:MyCheckBox Text="使用彩色背景" Margin="-1,0,0,8" Height="22" x:Name="CheckBackgroundColorful" Tag="UiBackgroundColorful" />
<Grid Height="35" Margin="0,2,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnBackgroundOpen" MinWidth="140" Text="打开文件夹" Padding="13,0" Margin="0,0,20,0" ToolTip="将背景图片放到该文件夹,PCL 将会在每次打开时随机加载其中的一张图片"/>
<local:MyButton x:Name="BtnBackgroundRefresh" MinWidth="140" Text="刷新背景图片" Padding="13,0" Margin="0,0,20,0" ToolTip="随机加载文件夹内的一张背景图片" Grid.Column="1"/>
<local:MyButton x:Name="BtnBackgroundClear" MinWidth="140" Text="清空背景图片" Visibility="Collapsed" Padding="13,0" Margin="0,0,20,0" ColorType="Red" Grid.Column="2"/>
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardMusic" Margin="0,0,0,15" Title="背景音乐">
<StackPanel Margin="25,42,25,20">
<Grid x:Name="PanMusicVolume" Visibility="Collapsed" Height="22" Margin="0,0,0,10">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="音量" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderMusicVolume" Tag="UiMusicVolume" MaxValue="1000" ValueByKey="10" Grid.Column="1" />
</Grid>
<StackPanel x:Name="PanMusicDetail" Visibility="Collapsed" Margin="-1,0,0,3">
<local:MyCheckBox Text="随机播放" Margin="0,0,0,5" Height="22" x:Name="CheckMusicRandom" Tag="UiMusicRandom" />
<local:MyCheckBox Text="打开启动器自动开始播放" Margin="0,0,0,5" Height="22" x:Name="CheckMusicAuto" Tag="UiMusicAuto" />
<local:MyCheckBox Text="游戏启动后自动开始播放,游戏退出后自动暂停播放" Margin="0,0,0,5" Height="22" x:Name="CheckMusicStart" Tag="UiMusicStart" />
<local:MyCheckBox Text="游戏启动后自动暂停播放,游戏退出后自动开始播放" Margin="0,0,0,5" Height="22" x:Name="CheckMusicStop" Tag="UiMusicStop" />
</StackPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnMusicOpen" Text="打开文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ToolTip="将背景音乐放到该文件夹,PCL 将会播放其中的所有音乐"/>
<local:MyButton x:Name="BtnMusicRefresh" Text="刷新背景音乐" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ToolTip="刷新播放列表,并播放列表中的音乐" Grid.Column="1"/>
<local:MyButton x:Name="BtnMusicClear" Text="清空背景音乐" MinWidth="140" Visibility="Collapsed" Padding="13,0" Margin="0,0,20,0" ColorType="Red" Grid.Column="2"/>
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardLogo" Margin="0,0,0,15" Title="标题栏">
<StackPanel Margin="25,40,25,15">
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="0.2*" />
</Grid.ColumnDefinitions>
<local:MyRadioBox Text="无" x:Name="RadioLogoType0" Height="22" Tag="UiLogoType/0" Grid.Column="0" />
<local:MyRadioBox Text="默认" x:Name="RadioLogoType1" Height="22" Tag="UiLogoType/1" Grid.Column="1" />
<local:MyRadioBox Text="文本" x:Name="RadioLogoType2" Height="22" Tag="UiLogoType/2" Grid.Column="2" />
<local:MyRadioBox Text="图片" x:Name="RadioLogoType3" Height="22" Tag="UiLogoType/3" Grid.Column="3" />
</Grid>
<local:MyCheckBox Text="标题栏居左" Margin="-1,8,0,3" Height="22" x:Name="CheckLogoLeft" Tag="UiLogoLeft" Visibility="Collapsed" />
<Grid x:Name="PanLogoText" Margin="0,14,0,5" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="标题栏文本" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextLogoText" Tag="UiLogoText" Grid.Column="1" MaxLength="30" />
</Grid>
<Grid x:Name="PanLogoChange" Margin="0,14,0,5" Height="35" Visibility="Collapsed">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnLogoChange" Text="更改图片" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnLogoDelete" Text="清空图片" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Red" Grid.Column="1" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="主页" x:Name="CardCustom">
<StackPanel Margin="25,40,25,15">
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="0.2*" />
</Grid.ColumnDefinitions>
<local:MyRadioBox Text="空白" x:Name="RadioCustomType0" Height="22" Tag="UiCustomType/0" Grid.Column="0" />
<local:MyRadioBox Text="预设" x:Name="RadioCustomType3" Height="22" Tag="UiCustomType/3" Grid.Column="1" />
<local:MyRadioBox Text="读取本地文件" x:Name="RadioCustomType1" Height="22" Tag="UiCustomType/1" Grid.Column="2" />
<local:MyRadioBox Text="联网更新" x:Name="RadioCustomType2" Height="22" Tag="UiCustomType/2" Grid.Column="3" />
</Grid>
<local:MyHint Margin="0,15,0,1" Text="内容见 ModSetup" IsWarn="False" x:Name="HintCustom" />
<Grid Height="35" x:Name="PanCustomLocal" Visibility="Collapsed" Margin="0,10,0,5">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnCustomRefresh" Grid.Column="0" MinWidth="140" Text="刷新主页" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnCustomFile" Grid.Column="1" MinWidth="140" Text="生成教学文件" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnCustomTutorial" Grid.Column="2" MinWidth="140" Text="查看教程" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
<Grid x:Name="PanCustomNet" Visibility="Collapsed" Margin="0,10,0,5">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载地址" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextCustomNet" Tag="UiCustomNet" Grid.Column="1" MaxHeight="28">
<local:MyTextBox.ValidateRules>
<local:ValidateHttp />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
<Grid x:Name="PanCustomPreset" Visibility="Collapsed" Margin="0,12,10,5" Height="28">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页预设" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboCustomPreset" Grid.ColumnSpan="2" Tag="UiCustomPreset" Grid.Column="1">
<local:MyComboBoxItem Content="你知道吗?" IsSelected="True" />
<local:MyComboBoxItem Content="回声洞" />
<local:MyComboBoxItem Content="Minecraft 新闻(作者:最亮的信标)" />
<local:MyComboBoxItem Content="简单主页(作者:MFn233)" />
<local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
</local:MyComboBox>
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardSwitch" Margin="0,0,0,15" Title="功能隐藏">
<StackPanel Margin="25,38,15,15">
<TextBlock Margin="0,1,0,1" Text="你可以隐藏不需要的页面或关闭特定功能。在任意界面按 F12 可以暂时显示被隐藏的功能。" TextWrapping="Wrap" />
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="18" />
<ColumnDefinition Width="0.8*" />
<ColumnDefinition Width="0.9*" />
<ColumnDefinition Width="0.8*" />
<ColumnDefinition Width="0.6*" />
<ColumnDefinition Width="1.0*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="4" />
<RowDefinition Height="30" />
<RowDefinition Height="30" />
<RowDefinition Height="30" />
<RowDefinition Height="30" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="2" Text="下载" x:Name="CheckHiddenPageDownload" Tag="UiHiddenPageDownload" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Visibility="Collapsed" Text="联机" x:Name="CheckHiddenPageLink" Tag="UiHiddenPageLink" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Text="设置" x:Name="CheckHiddenPageSetup" Tag="UiHiddenPageSetup" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="4" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="设置 子页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="2" Text="游戏" x:Name="CheckHiddenSetupLaunch" Tag="UiHiddenSetupLaunch" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" Text="个性化" x:Name="CheckHiddenSetupUI" Tag="UiHiddenSetupUi" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="4" Text="启动器" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="5" Text="联机" x:Name="CheckHiddenSetupLink" Tag="UiHiddenSetupLink" Visibility="Collapsed" />
<TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="更多 子页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="2" Text="帮助" x:Name="CheckHiddenOtherHelp" Tag="UiHiddenOtherHelp" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="3" Text="关于与鸣谢" x:Name="CheckHiddenOtherAbout" Tag="UiHiddenOtherAbout" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="4" Text="百宝箱" x:Name="CheckHiddenOtherTest" Tag="UiHiddenOtherTest" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="5" Text="反馈" x:Name="CheckHiddenOtherFeedback" Tag="UiHiddenOtherFeedback" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="3" Grid.Column="6" Text="新功能投票" x:Name="CheckHiddenOtherVote" Tag="UiHiddenOtherVote" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="特定功能" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="4" Grid.Column="2" Text="邮箱隐藏" x:Name="CheckLauncherEmail" Tag="UiLauncherEmail" ToolTip="隐藏第三方登录的账号邮箱显示,并尽量将邮箱打码,以避免隐私泄露。&#xa;此选项的更改将在重启启动器后生效。" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="4" Grid.Column="3" Text="版本选择" x:Name="CheckHiddenFunctionSelect" Tag="UiHiddenFunctionSelect" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="4" Grid.Column="4" Text="功能隐藏" x:Name="CheckHiddenFunctionHidden" Tag="UiHiddenFunctionHidden" ToolTip="仅隐藏本选项卡,设置的禁用内容依然有效。&#xa;可以在保留个性化设置页面的情况下避免隐藏设置被修改。" />
</Grid>
</StackPanel>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,698 @@
Public Class PageSetupUI
Public Shadows IsLoaded As Boolean = False
Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'重复加载部分
PanBack.ScrollToHome()
ThemeCheckAll(True)
If ThemeDontClick <> 0 Then
Dim NewText As String
Select Case ThemeDontClick
Case 1
NewText = "眼瞎白"
Case 2
NewText = "真·滑稽彩"
Case Else
NewText = "???"
End Select
For Each Control In PanLauncherTheme.Children
If (TypeOf Control Is MyRadioBox) AndAlso CType(Control, MyRadioBox).IsEnabled Then
CType(Control, MyRadioBox).Text = NewText
End If
Next
End If
'非重复加载部分
If IsLoaded Then Exit Sub
IsLoaded = True
AniControlEnabled += 1
SliderLoad()
Reload()
AniControlEnabled -= 1
#If BETA Then
PanLauncherHide.Visibility = Visibility.Visible
#End If
'设置解锁
If Not RadioLauncherTheme8.IsEnabled Then LabLauncherTheme8Copy.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁。" & vbCrLf & "右键打开赞助页面,如果觉得 PCL 做得还不错就支持一下吧 =w=!"
RadioLauncherTheme8.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁(右键打开反馈页面)" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
'极客蓝的处理在 ThemeCheck 中
End Sub
Public Sub Reload()
Try
'启动器
SliderLauncherOpacity.Value = Setup.Get("UiLauncherTransparent")
SliderLauncherHue.Value = Setup.Get("UiLauncherHue")
SliderLauncherSat.Value = Setup.Get("UiLauncherSat")
SliderLauncherDelta.Value = Setup.Get("UiLauncherDelta")
SliderLauncherLight.Value = Setup.Get("UiLauncherLight")
If Setup.Get("UiLauncherTheme") <= 14 Then CType(FindName("RadioLauncherTheme" & Setup.Get("UiLauncherTheme")), MyRadioBox).Checked = True
CheckLauncherLogo.Checked = Setup.Get("UiLauncherLogo")
CheckLauncherEmail.Checked = Setup.Get("UiLauncherEmail")
'背景图片
SliderBackgroundOpacity.Value = Setup.Get("UiBackgroundOpacity")
SliderBackgroundBlur.Value = Setup.Get("UiBackgroundBlur")
ComboBackgroundSuit.SelectedIndex = Setup.Get("UiBackgroundSuit")
CheckBackgroundColorful.Checked = Setup.Get("UiBackgroundColorful")
BackgroundRefresh(False, False)
'标题栏
CType(FindName("RadioLogoType" & Setup.Get("UiLogoType")), MyRadioBox).Checked = True
CheckLogoLeft.Visibility = If(RadioLogoType0.Checked, Visibility.Visible, Visibility.Collapsed)
PanLogoText.Visibility = If(RadioLogoType2.Checked, Visibility.Visible, Visibility.Collapsed)
PanLogoChange.Visibility = If(RadioLogoType3.Checked, Visibility.Visible, Visibility.Collapsed)
TextLogoText.Text = Setup.Get("UiLogoText")
CheckLogoLeft.Checked = Setup.Get("UiLogoLeft")
'背景音乐
CheckMusicRandom.Checked = Setup.Get("UiMusicRandom")
CheckMusicAuto.Checked = Setup.Get("UiMusicAuto")
CheckMusicStop.Checked = Setup.Get("UiMusicStop")
CheckMusicStart.Checked = Setup.Get("UiMusicStart")
SliderMusicVolume.Value = Setup.Get("UiMusicVolume")
MusicRefreshUI()
'主页
Try
ComboCustomPreset.SelectedIndex = Setup.Get("UiCustomPreset")
Catch
Setup.Reset("UiCustomPreset")
End Try
CType(FindName("RadioCustomType" & Setup.Load("UiCustomType")), MyRadioBox).Checked = True
TextCustomNet.Text = Setup.Get("UiCustomNet")
'功能隐藏
CheckHiddenPageDownload.Checked = Setup.Get("UiHiddenPageDownload")
CheckHiddenPageLink.Checked = Setup.Get("UiHiddenPageLink")
CheckHiddenPageSetup.Checked = Setup.Get("UiHiddenPageSetup")
CheckHiddenPageOther.Checked = Setup.Get("UiHiddenPageOther")
CheckHiddenFunctionSelect.Checked = Setup.Get("UiHiddenFunctionSelect")
CheckHiddenFunctionHidden.Checked = Setup.Get("UiHiddenFunctionHidden")
CheckHiddenSetupLaunch.Checked = Setup.Get("UiHiddenSetupLaunch")
CheckHiddenSetupUI.Checked = Setup.Get("UiHiddenSetupUi")
CheckHiddenSetupLink.Checked = Setup.Get("UiHiddenSetupLink")
CheckHiddenSetupSystem.Checked = Setup.Get("UiHiddenSetupSystem")
CheckHiddenOtherAbout.Checked = Setup.Get("UiHiddenOtherAbout")
CheckHiddenOtherFeedback.Checked = Setup.Get("UiHiddenOtherFeedback")
CheckHiddenOtherVote.Checked = Setup.Get("UiHiddenOtherVote")
CheckHiddenOtherHelp.Checked = Setup.Get("UiHiddenOtherHelp")
CheckHiddenOtherTest.Checked = Setup.Get("UiHiddenOtherTest")
Catch ex As NullReferenceException
Log(ex, "个性化设置项存在异常,已被自动重置", LogLevel.Msgbox)
Reset()
Catch ex As Exception
Log(ex, "重载个性化设置时出错", LogLevel.Feedback)
End Try
End Sub
'初始化
Public Sub Reset()
Try
Setup.Reset("UiLauncherTransparent")
Setup.Reset("UiLauncherTheme")
Setup.Reset("UiLauncherLogo")
Setup.Reset("UiLauncherHue")
Setup.Reset("UiLauncherSat")
Setup.Reset("UiLauncherDelta")
Setup.Reset("UiLauncherLight")
Setup.Reset("UiLauncherEmail")
Setup.Reset("UiBackgroundColorful")
Setup.Reset("UiBackgroundOpacity")
Setup.Reset("UiBackgroundBlur")
Setup.Reset("UiBackgroundSuit")
Setup.Reset("UiLogoType")
Setup.Reset("UiLogoText")
Setup.Reset("UiLogoLeft")
Setup.Reset("UiMusicVolume")
Setup.Reset("UiMusicStop")
Setup.Reset("UiMusicStart")
Setup.Reset("UiMusicRandom")
Setup.Reset("UiMusicAuto")
Setup.Reset("UiCustomType")
Setup.Reset("UiCustomPreset")
Setup.Reset("UiCustomNet")
Setup.Reset("UiHiddenPageDownload")
Setup.Reset("UiHiddenPageLink")
Setup.Reset("UiHiddenPageSetup")
Setup.Reset("UiHiddenPageOther")
Setup.Reset("UiHiddenFunctionSelect")
Setup.Reset("UiHiddenFunctionHidden")
Setup.Reset("UiHiddenSetupLaunch")
Setup.Reset("UiHiddenSetupUi")
Setup.Reset("UiHiddenSetupLink")
Setup.Reset("UiHiddenSetupSystem")
Setup.Reset("UiHiddenOtherAbout")
Setup.Reset("UiHiddenOtherFeedback")
Setup.Reset("UiHiddenOtherVote")
Setup.Reset("UiHiddenOtherHelp")
Setup.Reset("UiHiddenOtherTest")
Log("[Setup] 已初始化个性化设置!")
Hint("已初始化个性化设置", HintType.Finish, False)
Catch ex As Exception
Log(ex, "初始化个性化设置失败", LogLevel.Msgbox)
End Try
Reload()
End Sub
'将控件改变路由到设置改变
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderBackgroundOpacity.Change, SliderBackgroundBlur.Change, SliderLauncherOpacity.Change, SliderMusicVolume.Change, SliderLauncherHue.Change, SliderLauncherLight.Change, SliderLauncherSat.Change, SliderLauncherDelta.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboBackgroundSuit.SelectionChanged, ComboCustomPreset.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLogoText.ValidatedTextChanged, TextCustomNet.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
End Sub
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioLogoType0.Check, RadioLogoType1.Check, RadioLogoType2.Check, RadioLogoType3.Check, RadioLauncherTheme0.Check, RadioLauncherTheme1.Check, RadioLauncherTheme2.Check, RadioLauncherTheme3.Check, RadioLauncherTheme4.Check, RadioLauncherTheme5.Check, RadioLauncherTheme6.Check, RadioLauncherTheme7.Check, RadioLauncherTheme8.Check, RadioLauncherTheme9.Check, RadioLauncherTheme10.Check, RadioLauncherTheme11.Check, RadioLauncherTheme12.Check, RadioLauncherTheme13.Check, RadioLauncherTheme14.Check, RadioCustomType0.Check, RadioCustomType1.Check, RadioCustomType2.Check, RadioCustomType3.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)))
End Sub
'背景图片
Private Sub BtnUIBgOpen_Click(sender As Object, e As EventArgs) Handles BtnBackgroundOpen.Click
OpenExplorer("""" & Path & "PCL\Pictures""")
End Sub
Private Sub BtnBackgroundRefresh_Click(sender As Object, e As EventArgs) Handles BtnBackgroundRefresh.Click
BackgroundRefresh(True, True)
End Sub
Public Sub BackgroundRefreshUI(Show As Boolean, Count As Integer)
If IsNothing(PanBackgroundOpacity) Then Exit Sub
If Show Then
PanBackgroundOpacity.Visibility = Visibility.Visible
PanBackgroundBlur.Visibility = Visibility.Visible
PanBackgroundSuit.Visibility = Visibility.Visible
BtnBackgroundClear.Visibility = Visibility.Visible
CardBackground.Title = "背景图片(" & Count & " 张)"
Else
PanBackgroundOpacity.Visibility = Visibility.Collapsed
PanBackgroundBlur.Visibility = Visibility.Collapsed
PanBackgroundSuit.Visibility = Visibility.Collapsed
BtnBackgroundClear.Visibility = Visibility.Collapsed
CardBackground.Title = "背景图片"
End If
CardBackground.TriggerForceResize()
End Sub
Private Sub BtnBackgroundClear_Click(sender As Object, e As EventArgs) Handles BtnBackgroundClear.Click
If MyMsgBox("即将删除背景图片文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
DeleteDirectory(Path & "PCL\Pictures")
BackgroundRefresh(False, True)
Hint("背景图片已清空!", HintType.Finish)
End If
End Sub
''' <summary>
''' 刷新背景图片及设置页 UI。
''' </summary>
''' <param name="IsHint">是否显示刷新提示。</param>
''' <param name="Refresh">是否刷新图片显示。</param>
Public Shared Sub BackgroundRefresh(IsHint As Boolean, Refresh As Boolean)
Try
'获取可用的图片文件
Directory.CreateDirectory(Path & "PCL\Pictures\")
Dim Pic As New List(Of String)
For Each File In EnumerateFiles(Path & "PCL\Pictures\")
If File.Extension.ToLower <> ".ini" AndAlso File.Extension.ToLower <> ".db" Then '文件夹可能会被加入 .ini 和 thumbs.db
Pic.Add(File.FullName)
End If
Next
'加载
If Not Pic.Any() Then
If Refresh Then
If FrmMain.ImgBack.Visibility = Visibility.Collapsed Then
If IsHint Then Hint("未检测到可用背景图片!", HintType.Critical)
Else
FrmMain.ImgBack.Visibility = Visibility.Collapsed
If IsHint Then Hint("背景图片已清除!", HintType.Finish)
End If
End If
If Not IsNothing(FrmSetupUI) Then FrmSetupUI.BackgroundRefreshUI(False, 0)
Else
If Refresh Then
Dim Address As String = RandomOne(Pic)
Try
Log("[UI] 加载背景图片:" & Address)
FrmMain.ImgBack.Background = New MyBitmap(Address)
Setup.Load("UiBackgroundSuit", True)
FrmMain.ImgBack.Visibility = Visibility.Visible
If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("刷新背景图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。" & vbCrLf &
"文件:" & Address, LogLevel.Msgbox)
Else
Log(ex, "刷新背景图片失败(" & Address & ")", LogLevel.Msgbox)
End If
End Try
End If
If Not IsNothing(FrmSetupUI) Then FrmSetupUI.BackgroundRefreshUI(True, Pic.Count)
End If
Catch ex As Exception
Log(ex, "刷新背景图片时出现未知错误", LogLevel.Feedback)
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", "选择图片")
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")
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("改变标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。", LogLevel.Msgbox)
Else
Log(ex, "设置标题栏图片失败", LogLevel.Msgbox)
End If
FrmMain.ImageTitleLogo.Source = Nothing
End Try
End Sub
Private Sub RadioLogoType3_Check(sender As Object, e As RouteEventArgs) Handles RadioLogoType3.PreviewCheck
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Exit Sub
Refresh:
'已有图片则不再选择
If File.Exists(Path & "PCL\Logo.png") Then
Try
FrmMain.ImageTitleLogo.Source = New MyBitmap(Path & "PCL\Logo.png")
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("调整标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。", LogLevel.Msgbox)
Else
Log(ex, "调整标题栏图片失败", LogLevel.Msgbox)
End If
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Try
File.Delete(Path & "PCL\Logo.png")
Catch exx As Exception
Log(exx, "清理错误的标题栏图片失败", LogLevel.Msgbox)
End Try
End Try
Exit Sub
End If
'没有图片则要求选择
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片")
If FileName = "" Then
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Else
Try
'拷贝文件
File.Delete(Path & "PCL\Logo.png")
CopyFile(FileName, Path & "PCL\Logo.png")
GoTo Refresh
Catch ex As Exception
Log(ex, "复制标题栏图片失败", LogLevel.Msgbox)
End Try
End If
End Sub
Private Sub BtnLogoDelete_Click(sender As Object, e As EventArgs) Handles BtnLogoDelete.Click
Try
File.Delete(Path & "PCL\Logo.png")
RadioLogoType1.SetChecked(True, True, True)
Hint("标题栏图片已清空!", HintType.Finish)
Catch ex As Exception
Log(ex, "清空标题栏图片失败", LogLevel.Msgbox)
End Try
End Sub
'背景音乐
Private Sub BtnMusicOpen_Click(sender As Object, e As EventArgs) Handles BtnMusicOpen.Click
OpenExplorer("""" & Path & "PCL\Musics""")
End Sub
Private Sub BtnMusicRefresh_Click(sender As Object, e As EventArgs) Handles BtnMusicRefresh.Click
MusicRefreshPlay(True)
End Sub
Public Sub MusicRefreshUI()
If PanBackgroundOpacity Is Nothing Then Exit Sub
If MusicAllList.Any Then
PanMusicVolume.Visibility = Visibility.Visible
PanMusicDetail.Visibility = Visibility.Visible
BtnMusicClear.Visibility = Visibility.Visible
CardMusic.Title = "背景音乐(" & EnumerateFiles(Path & "PCL\Musics\").Count & " 首)"
Else
PanMusicVolume.Visibility = Visibility.Collapsed
PanMusicDetail.Visibility = Visibility.Collapsed
BtnMusicClear.Visibility = Visibility.Collapsed
CardMusic.Title = "背景音乐"
End If
CardMusic.TriggerForceResize()
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)
End If
End Sub
Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change
If AniControlEnabled <> 0 Then Exit Sub
If CheckMusicStart.Checked Then CheckMusicStop.Checked = False
End Sub
Private Sub CheckMusicStop_Change() Handles CheckMusicStop.Change
If AniControlEnabled <> 0 Then Exit Sub
If CheckMusicStop.Checked Then CheckMusicStart.Checked = False
End Sub
'主页
Private Sub BtnCustomFile_Click(sender As Object, e As EventArgs) Handles BtnCustomFile.Click
Try
If File.Exists(Path & "PCL\Custom.xaml") Then
If MyMsgBox("当前已存在布局文件,继续生成教学文件将会覆盖现有布局文件!", "覆盖确认", "继续", "取消", IsWarn:=True) = 2 Then Exit Sub
End If
WriteFile(Path & "PCL\Custom.xaml", GetResources("Custom"))
Hint("教学文件已生成!", HintType.Finish)
OpenExplorer("/select,""" & Path & "PCL\Custom.xaml""")
Catch ex As Exception
Log(ex, "生成教学文件失败", LogLevel.Feedback)
End Try
End Sub
Private Sub BtnCustomRefresh_Click() Handles BtnCustomRefresh.Click
FrmLaunchRight.ForceRefresh()
Hint("已刷新主页!", HintType.Finish)
End Sub
Private Sub BtnCustomTutorial_Click(sender As Object, e As EventArgs) Handles BtnCustomTutorial.Click
MyMsgBox("1. 点击 生成教学文件 按钮,这会在 PCL 文件夹下生成 Custom.xaml 布局文件。" & vbCrLf &
"2. 使用记事本等工具打开这个文件并进行修改,修改完记得保存。" & vbCrLf &
"3. 点击 刷新主页 按钮,查看主页现在长啥样了。" & vbCrLf &
vbCrLf &
"你可以在生成教学文件后直接刷新主页,对照着进行修改,更有助于理解。" & vbCrLf &
"直接将自定义主页文件拖进 PCL 窗口也可以快捷加载。", "主页自定义教程")
End Sub
'主题
Private Sub LabLauncherTheme5Unlock_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles LabLauncherTheme5Unlock.MouseLeftButtonUp
RadioLauncherTheme5Gray.Opacity -= 0.23
RadioLauncherTheme5.Opacity += 0.23
AniStart({
AaOpacity(RadioLauncherTheme5Gray, 1, 1000),
AaOpacity(RadioLauncherTheme5, -1, 1000)
}, "ThemeUnlock")
If RadioLauncherTheme5Gray.Opacity < 0.08 Then
ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!")
AniStop("ThemeUnlock")
RadioLauncherTheme5.Checked = True
End If
End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then
If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
"3. 在你感到迷茫的时候,看看回声洞可能会给你带来惊喜。" & vbCrLf & vbCrLf &
"若违规,可能会被从任意相关群中踢出!",
"解密游戏的基本规则", "我知道了", "恕我拒绝") = 1 Then
MyMsgBox("你需要用自己的智慧来找到下一步的线索……" & vbCrLf &
"初始线索:gnp.dorC61\60\20\0202\moc.x1xa.2s\\:sp" & "T".ToLower & "th", "解密游戏") '防止触发病毒检测规则
End If
End If
End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
OpenWebsite("https://afdian.net/a/LTCat")
End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
PageOtherLeft.TryFeedback()
End Sub
'主题自定义
Private Sub RadioLauncherTheme14_Change(sender As Object, e As RouteEventArgs) Handles RadioLauncherTheme14.Changed
If RadioLauncherTheme14.Checked Then
If LabLauncherHue.Visibility = Visibility.Visible Then Exit Sub
LabLauncherHue.Visibility = Visibility.Visible
SliderLauncherHue.Visibility = Visibility.Visible
LabLauncherSat.Visibility = Visibility.Visible
SliderLauncherSat.Visibility = Visibility.Visible
LabLauncherDelta.Visibility = Visibility.Visible
SliderLauncherDelta.Visibility = Visibility.Visible
LabLauncherLight.Visibility = Visibility.Visible
SliderLauncherLight.Visibility = Visibility.Visible
Else
If LabLauncherHue.Visibility = Visibility.Collapsed Then Exit Sub
LabLauncherHue.Visibility = Visibility.Collapsed
SliderLauncherHue.Visibility = Visibility.Collapsed
LabLauncherSat.Visibility = Visibility.Collapsed
SliderLauncherSat.Visibility = Visibility.Collapsed
LabLauncherDelta.Visibility = Visibility.Collapsed
SliderLauncherDelta.Visibility = Visibility.Collapsed
LabLauncherLight.Visibility = Visibility.Collapsed
SliderLauncherLight.Visibility = Visibility.Collapsed
End If
CardLauncher.TriggerForceResize()
End Sub
Private Sub HSL_Change() Handles SliderLauncherHue.Change, SliderLauncherLight.Change, SliderLauncherSat.Change, SliderLauncherDelta.Change
If AniControlEnabled <> 0 OrElse SliderLauncherSat Is Nothing OrElse Not SliderLauncherSat.IsLoaded Then Exit Sub
ThemeRefresh()
End Sub
#Region "功能隐藏"
Private Shared _HiddenForceShow As Boolean = False
''' <summary>
''' 是否强制显示被禁用的功能。
''' </summary>
Public Shared Property HiddenForceShow As Boolean
Get
Return _HiddenForceShow
End Get
Set(value As Boolean)
_HiddenForceShow = value
HiddenRefresh()
End Set
End Property
''' <summary>
''' 更新功能隐藏带来的显示变化。
''' </summary>
Public Shared Sub HiddenRefresh() Handles Me.Loaded
If FrmMain.PanTitleSelect Is Nothing OrElse Not FrmMain.PanTitleSelect.IsLoaded Then Exit Sub
Try
'顶部栏
If Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload") AndAlso Setup.Get("UiHiddenPageLink") AndAlso Setup.Get("UiHiddenPageSetup") AndAlso Setup.Get("UiHiddenPageOther") Then
'顶部栏已被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Collapsed
Else
'顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If
'功能
FrmLaunchLeft.RefreshButtonsUI()
If FrmSetupUI IsNot Nothing Then
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
End If
'设置子页面
If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
Dim AvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupUi") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupSystem") Then AvaliableCount += 1
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
'更多子页面
Dim OtherAvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Setup.Get("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If FrmOtherLeft IsNot Nothing Then
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
FrmOtherLeft.PanItem.Visibility = If(OtherAvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
If OtherAvaliableCount = 1 AndAlso Not HiddenForceShow Then
If Not Setup.Get("UiHiddenOtherHelp") Then
FrmMain.BtnTitleSelect4.Text = "帮助"
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then
FrmMain.BtnTitleSelect4.Text = "关于"
Else
FrmMain.BtnTitleSelect4.Text = "百宝箱"
End If
Else
FrmMain.BtnTitleSelect4.Text = "更多"
End If
'各个页面的入口
If FrmMain.PageCurrent = FormMain.PageType.VersionSelect Then FrmSelectRight.BtnEmptyDownload_Loaded()
If FrmMain.PageCurrent = FormMain.PageType.Launch Then FrmLaunchLeft.RefreshButtonsUI()
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmVersionModDisabled IsNot Nothing Then FrmVersionModDisabled.BtnDownload_Loaded()
'备注
If FrmSetupUI IsNot Nothing Then FrmSetupUI.CardSwitch.Title = If(HiddenForceShow, "功能隐藏(已暂时关闭,按 F12 以重新启用)", "功能隐藏")
Catch ex As Exception
Log(ex, "刷新功能隐藏项目失败", LogLevel.Feedback)
End Try
End Sub
'UI 协同改变
Private Sub HiddenSetupMain() Handles CheckHiddenPageSetup.Change
'设置主页面
If CheckHiddenPageSetup.Checked Then
'开启
CheckHiddenSetupLaunch.Checked = True
CheckHiddenSetupSystem.Checked = True
CheckHiddenSetupLink.Checked = True
CheckHiddenSetupUI.Checked = True
Else
'关闭
If Setup.Get("UiHiddenSetupLaunch") AndAlso Setup.Get("UiHiddenSetupUi") AndAlso Setup.Get("UiHiddenSetupSystem") AndAlso Setup.Get("UiHiddenSetupLink") Then
CheckHiddenSetupLaunch.Checked = False
CheckHiddenSetupSystem.Checked = False
CheckHiddenSetupLink.Checked = False
CheckHiddenSetupUI.Checked = False
End If
End If
End Sub
Private Sub HiddenSetupSub() Handles CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change
'设置子页面
If Setup.Get("UiHiddenSetupLaunch") AndAlso Setup.Get("UiHiddenSetupUi") AndAlso Setup.Get("UiHiddenSetupSystem") AndAlso Setup.Get("UiHiddenSetupLink") Then
'已被全部隐藏
CheckHiddenPageSetup.Checked = True
Else
'未被全部隐藏
CheckHiddenPageSetup.Checked = False
End If
End Sub
Private Sub HiddenOtherMain() Handles CheckHiddenPageOther.Change
'更多主页面
If CheckHiddenPageOther.Checked Then
'开启
CheckHiddenOtherAbout.Checked = True
CheckHiddenOtherTest.Checked = True
CheckHiddenOtherFeedback.Checked = True
CheckHiddenOtherVote.Checked = True
CheckHiddenOtherHelp.Checked = True
Else
'关闭
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") AndAlso
Setup.Get("UiHiddenOtherVote") AndAlso Setup.Get("UiHiddenOtherFeedback") Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherFeedback.Checked = False
CheckHiddenOtherVote.Checked = False
CheckHiddenOtherHelp.Checked = False
End If
End If
End Sub
Private Sub HiddenOtherSub(sender As Object, user As Boolean) Handles CheckHiddenOtherHelp.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherTest.Change
'更多子页面(有具体内容的)
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") Then
'已被全部隐藏
CheckHiddenPageOther.Checked = True
Else
'未被全部隐藏
CheckHiddenPageOther.Checked = False
End If
'修改无具体内容的项
If Not user Then Exit Sub
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") Then
CheckHiddenOtherFeedback.Checked = True
CheckHiddenOtherVote.Checked = True
End If
End Sub
Private Sub HiddenOtherNet(sender As Object, user As Boolean) Handles CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change
'更多子页面(无具体内容的)
If Not user Then Exit Sub
If Setup.Get("UiHiddenOtherHelp") AndAlso Setup.Get("UiHiddenOtherAbout") AndAlso Setup.Get("UiHiddenOtherTest") AndAlso
(Not Setup.Get("UiHiddenOtherFeedback") OrElse Not Setup.Get("UiHiddenOtherVote")) Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherHelp.Checked = False
End If
End Sub
'警告提示
Private Sub HiddenHint(sender As Object, user As Boolean) Handles CheckHiddenFunctionHidden.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupUI.Change
If AniControlEnabled = 0 AndAlso sender.Checked Then Hint("按 F12 即可暂时关闭功能隐藏设置。千万别忘了,要不然设置就改不回来了……")
End Sub
#End Region
'公开预览版
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.net/a/LTCat")
End Sub
'滑动条
Private Sub SliderLoad()
SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%"
SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherSat.GetHintText = Function(v) v & "%"
SliderLauncherDelta.GetHintText = Function(Value As Integer)
If Value > 90 Then
Return "+" & (Value - 90)
ElseIf Value = 90 Then
Return 0
Else
Return Value - 90
End If
End Function
SliderLauncherLight.GetHintText = Function(Value As Integer)
If Value > 20 Then
Return "+" & (Value - 20)
ElseIf Value = 20 Then
Return 0
Else
Return Value - 20
End If
End Function
SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%"
SliderBackgroundBlur.GetHintText = Function(v) v & " 像素"
End Sub
End Class
@@ -1,4 +1,6 @@
Public Class PageSpeedLeft
Imports System.Threading.Tasks
Public Class PageSpeedLeft
Private Const WatcherInterval As Integer = 300
'初始化
@@ -59,8 +61,8 @@
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
TaskRefresh(LoaderTaskbar(i))
For Each Loader In LoaderTaskbar.ToList
TaskRefresh(Loader)
Next
End SyncLock
Catch ex As Exception
@@ -110,7 +112,7 @@
#Region "进度不同,更新卡片"
Try
If Card.Children.Count < LoaderList.Count * 2 Then
Log("刷新下载管理卡片失败:卡片中仅有 " & Card.Children.Count & " 个子项", LogLevel.Debug)
Log($"[Watcher] 刷新下载管理卡片 {Loader.Name} 失败:卡片中仅有 {Card.Children.Count} 个子项,要求至少有 {LoaderList.Count * 2} 个子项", LogLevel.Debug)
Exit Try
End If
Dim Row As Integer = 0
@@ -137,7 +139,7 @@
Row += 1
Next
Catch ex As Exception
Log(ex, "刷新下载管理卡片失败", LogLevel.Feedback)
Log(ex, $"刷新下载管理卡片 {Loader.Name} 失败", LogLevel.Feedback)
End Try
#End Region
End Select
@@ -191,13 +193,18 @@
'添加取消按钮
Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top}
Card.Children.Add(Cancel)
AddHandler Cancel.Click, Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort())
End Sub
AddHandler Cancel.Click,
Sub(sender As MyIconButton, e As EventArgs)
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}")
RunInThread(Sub() Loader.Abort())
End Sub
'如果已经失败,再刷新一次,修改成失败的控件
If Loader.State = LoadState.Failed Then
Card.Tag = Nothing '避免重复导致刷新无效
@@ -607,8 +607,10 @@
If ModEntry.Comp IsNot Nothing Then
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge, If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))}})
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge,
If(PageVersionLeft.Version.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any)))}})
Else
'获取信息
Dim ContentLines As New List(Of String)
@@ -22,7 +22,7 @@
</Grid.ColumnDefinitions>
<TextBlock Grid.Row="0" Grid.ColumnSpan="4" Margin="0,0,0,9" HorizontalAlignment="Center" Text="该版本不可使用 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle Grid.Row="1" Grid.ColumnSpan="4" HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge 或 Fabric 等 Mod 加载器才能使用 Mod,请在下载页面重新安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本,并注意 Forge 在版本选择列表中的图标为铁砧,Fabric 的图标为丝绸。" TextWrapping="Wrap" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge、Fabric 等 Mod 加载器才能使用 Mod,请在下载页面安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本。" TextWrapping="Wrap" />
<local:MyButton Grid.Row="3" Grid.Column="1" Height="35" HorizontalAlignment="Center" x:Name="BtnDownload" MinWidth="140" Text="转到下载页面" Margin="10,10,10,0" Padding="13,0" ColorType="Highlight" />
<local:MyButton Grid.Row="3" Grid.Column="2" Height="35" HorizontalAlignment="Center" x:Name="BtnVersion" MinWidth="140" Text="版本选择" Margin="10,10,10,0" Padding="13,0" />
</Grid>
@@ -37,6 +37,7 @@
<local:MyComboBoxItem Content="红石灯(关)" Tag="pack://application:,,,/images/Blocks/RedstoneLampOff.png" />
<local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" />
<local:MyComboBoxItem Content="布料(Fabric)" Tag="pack://application:,,,/images/Blocks/Fabric.png" />
<local:MyComboBoxItem Content="狐狸(NeoForge)" Tag="pack://application:,,,/images/Blocks/NeoForge.png" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType">
@@ -127,6 +127,8 @@
'重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName)
'清理 ini 缓存
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
'遍历重命名所有文件与文件夹
For Each Entry As DirectoryInfo In New DirectoryInfo(NewPath).EnumerateDirectories
If Not Entry.Name.Contains(OldName) Then Continue For
@@ -292,16 +294,17 @@
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
Loader.OnStateChanged =
Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -312,8 +315,8 @@
End Sub
'删除版本
'修改此代码时,同时修改 PageSelectRight 中的代码
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
'修改此代码时,同时修改 PageSelectRight 中的代码
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
@@ -321,6 +324,7 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
@@ -77,6 +77,22 @@
<local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="VersionRamCustom" MaxValue="49" Value="13" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid>
<Grid Margin="0,5,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Margin="0,6,30,0" Text="启动游戏前进行内存优化" Grid.Row="1" Grid.Column="1" HorizontalAlignment="Left" />
<local:MyComboBox x:Name="ComboRamOptimize" Margin="10,0,0,0" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="2" Tag="VersionRamOptimize">
<local:MyComboBoxItem Content="使用全局设置" IsSelected="True" />
<local:MyComboBoxItem Content="开启" />
<local:MyComboBoxItem Content="关闭" />
</local:MyComboBox>
</Grid>
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
<Grid.ColumnDefinitions>
<ColumnDefinition x:Name="ColumnRamUsed" Width="4.7*"/>
@@ -51,6 +51,7 @@
'游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Version:=PageVersionLeft.Version)
'服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version)
@@ -95,6 +96,7 @@
Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamOptimize", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version)
@@ -130,7 +132,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change
@@ -163,10 +165,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49)
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If
'设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -351,15 +351,14 @@ 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 - 41) * 4 + 32
RamGive = (Value - 33) * 2 + 16
End If
End If
'若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(PageVersionLeft.Version)) Then RamGive = Math.Min(1, RamGive)
Return RamGive
'封顶 32G
Return Math.Min(32, RamGive)
End Function
#End Region
@@ -35,10 +35,10 @@
<PlatformTarget>AnyCPU</PlatformTarget>
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<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>
@@ -185,6 +185,9 @@
<Compile Include="Controls\MyIconTextButton.xaml.vb">
<DependentUpon>MyIconTextButton.xaml</DependentUpon>
</Compile>
<Compile Include="Modules\Minecraft\ModComp.vb" />
<Compile Include="Modules\Minecraft\ModJava.vb" />
<Compile Include="Modules\Minecraft\ModMod.vb" />
@@ -241,6 +244,9 @@
<Compile Include="Pages\PageDownload\PageDownloadCompDetail.xaml.vb">
<DependentUpon>PageDownloadCompDetail.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadNeoForge.xaml.vb">
<DependentUpon>PageDownloadNeoForge.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb">
<DependentUpon>PageDownloadPack.xaml</DependentUpon>
</Compile>
@@ -466,6 +472,7 @@
<DependentUpon>FormMain.xaml</DependentUpon>
<SubType>Code</SubType>
</Compile>
<Page Include="Modules\Minecraft\MyLocalModItem.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
@@ -490,6 +497,10 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageDownload\PageDownloadNeoForge.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageDownload\PageDownloadPack.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
@@ -916,5 +927,11 @@
<ItemGroup>
<Resource Include="Images\Heads\MCBBS.png" />
</ItemGroup>
<ItemGroup>
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Blocks\NeoForge.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
+20 -14
View File
@@ -79,7 +79,11 @@
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" />
<local:MyButton Margin="0,4,0,0" Width="250" Height="35"
Text="启动 1.12.2 并进入 Hypixel" EventType="启动游戏" EventData="1.12.2|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
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"
Text="在 EventData 中填写 \current,表示启动当前被选中的游戏版本,同样可以在后面填写服务器 IP。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动当前选中版本并进入 Hypixel" EventType="启动游戏" EventData="\current|mc.hypixel.net" ToolTip="启动当前版本" />
</StackPanel>
</local:MyCard>
@@ -144,7 +148,7 @@
<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" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</StackPanel>
<!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
@@ -180,28 +184,30 @@
<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/CommandBlock.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/Cobblestone.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/GoldBlock.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/Grass.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/GrassPath.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/Anvil.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/RedstoneBlock.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/RedstoneLampOn.png"/>
<!-- 红石灯(灭) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.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/Fabric.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>
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="使用时,将上方对应行的 Source 复制到 MyListItem 的 Logo 属性处即可。"/>
@@ -264,7 +270,7 @@
<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" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid>
</StackPanel>
</local:MyCard>
Binary file not shown.
-2
View File
@@ -12,8 +12,6 @@
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了……
你也可以丢 Pull Request,虽然这个源代码库并不能直接编译,但一些简单的修改应该还是没问题的……
<br/>
## 相关内容
Binary file not shown.