Compare commits

...
344 Commits
Author SHA1 Message Date
龙腾猫跃 62394e0052 2.8.4 2024-08-17 01:46:19 +08:00
龙腾猫跃 c62ab46b99 Merge pull request #4485 from allMagicNB/Fix-#4482
Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482
2024-08-14 05:29:20 +08:00
龙腾猫跃 bdb19e1ae4 Merge pull request #4491 from LxHTT/main
fix: 下载 NeoForge 时,从未使用镜像源
2024-08-13 22:55:21 +08:00
LxHTT b11c8c5d96 fix: 下载 NeoForge 时,从未使用镜像源 2024-08-13 21:30:47 +08:00
allMagicNB 348472b3ca Revert 2024-08-13 19:33:15 +08:00
allMagicNB 19fe4c03dc Fix #4482:+ "chcp 65001 > nul" & Encoding:=Encoding.UTF8 2024-08-13 14:00:26 +08:00
allMagicNB 06d92556b6 Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482 2024-08-13 11:57:46 +08:00
龙腾猫跃 4c1bfe9140 Merge pull request #4438 from 3gf8jv4dv/kitchen-sink
Revise the translation of Kitchen Sink
2024-08-13 03:46:08 +08:00
龙腾猫跃 a6d6c97fd7 Merge pull request #4415 from allMagicNB/Close-#4366
Close 添加对 MCC 15周年披风的翻译 #4366
2024-08-12 03:11:51 +08:00
龙腾猫跃 1c6af2caca Merge pull request #4291 from youzi-2333/feat-setup-modsrc
添加国内 Mod 镜像下载源
2024-08-12 03:08:47 +08:00
龙腾猫跃 12a3712524 Merge pull request #4449 from tangge233/VersionSortFix
fix: 检测愚人节版本所用时区不正确
2024-08-12 03:07:56 +08:00
龙腾猫跃 9d56a95dcb Merge pull request #4441 from 3gf8jv4dv/mod_modpack-download-filter-gameversion-1.21.1
Add 1.21.1 to Mod and Modpack downloadpage version filter
2024-08-12 03:02:35 +08:00
tangge233 e5a0eddcea fix: 检测愚人节版本所用时区不正确 2024-08-09 14:05:29 +08:00
3gf8jv4dv f7d2cd1cb6 Add 1.21.1 to Mod and Modpack downloadpage version filter 2024-08-08 08:27:58 +08:00
3gf8jv4dv ec3ebe3215 Update 2024-08-07 23:51:17 +08:00
3gf8jv4dv 084fb1248e Revise the translation of Kitchen Sink 2024-08-07 22:41:03 +08:00
allMagicNB f639435813 + "MCC 15th Year" Cape 2024-08-06 06:36:56 +08:00
龙腾猫跃 8f49799c6d Merge pull request #3945 from Silverteal/patch-1
所有4月1日发布的版本自动视为愚人节版
2024-07-29 05:45:40 +08:00
youzi-2333 6c8a7a33b7 👌 💥 更新 LTCatt 的审核 2024-07-28 22:30:59 +08:00
龙腾猫跃 020ce330b5 https://github.com/Hex-Dragon/PCL2/discussions/4361#discussioncomment-10169901 2024-07-28 16:13:06 +08:00
龙腾猫跃 c8c981fd8c 放宽分发限制 2024-07-28 04:28:58 +08:00
youzi-2333 89f537a00e 👌 更新一部分 LTCatt 的审核 2024-07-26 22:52:28 +08:00
龙腾猫跃 9c0ae93d7d Create FUNDING.yml 2024-07-26 17:02:43 +08:00
龙腾猫跃 016ff2c912 Merge pull request #4349 from Forks-Space/main
Readme 徽标更改爱发电 net->com
2024-07-26 16:35:09 +08:00
Ad_closeNN a4982c5ca7 进一步更改徽标 2024-07-26 16:22:23 +08:00
Ad_closeNN 6208a21b85 徽标更改爱发电 net->com 2024-07-26 16:21:32 +08:00
youzi-2333 e69b189c8b ✏️ MCLM -> MCIM
我是【该词语违禁】
2024-07-18 14:40:01 +08:00
youzi-2333 8ed02fe4d9 ✨ 为 Mod 列表、下载添加 MCLM 下载源 2024-07-18 12:38:45 +08:00
龙腾猫跃 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
Silverteal a465807d0c Merge pull request #11 from PCL-Community/patch-1
Fix Bugs
2024-07-11 16:01:31 +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
无聊的小洛 10e17d48c5 致命错误
败笔也
2024-07-04 11:37:12 +08:00
无聊的小洛 fa7deb7500 修正错误
为什么要大写啊
2024-07-04 11:36:00 +08:00
无聊的小洛 2f39c57e58 Update FormMain.xaml.vb
之前改的没改回来
2024-07-04 11:35:11 +08:00
wuliaodexiaoluo aa576e669d Fix Bugs 2024-07-04 11:23:15 +08:00
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 73f8bdf4e1 Delete .github/workflows/build-pr.yml 2024-06-01 06:53:20 +08:00
Silverteal a95e8e8bf7 Create build-pr.yml 2024-06-01 06:52:08 +08:00
Silverteal 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
Silverteal a4d2e21e1f Merge pull request #1 from Hex-Dragon/main
merge upstream
2024-05-31 18:21:05 +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
Silverteal 9402523e01 Merge branch 'Hex-Dragon:main' into main 2024-05-31 14:40:01 +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
龙腾猫跃 67d830ea29 2.7.3 2024-05-16 21:06:03 +08:00
龙腾猫跃 a84601d99c 2.7.2 2024-05-13 18:09:30 +08:00
allMagic 7f37c83f52 fix #3702 2024-05-06 18:54:45 +08:00
龙腾猫跃 a5a3800957 Merge pull request #3781 from Chiloven945/main
修改模组及整合包版本筛选列表冗余
2024-05-06 17:14:35 +08:00
龙腾猫跃 baba653a67 Update README.md 2024-05-06 17:10:37 +08:00
龙腾猫跃 5733cbdb0e Merge pull request #3768 from allMagicNB/Revive-#85-#91-#192
Revive #85 #91 #192
2024-05-06 16:09:33 +08:00
ClovenBugle 6e1072d042 修改整合包版本筛选列表冗余
删去1.20、1.20.3、1.20.5因均有被继后版本修复的bug
添加1.19.2因其为1.19最常用的模组版本
2024-05-04 11:40:42 +08:00
ClovenBugle efe58c9748 修改模组版本筛选列表冗余
删去1.20、1.20.3、1.20.5因均有被继后版本修复的bug
添加1.19.2因其为1.19最常用的模组版本
2024-05-04 11:37:50 +08:00
Silverteal c99575c3f1 修改PageDownloadClient.xaml.vb和PageDownloadInstall.xaml.vb
对4月1日版本直接判定为愚人节版
2024-05-04 09:22:24 +08:00
allMagicNB 1158ff9e78 fix #3702 2024-05-02 21:21:43 +08:00
allMagicNB 5b58e3868d 更换爱发电主页链接 2024-05-01 16:28:24 +08:00
allMagicNB 0a48feba18 不加了不加了……都预览不了 2024-05-01 14:58:46 +08:00
allMagicNB 7d89b90ae1 换 SVG…… 2024-05-01 14:31:02 +08:00
allMagicNB f6cae4ea23 添加 “赞助-爱发电” Badge 2024-05-01 14:14:29 +08:00
allMagicNB a09baee5f8 添加 “赞助-爱发电” Badge 2024-05-01 14:13:20 +08:00
allMagicNB fa3d5bc09b 增加 “Issues” Badge 2024-05-01 13:33:39 +08:00
allMagicNB c169532794 为 Bagde 添加链接和说明 2024-05-01 10:48:38 +08:00
allMagic 37313e4d6e Update README.md
再改下
2024-05-01 10:18:04 +08:00
allMagic dd9cdaf15f Update README.md
换了下 Star 的 Logo
2024-05-01 10:17:32 +08:00
allMagic 6a2f95e96f Update README.md
Revive #85 #91 #192
2024-04-30 23:00:24 +08:00
龙腾猫跃 d682b59803 Merge pull request #3732 from allMagicNB/main
增加资源下载界面的 1.20.5(#3731)
2024-04-25 04:14:52 +08:00
allMagic 02347239b4 Add 1.20.5 2024-04-25 02:12:48 +08:00
allMagic dc4eda533c Add 1.20.5 2024-04-25 02:10:28 +08:00
龙腾猫跃 d86ad945a6 Merge pull request #3699 from zkitefly/crash
updata CrashReason.Fabric报错并给出解决方案
2024-04-19 22:04:02 +08:00
zkitefly 12be800391 updata CrashReason.Fabric报错并给出解决方案 2024-04-19 13:52:59 +00:00
龙腾猫跃 c47b80df36 2.7.1 正式版 2024-04-08 17:15:20 +08:00
龙腾猫跃 43b0acba08 2.7.1 2024-04-08 01:54:35 +08:00
龙腾猫跃 c1cad542c2 Merge pull request #3530 from wuliaodexiaoluo/main
添加 JVM 参数
2024-04-05 22:14:26 +08:00
龙腾猫跃 09f9b8f1e5 Merge branch 'main' into main 2024-04-05 22:14:18 +08:00
龙腾猫跃 4241060010 2.7.0 正式版 2024-04-05 17:36:13 +08:00
龙腾猫跃 0dab617b64 2.7.0 2024-04-04 03:26:43 +08:00
龙腾猫跃 515b7e89c5 Merge pull request #3593 from allMagicNB/main
fix #3591
2024-04-04 01:26:23 +08:00
allMagic d83f98b34a fix #3591 2024-04-02 13:32:14 +08:00
allMagic e2030970a3 fix #3591 2024-04-02 06:23:00 +08:00
allMagic e623d3464a fix #3591 2024-04-01 22:55:39 +08:00
allMagic 81346f0821 fix #3591 2024-04-01 22:37:05 +08:00
allMagic 810c6e8618 fix #3591 2024-04-01 22:17:49 +08:00
wuliaodexiaoluo a5199d32ed Update FormMain.xaml.vb 2024-03-20 08:42:54 +08:00
wuliaodexiaoluo b058e7722d Update FormMain.xaml.vb 2024-03-19 14:52:56 +08:00
wuliaodexiaoluo 4beef0fb5d Merge pull request #4 from wuliaodexiaoluo/wuliaodexiaoluo-patch-2
Update FormMain.xaml.vb
2024-03-19 13:56:29 +08:00
wuliaodexiaoluo eb195373ea Update FormMain.xaml.vb
修复 UAC 阻止文件拖拽
2024-03-19 13:56:11 +08:00
wuliaodexiaoluo 65ca2e0cf4 Update PageSetupLaunch.xaml 2024-03-16 13:10:15 +08:00
wuliaodexiaoluo 09e420ad6b Merge pull request #3 from wuliaodexiaoluo/wuliaodexiaoluo-patch-2
Update PageSetupLaunch.xaml
2024-03-16 13:01:45 +08:00
wuliaodexiaoluo 95429cc9cc Merge branch 'main' into wuliaodexiaoluo-patch-2 2024-03-16 13:01:37 +08:00
wuliaodexiaoluo 5a78a46b28 Update PageSetupLaunch.xaml
解决描述错误
2024-03-16 12:53:00 +08:00
wuliaodexiaoluo 3ae624d4fb Update PageSetupLaunch.xaml
手滑了抱歉。。。
2024-03-16 12:51:14 +08:00
wuliaodexiaoluo 91f39f2afd Merge pull request #2 from wuliaodexiaoluo/wuliaodexiaoluo-patch-1
Fix # 3511
2024-03-16 12:31:42 +08:00
wuliaodexiaoluo 65da5b67f7 Update PageSetupLaunch.xaml 2024-03-16 12:30:46 +08:00
wuliaodexiaoluo 268cb092dd Update PageSetupLaunch.xaml 2024-03-16 12:27:47 +08:00
wuliaodexiaoluo 9728af60d0 Update PageSetupLaunch.xaml 2024-03-16 12:24:48 +08:00
wuliaodexiaoluo 7affc1e24f Merge pull request #1 from Hex-Dragon/main
Update
2024-03-16 12:23:26 +08:00
龙腾猫跃 3076f3a6b7 Merge pull request #3475 from WorldHim/patch-1
修复 #3461 换行缺失
2024-03-03 04:42:17 +08:00
WorldHim 02c8b7211b fix: #3461 2024-03-02 20:30:02 +08:00
龙腾猫跃 5843649cfa 2.6.15 正式版 2024-03-02 18:04:12 +08:00
龙腾猫跃 f78250020e 2.6.15 2024-03-02 17:53:55 +08:00
龙腾猫跃 031cd898f6 Merge pull request #3427 from zkitefly/patch-4
Update bug2.yml
2024-02-26 06:14:19 +08:00
zkitefly 1b272a6f06 更新 bug2.yml 2024-02-25 17:23:50 +08:00
zkiteflyand柚子柚子 f2e9be66c1 Update .github/ISSUE_TEMPLATE/bug2.yml
Co-authored-by: 柚子柚子 <[email protected]>
2024-02-25 15:28:04 +08:00
zkitefly c719803849 Update bug2.yml
?
2024-02-25 15:15:13 +08:00
zkiteflyand何杰豪 2b485233cb Update .github/ISSUE_TEMPLATE/bug2.yml
Co-authored-by: 何杰豪 <[email protected]>
2024-02-25 15:10:49 +08:00
zkitefly 5198298336 Update bug2.yml 2024-02-25 15:07:14 +08:00
zkitefly a1a2d53d31 Update bug2.yml 2024-02-25 11:37:16 +08:00
龙腾猫跃 ec6784d57d 2.6.14 正式版 2024-02-23 17:59:24 +08:00
龙腾猫跃 83ebc61d8a 2.6.14 2024-02-22 00:04:00 +08:00
龙腾猫跃 63d48b09e3 Merge pull request #3231 from zkitefly/fabric_error-chinese
添加"Fabric报错并给出解决方案"中文检查支持
2024-02-20 04:27:32 +08:00
zkitefly 4a25b066d2 Fix https://github.com/Hex-Dragon/PCL2/issues/3228 . 添加"Fabric报错并给出解决方案"中文检查支持 2024-01-31 11:39:32 +00:00
龙腾猫跃 8c8b1066bf 2.6.13 正式版 2024-01-06 22:46:38 +08:00
龙腾猫跃 fb4386952d 2.6.13 2024-01-06 22:35:35 +08:00
龙腾猫跃 fa054d9a9e 2.6.12 正式版 2023-12-26 16:52:03 +08:00
龙腾猫跃 6705444fb4 2.6.12 2023-12-18 04:56:23 +08:00
龙腾猫跃 c98e0367d0 2.6.10 正式版重新签名 2023-11-28 18:01:30 +08:00
龙腾猫跃 2c7b532188 2.6.11 2023-11-27 00:49:59 +08:00
龙腾猫跃 e2a3dd3281 Merge pull request #2864 from zkitefly/minecraft.wiki
`https://minecraft.fandom.com/zh/wiki/` -> `https://zh.minecraft.wiki/w/`
2023-11-21 18:14:34 +08:00
zkitefly e712280c7b Update ModDownloadLib.vb 2023-11-11 11:26:52 +08:00
龙腾猫跃 8308577549 2.6.10 正式版 2023-10-25 16:36:22 +08:00
龙腾猫跃 f0c634db78 2.6.10 修正 2023-10-23 23:37:34 +08:00
龙腾猫跃 7b623dbc2d 2.6.10 2023-10-23 23:34:18 +08:00
龙腾猫跃 037e6b19b4 2.6.9 2023-10-07 05:29:24 +08:00
龙腾猫跃 5ff7aed46e Merge pull request #2724 from JingHai-Lingyun/main
Update PageLoginMs.xaml.vb
2023-09-30 04:08:43 +08:00
凌云 3779d74e93 Update PageLoginMs.xaml.vb 2023-09-29 10:16:25 +08:00
龙腾猫跃 3b8de89309 2.6.8 2023-09-12 00:55:44 +08:00
龙腾猫跃 f18ede2c7a Merge pull request #2649 from zkitefly/patch-4
Update ModCrash.vb
2023-09-07 16:58:36 +08:00
龙腾猫跃 4158e95f87 * 2023-09-06 17:36:44 +08:00
龙腾猫跃 a77c2385cd * 2023-09-06 17:32:16 +08:00
龙腾猫跃 fe5dc2d07f 修改 issue 模板 2023-09-06 17:28:27 +08:00
zkitefly 17c2049d2c Update ModCrash.vb 2023-08-31 21:33:05 +08:00
zkitefly 0eebb8ec78 Update ModCrash.vb 2023-08-31 10:15:50 +08:00
zkitefly 58d40976a7 Update ModCrash.vb 2023-08-31 10:07:12 +08:00
龙腾猫跃 b2f2bcf4b6 Merge pull request #2617 from so1ve/main-1
在issue template中添加讨论链接
2023-08-26 00:28:12 +08:00
Ray 2a6708cc08 Update config.yml 2023-08-26 00:14:35 +08:00
Ray c9c00bc23f Update config.yml 2023-08-26 00:12:42 +08:00
Ray 7fa092eb25 Update config.yml 2023-08-26 00:12:05 +08:00
Ray d4e692b69f Update config.yml 2023-08-26 00:10:15 +08:00
龙腾猫跃 8479c47da0 Merge pull request #2574 from zkitefly/issue
https://github.com/Hex-Dragon/PCL2/discussions/2572
2023-08-23 02:40:57 +08:00
zkitefly 971aa0034d 还是换回去吧( 2023-08-22 23:11:08 +08:00
龙腾猫跃 b717bb31c8 2.6.7 正式版 2023-08-22 22:47:42 +08:00
zkitefly 3037a9e384 改一下 2023-08-22 22:41:40 +08:00
zkitefly 6794b24292 https://github.com/Hex-Dragon/PCL2/discussions/2572 2023-08-22 22:39:33 +08:00
龙腾猫跃 d774de5436 2.6.7 2023-08-22 16:19:12 +08:00
龙腾猫跃 e4ae1a057a 2.6.6 正式版 2023-08-21 14:22:57 +08:00
龙腾猫跃 41250d8387 2.6.6 2023-08-21 04:02:19 +08:00
龙腾猫跃 79778490d5 2.6.5 2023-08-15 16:38:52 +08:00
龙腾猫跃 e1e084aea3 Merge pull request #2487 from SALTWOOD/main
Fix #2486
2023-08-13 19:22:36 +08:00
SALTWOOD 836d55e445 Fix #2486 2023-08-13 17:26:35 +08:00
龙腾猫跃 3574931bfb Merge pull request #2301 from zkitefly/patch-2
Update ModCrash.vb
2023-08-06 11:25:17 +08:00
zkitefly c9aabd6a55 Update ModCrash.vb 2023-07-21 09:30:39 +08:00
龙腾猫跃 e6c6975047 2.6.4 2023-07-18 04:45:38 +08:00
龙腾猫跃 9c41a807c3 Merge pull request #2271 from zkitefly/patch-2
Update ModCrash.vb
2023-07-17 18:17:15 +08:00
zkitefly a0fe5903f0 Update ModCrash.vb 2023-07-17 16:43:44 +08:00
zkitefly 06be5b5b17 Update ModCrash.vb
https://github.com/Hex-Dragon/PCL2/discussions/2270
2023-07-17 16:08:38 +08:00
龙腾猫跃 73d43310c9 Merge pull request #2173 from zkitefly/patch-2
Update PageVersionSetup.xaml
2023-07-16 00:55:53 +08:00
龙腾猫跃 9b54ea3dee Merge pull request #2148 from zkitefly/log
添加检查:Mod依赖项未完善
2023-07-16 00:53:21 +08:00
zkitefly fa5026ccd7 Update PageVersionSetup.xaml 2023-07-04 17:48:05 +08:00
zkitefly ca3e7f40e1 Update PageVersionSetup.xaml 2023-07-04 17:47:15 +08:00
zkitefly 8004385d6f Update PageVersionSetup.xaml 2023-07-04 17:46:50 +08:00
龙腾猫跃 2c2bd2d489 2.6.3 正式版 2023-07-02 22:04:24 +08:00
[email protected] 80cf5957f2 更新 ModCrash.vb 2023-06-30 11:57:25 +08:00
[email protected] 7d139cbd73 添加检查:Mod依赖项未完善
https://mclo.gs/p25LjXV
2023-06-30 11:17:10 +08:00
龙腾猫跃 8a770f63cf 2.6.3 重新上传 2023-06-24 17:32:40 +08:00
153 changed files with 21821 additions and 11129 deletions

No files matched your search

+3
View File
@@ -0,0 +1,3 @@
# These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat']
+16 -10
View File
@@ -1,5 +1,5 @@
name: "Minecraft 崩溃"
description: "PCL2 提示 “Minecraft 出现错误”,或游戏崩溃"
description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃"
labels: [· Bug, 新反馈]
body:
- type: checkboxes
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃不是 PCL2 的原因,请 **不要** 提交反馈。你可以在 QQ 群里或者论坛找人求助,但这里并不是你求助的地方。"
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃基本不是 PCL 的原因,请 **不要** 提交反馈。你可以在论坛或社区找人求助,但这里并不是你求助的地方。"
required: false
- label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: true
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是游戏本身的问题,并非 PCL2 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
required: true
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
@@ -26,8 +24,16 @@ body:
- type: textarea
id: "yml-3"
attributes:
label: 错误报告、日志与附件
description: "上传 PCL2 提供的错误报告(在崩溃时选择导出错误报告)。如果没有,也可以上传 PCL 文件夹中的 Log1~5.txt。"
label: PCL 错误报告、日志与附件
description: "上传 PCL 提供的错误报告(在崩溃时选择导出错误报告)。如果没有,也可以上传 PCL 文件夹中的 Log1~5.txt。"
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
validations:
required: true
required: true
- type: textarea
id: "yml-4"
attributes:
label: HMCL 启动脚本
description: "在 HMCL 中进入版本列表,点击版本右侧的三个点,选择 生成启动脚本。"
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
validations:
required: false
+6 -8
View File
@@ -1,5 +1,5 @@
name: "下载或登录时卡住或失败"
description: "下载游戏、Mod 或整合包,登录正版账号时出现问题"
description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题"
labels: [· Bug, 新反馈]
body:
- type: checkboxes
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL2 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL 的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
required: true
- label: "我已知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题是 PCL2 导致的,和我的网络环境无关。"
required: true
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
@@ -40,4 +38,4 @@ body:
description: "上传 PCL 文件夹中的 Log1~5.txt。[日志在哪?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-fvZW)"
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
validations:
required: true
required: true
+1 -3
View File
@@ -8,9 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未修复这个 Bug。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: false
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+1 -3
View File
@@ -8,9 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未实现这项建议。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一建议未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一建议未被提交过。"
required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
required: true
+5 -2
View File
@@ -2,7 +2,10 @@ blank_issues_enabled: false
contact_links:
- name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues
about: 提交 PCL2 帮助系统(更多 → 帮助)相关的反馈
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
- name: 提问
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE
about: 我不想提交反馈,只是想问一些问题
about: 我想问一些 PCL 相关的问题……
- name: 讨论
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E8%AE%A8%E8%AE%BA
about: 我想讨论一些 PCL 相关的事情……
+2 -4
View File
@@ -8,13 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已点击 `设置 → 启动器 → 检查更新` 确认了启动器已为最新版,且最新版未实现这一功能。[怎样更新?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-oTgb)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 中搜索,确认了这一提案未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一提案未被提交过。"
required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
required: true
- label: "我已知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
- label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
required: true
- type: textarea
id: "yml-2"
+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),且可能随时修改本指南,本指南并不是永久性保证。
说人话就是,随便你参考这堆代码的思路,乃至复制一两个函数什么的也可以,别太过火就行,顺便记得声明一下这段是从这里来的。
不过,你不能把它们直接复制下来然后再小修小补,就说这是你自己的东西。也不能把其中一小部分单独抠出来说是你自己的东西。
没有法律顾问,所以这只是明确说明一下,你可以借鉴其中的小部分内容,我也不会且懒得因此找你麻烦。
如果有专业人士愿意帮帮忙把这堆东西写得专业一点我也很乐意……
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。
  如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。
  3、使用本指南文件作为协议,不得附加额外条款。
  4、该衍生作品不能被允许用于再次分发,这包括制作整合包。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
————————————
说人话的备注:
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。
如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。
+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
+5 -5
View File
@@ -133,7 +133,7 @@
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="4" MaxWidth="500" Background="#E5FFFFFF" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="4" MaxWidth="500" Background="#E5FFFFFF" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.3" BlurRadius="4" ShadowDepth="2" Color="{DynamicResource ColorObject1}" />
</Border.Effect>
@@ -147,7 +147,7 @@
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
@@ -277,7 +277,7 @@
<Setter Property="ScrollViewer.PanningMode" Value="VerticalFirst"/>
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="UndoLimit" Value="15" />
<Setter Property="MaxLength" Value="10000" />
<Setter Property="MaxLength" Value="1000" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Template">
<Setter.Value>
@@ -293,7 +293,7 @@
<!-- 由于未知原因,TextView 会有 2,0 的 Margin -->
</Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.3" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.25" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid>
@@ -345,7 +345,7 @@
<!-- ComboBox -->
<DataTemplate x:Key="ComboBoxItemTemplateWithDelete">
<local:MyListItem Title="{Binding}" FontSize="13" PaddingRight="40" MaxHeight="26" IsScaleAnimationEnabled="False" Margin="-3,0,0,0">
<local:MyListItem Title="{Binding}" FontSize="13" MaxHeight="26" IsScaleAnimationEnabled="False" Margin="-3,0,0,0">
<local:MyListItem.Buttons>
<x:Array Type="local:MyIconButton">
<local:MyIconButton Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Tag="{Binding}" Click="MyIconButton_Click" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z" />
+45 -29
View File
@@ -12,27 +12,22 @@ Public Class Application
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", LogLevel.Feedback)
Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
End Try
End Sub
#End If
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
ApplicationStartTick = GetTimeTick()
SecretOnApplicationStart()
Try
SecretOnApplicationStart()
'检查参数调用
If e.Args.Length > 0 Then
If e.Args(0) = "--update" Then
'自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel)
'ElseIf e.Args(0).StartsWith("--link") Then
' '稍作等待后切换到联机页面
' Thread.Sleep(1000)
' FormMain.IsLinkRestart = True
ElseIf e.Args(0).StartsWith("--memory") Then
ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try
@@ -41,12 +36,18 @@ Public Class Application
MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败")
Environment.Exit(-1)
End Try
Ram = My.Computer.Info.AvailablePhysicalMemory - Ram
Environment.Exit(Math.Max(0, Ram / 1024)) '返回清理的内存量(K)
If My.Computer.Info.AvailablePhysicalMemory < Ram Then '避免 ULong 相减出现负数
Environment.Exit(0)
Else
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
End If
#If DEBUG Then
ElseIf e.Args(0) = "--make" Then
'制作更新包
UpdateMake(e.Args(1))
ElseIf e.Args(0) = "--edit1" Then
ExeEdit(e.Args(1), True)
Environment.Exit(Result.Cancel)
ElseIf e.Args(0) = "--edit2" Then
ExeEdit(e.Args(1), False)
Environment.Exit(Result.Cancel)
#End If
End If
@@ -71,7 +72,8 @@ Public Class Application
Directory.CreateDirectory(PathAppdata)
'检测单例
#If Not DEBUG Then
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2 ")
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
@@ -88,7 +90,7 @@ Public Class Application
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
@@ -97,9 +99,11 @@ Public Class Application
'日志初始化
LogStart()
'添加日志
Log("[Start] 程序版本:" & VersionDisplayName & "(" & VersionCode & ")")
Log("[Start] 识别码:" & UniqueAddress & If(ThemeCheckOne(9), ",已解锁反馈主题", ""))
Log("[Start] 程序路径:" & PathWithName)
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})")
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)
@@ -108,13 +112,11 @@ Public Class Application
Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert")
'网络配置初始化
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 1024
ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean
Return True
End Function)
'计时
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick()
@@ -124,7 +126,12 @@ Public Class Application
#End If
AniControlEnabled += 1
Catch ex As Exception
MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL 初始化错误")
Dim FilePath As String = Nothing
Try
FilePath = PathWithName
Catch
End Try
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(Result.Exception)
End Try
End Sub
@@ -168,7 +175,7 @@ Public Class Application
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWith("NAudio") Then
If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL:NAudio")
@@ -176,7 +183,7 @@ Public Class Application
End If
Return AssemblyNAudio
End SyncLock
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
SyncLock AssemblyJsonLock
If AssemblyJson Is Nothing Then
Log("[Start] 加载 DLL:Json")
@@ -184,7 +191,7 @@ Public Class Application
End If
Return AssemblyJson
End SyncLock
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL:Dialogs")
@@ -207,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
'离线
@@ -215,7 +223,7 @@ Public Class Application
Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨"))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else
'第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
@@ -233,14 +241,22 @@ Public Class Application
Select Case Token
Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
Case "Auth"
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
End Select
End Select
End Sub
Public Shared ShowingTooltips As New List(Of Border)
Private Sub TooltipLoaded(sender As Border, e As EventArgs)
ShowingTooltips.Add(sender)
End Sub
Private Sub TooltipUnloaded(sender As Border, e As RoutedEventArgs)
ShowingTooltips.Remove(sender)
End Sub
End Class
@@ -134,23 +134,21 @@
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
If Not IsMouseDown Then Exit Sub
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
ModEvent.TryStartEvent(EventType, EventData)
End If
ModEvent.TryStartEvent(EventType, EventData)
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
@@ -159,8 +157,7 @@
Get
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
+40 -30
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,14 +58,11 @@
Children.Add(MainGrid)
End Sub
Private IsLoad As Boolean = False
Private Sub MyCard_Loaded() Handles Me.Loaded
'卡片的进入时动画已被页面通用切换动画替代
'If LoadAnimation AndAlso IsLoad Then
' StartHeightAnimation(Math.Min(50, ActualHeight), ActualHeight - Math.Min(50, ActualHeight), True)
'End If
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})
@@ -59,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))
@@ -84,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
@@ -113,7 +119,7 @@
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
CompFilesCardPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick)
CompFilesCardPreload(Stack, Stack.Tag)
End Select
'实现控件虚拟化
For Each Data As Object In Stack.Tag
@@ -130,11 +136,10 @@
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 Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
@@ -143,7 +148,7 @@
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 9
If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
@@ -157,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
@@ -166,7 +173,9 @@
End Sub
'事件
Public Property HasMouseAnimation As Boolean = True
Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
If Not HasMouseAnimation Then Exit Sub
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
@@ -178,6 +187,7 @@
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
If Not HasMouseAnimation Then Exit Sub
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
@@ -210,7 +220,7 @@
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
'高度增加较大,使用弹起动画
Dim Delta As Double = MathRange(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
AnimList.AddRange({
AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
@@ -218,7 +228,7 @@
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathRange(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
End If
AnimList.Add(AaCode(Sub()
@@ -16,9 +16,9 @@
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<Border x:Name="PanProgress" CornerRadius="1000" BorderThickness="0.001" Background="#2AFFFFFF" ClipToBounds="True" Visibility="Collapsed">
<Border x:Name="PanProgress" CornerRadius="1000" BorderThickness="0.001" Background="#2FFFFFFF" ClipToBounds="True" Visibility="Collapsed">
<Border.Clip>
<RectangleGeometry x:Name="RectProgress" Rect="0,0,40,25" />
<RectangleGeometry x:Name="RectProgress" Rect="0,5,40,35" />
</Border.Clip>
</Border>
<Path x:Name="Path" Stretch="Uniform" Margin="12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
@@ -17,7 +17,7 @@
PanProgress.Visibility = Visibility.Collapsed
Else
PanProgress.Visibility = Visibility.Visible
RectProgress.Rect = New Rect(0, 0, 40, 40 * (1 - value))
RectProgress.Rect = New Rect(0, 40 * (1 - value), 40, 40 * value)
End If
End Set
End Property
@@ -102,7 +102,7 @@
Get
Return _CanRightClick
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
_CanRightClick = value
End Set
End Property
@@ -179,7 +179,7 @@
AniStop("MyExtraButton Color " & Uuid)
If IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush2")
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
+42 -9
View File
@@ -11,17 +11,17 @@
If _IsWarn = value Then Exit Property
_IsWarn = value
If _IsWarn Then
BorderBrush = New MyColor("#99FF4444")
Gradient1.Color = New MyColor("#88FFBBBB")
Gradient2.Color = New MyColor("#88FF8888")
BorderBrush = New MyColor("#CCFF4444")
Gradient1.Color = New MyColor("#BBFFBBBB")
Gradient2.Color = New MyColor("#BBFF8888")
Path.Fill = New MyColor("#BF0000")
LabText.Foreground = New MyColor("#BF0000")
BtnClose.Foreground = New MyColor("#BF0000")
Path.Data = (New GeometryConverter).ConvertFromString("F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z ")
Else
BorderBrush = New MyColor("#994D76FF")
Gradient1.Color = New MyColor("#88B0D0FF")
Gradient2.Color = New MyColor("#889EBAFF")
BorderBrush = New MyColor("#CC4D76FF")
Gradient1.Color = New MyColor("#BBB0D0FF")
Gradient2.Color = New MyColor("#BB9EBAFF")
Path.Fill = New MyColor("#0062BF")
LabText.Foreground = New MyColor("#0062BF")
BtnClose.Foreground = New MyColor("#0062BF")
@@ -34,7 +34,7 @@
Get
Return LabText.Text
End Get
Set(ByVal value As String)
Set(value As String)
LabText.Text = value
End Set
End Property
@@ -43,13 +43,12 @@
Get
Return BtnClose.Visibility = Visibility.Visible
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then
Visibility = Visibility.Collapsed
@@ -60,6 +59,40 @@
AniDispose(Me, False)
End Sub
'触发点击事件
Private IsMouseDown As Boolean = False
Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
IsMouseDown = False
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
e.Handled = True
ModEvent.TryStartEvent(EventType, EventData)
End Sub
Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
End Sub
Private Sub MyHint_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyHint), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyHint), New PropertyMetadata(Nothing))
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
@@ -1,7 +1,7 @@
Public Class MyIconButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
'自定义事件
Public Event Click(sender As Object, e As EventArgs)
'自定义属性
@@ -50,13 +50,31 @@
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
End If
If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
ModEvent.TryStartEvent(EventType, EventData)
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyIconButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconButton), New PropertyMetadata(Nothing))
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
@@ -93,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
@@ -115,7 +142,7 @@
Dim AnimList As New List(Of AniData)
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush5", AnimationColorOut))
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
Case Themes.White
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush8", AnimationColorOut))
@@ -0,0 +1,9 @@
<Border x:Name="PanBack" x:Class="MyIconTextButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="7,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -0,0 +1,186 @@
Public Class MyIconTextButton
'基础
Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性
Public Property Logo As String
Get
Return ShapeLogo.Data.ToString
End Get
Set(value As String)
ShapeLogo.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(ShapeLogo) Then ShapeLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue
End Sub)))
Public Enum ColorState
Black
Highlight
End Enum
Private _ColorType As ColorState = ColorState.Black
Public Property ColorType As ColorState
Get
Return _ColorType
End Get
Set(value As ColorState)
_ColorType = value
RefreshColor()
End Set
End Property '颜色类别
Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata())
'点击事件
Public Event Click(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
ModEvent.TryStartEvent(EventType, EventData)
RefreshColor()
End Sub
Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
IsMouseDown = True
RefreshColor()
End Sub
Private Sub MyIconTextButton_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
RefreshColor()
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(Nothing))
'动画
Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度
Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画,若强制不执行动画,则 e 为 False
Select Case ColorType
Case ColorState.Black
If IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", 70), "MyIconTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrushBg1", AnimationTimeOfMouseIn), "MyIconTextButton Color " & Uuid)
ElseIf IsEnabled Then
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush1", AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush1", AnimationTimeOfMouseOut)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
Else
'禁用
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrushGray5", 100),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrushGray5", 100)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
End If
Case ColorState.Highlight
If IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", 70), "MyIconTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrushBg1", AnimationTimeOfMouseIn), "MyIconTextButton Color " & Uuid)
ElseIf IsEnabled Then
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseOut)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
Else
'禁用
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrushGray5", 100),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrushGray5", 100)
}, "MyIconTextButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyIconTextButton Color " & Uuid)
End If
End Select
Else
'不使用动画
AniStop("MyIconTextButton Checked " & Uuid)
AniStop("MyIconTextButton Color " & Uuid)
Select Case ColorType
Case ColorState.Black
Background = ColorSemiTransparent
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
Case ColorState.Highlight
Background = ColorSemiTransparent
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, If(IsEnabled, "ColorBrush3", "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush3", "ColorBrushGray5"))
End Select
End If
Catch ex As Exception
Log(ex, "刷新带图标按钮颜色出错")
End Try
End Sub
End Class
@@ -11,7 +11,7 @@
<ColumnDefinition x:Name="ColumnPaddingLeft" Width="0" />
<ColumnDefinition x:Name="ColumnLogo" Width="4" />
<ColumnDefinition Width="1*"/>
<ColumnDefinition x:Name="ColumnPaddingRight" Width="0" />
<ColumnDefinition x:Name="ColumnPaddingRight" Width="4" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
@@ -15,7 +15,7 @@
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled, 6, 0)),
.CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled OrElse Height > 40, 6, 0)),
.RenderTransform = If(IsScaleAnimationEnabled, New ScaleTransform(0.8, 0.8), Nothing),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
@@ -104,42 +104,34 @@
ColumnPaddingLeft.Width = New GridLength(value)
End Set
End Property
Public Property PaddingRight As Integer
Get
Return ColumnPaddingRight.Width.Value
End Get
Set(value As Integer)
ColumnPaddingRight.Width = New GridLength(value)
End Set
End Property
''' <summary>
''' 右边距的最小值。
''' 在存在右侧按钮时,右边距会被自动设置为 5 + 按钮数 * 25。
''' </summary>
Public Property MinPaddingRight As Integer = 4
'按钮
Private _Buttons As IEnumerable
Public Property Buttons As IEnumerable
Private _Buttons As IEnumerable(Of MyIconButton)
Public Property Buttons As IEnumerable(Of MyIconButton)
Get
Return _Buttons
End Get
Set(value As IEnumerable)
Set(value As IEnumerable(Of MyIconButton))
_Buttons = value
'没有特殊按钮,移除原 Stack
If Not IsNothing(ButtonStack) Then
If ButtonStack IsNot Nothing Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
'获取按钮数量
Dim Count As Integer = 0
For Each Counter In value
Count += 1
Next
'添加新 Stack
Select Case Count
Select Case value.Count
Case 0
'没有按钮,不添加新的
Case 1
'只有一个按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
With Btn
.Opacity = 0
.Margin = New Thickness(0, 0, 5, 0)
@@ -149,22 +141,18 @@
.SnapsToDevicePixels = False
.UseLayoutRounding = False
End With
SetColumn(Btn, 4)
SetColumnSpan(Btn, 4)
SetRowSpan(Btn, 4)
SetColumnSpan(Btn, 10) : SetRowSpan(Btn, 10)
Children.Add(Btn)
ButtonStack = Btn
Next
Case Else
'有复数按钮,使用 StackPanel
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumn(ButtonStack, 4)
SetColumnSpan(ButtonStack, 4)
SetRowSpan(ButtonStack, 4)
SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
@@ -222,19 +210,21 @@
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
'添加新 Logo
If Not _Logo = "" Then
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
PathLogo = New Image With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.ToLower.EndsWith(".png") OrElse _Logo.ToLower.EndsWith(".jpg") Then
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Background = Bitmap,
.RenderTransformOrigin = New Point(0.5, 0.5),
@@ -252,6 +242,7 @@
Else
'矢量图
PathLogo = New Shapes.Path With {
.Tag = Me,
.IsHitTestVisible = LogoClickable, .HorizontalAlignment = HorizontalAlignment.Center, .VerticalAlignment = VerticalAlignment.Center, .Stretch = Stretch.Uniform,
.Data = (New GeometryConverter).ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
@@ -267,7 +258,7 @@
If LogoClickable Then
AddHandler PathLogo.MouseLeave, Sub(sender, e) IsLogoDown = False
AddHandler PathLogo.MouseLeftButtonDown, Sub(sender, e) IsLogoDown = True
AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender, e)
AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender.Tag, e)
End If
End If
'改变行距
@@ -286,6 +277,9 @@
End Property
'图标的点击
''' <summary>
''' 该 Logo 是否可用点击触发事件。需要在 Logo 属性之前设置。
''' </summary>
Public Property LogoClickable As Boolean = False
Private IsLogoDown As Boolean = False
@@ -318,7 +312,8 @@
'添加竖条控件
If IsNothing(RectCheck) Then
RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center), .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
.HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))}
RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(RectCheck, 4)
@@ -333,7 +328,7 @@
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWith(".png") Then
If _Logo.EndsWithF(".png", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -447,7 +442,7 @@
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-1, 0, 0, 0)
End If
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush3", 200))
Anim.Add(AaColor(Me, ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"), 200))
Else
'由有变无
If Not IsNothing(RectCheck) Then
@@ -469,7 +464,7 @@
RectCheck.Opacity = 1
RectCheck.VerticalAlignment = VerticalAlignment.Stretch
End If
SetResourceReference(ForegroundProperty, "ColorBrush3")
SetResourceReference(ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"))
Else
If Not IsNothing(RectCheck) Then
RectCheck.Height = 0
@@ -526,10 +521,6 @@
Log("[Control] 按下复选列表项(" & (Not Checked).ToString & "):" & Title)
SetChecked(Not Checked, True, True)
End Select
'AniStart({
' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent),
' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
'鼠标点击判定
@@ -537,15 +528,12 @@
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseDirectlyOver AndAlso Not Type = CheckType.None Then
IsMouseDown = True
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = False
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False
End If
'AniStart({
' AaScaleTransform(Me, 0.985 - CType(RenderTransform, ScaleTransform).ScaleX, 50,, New AniEaseOutFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = True
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'实现自定义事件
@@ -599,7 +587,11 @@
'有动画
Dim Ani As New List(Of AniData)
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
If ButtonStack IsNot Nothing Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
Math.Max(MinPaddingRight, 5 + Buttons.Count * 25) - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
End If
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
@@ -613,27 +605,39 @@
End If
End If
Else
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.5))
If ButtonStack IsNot Nothing Then
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
MinPaddingRight - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
Ani.Add(AaOpacity(RectBack, -RectBack.Opacity, Time))
If IsScaleAnimationEnabled Then Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.246, 1,,, True)
})
If IsScaleAnimationEnabled Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(Me, 1 - CType(RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.246, 1,,, True)
})
End If
End If
AniStart(Ani, "ListItem Color " & Uuid)
Else
'无动画
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1
If ButtonStack IsNot Nothing Then
ButtonStack.Opacity = 1
ColumnPaddingRight.Width = New GridLength(Math.Max(MinPaddingRight, 5 + Buttons.Count * 25))
End If
'由于鼠标已经移入,所以直接实例化 RectBack
RectBack.Background = ColorBg1
RectBack.Opacity = 1
RectBack.RenderTransform = New ScaleTransform(1, 1)
Me.RenderTransform = New ScaleTransform(1, 1)
Else
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 0
If ButtonStack IsNot Nothing Then
ButtonStack.Opacity = 0
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
End If
Me.RenderTransform = New ScaleTransform(1, 1)
If _RectBack IsNot Nothing Then
If IsScaleAnimationEnabled Then RectBack.RenderTransform = New ScaleTransform(0.75, 0.75)
@@ -647,13 +651,14 @@
Private Sub MyListItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If Checked Then
SetResourceReference(ForegroundProperty, "ColorBrush3")
SetResourceReference(ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2"))
Else
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
If EventType = "打开帮助" Then
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
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
@@ -46,7 +46,7 @@ Public Class MyLoading
Get
Return _Text
End Get
Set(ByVal value As String)
Set(value As String)
_Text = value
RefreshText()
End Set
@@ -57,7 +57,7 @@ Public Class MyLoading
Get
Return _TextError
End Get
Set(ByVal value As String)
Set(value As String)
_TextError = value
RefreshText()
End Set
@@ -67,29 +67,35 @@ Public Class MyLoading
''' </summary>
Public Property TextErrorInherit As Boolean = True
Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded
If InnerState = MyLoadingState.Error Then
If TextErrorInherit AndAlso State.IsLoader Then
Dim Ex As Exception = CType(State, Object).Error
If Ex Is Nothing Then
LabText.Text = "未知错误"
Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded, _State.ProgressChanged
RunInUi(
Sub()
If InnerState = MyLoadingState.Error Then
If TextErrorInherit AndAlso State.IsLoader Then
Dim Ex As Exception = CType(State, Object).Error
If Ex Is Nothing Then
LabText.Text = "未知错误"
Else
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = StrTrim(Ex.Message)
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
LabText.Text = "网络环境不佳,请重试或尝试使用 VPN"
End If
End If
Else
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = StrTrim(Ex.Message)
If LabText.Text.Contains("远程主机强迫关闭了一个现有的连接") OrElse LabText.Text.Contains("操作已超时") OrElse LabText.Text.Contains("操作超时") OrElse LabText.Text.Contains("服务器超时") OrElse LabText.Text.Contains("连接超时") Then LabText.Text = "网络环境不佳,请重试或尝试使用 VPN"
LabText.Text = TextError
End If
Else
LabText.Text = TextError
If ShowProgress AndAlso State.IsLoader Then
LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%"
Else
LabText.Text = Text
End If
End If
Else
If ShowProgress AndAlso State.IsLoader Then
LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%"
Else
LabText.Text = Text
End If
End If
End Sub)
End Sub
#End Region
@@ -180,46 +186,7 @@ Public Class MyLoading
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
IsLooping = True
ErrorAnimationWaiting = True
If ShowProgress Then
RefreshText()
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaCode(AddressOf RefreshText, 100), '这是为了省下一个 Timer 线程……
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
PathRight.Margin = New Thickness(14, 41, 0, 0)
ErrorAnimationWaiting = False
RefreshText()
End Sub),
AaCode(AddressOf RefreshText, 100),
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
AaCode(AddressOf RefreshText, 600),
AaCode(AddressOf RefreshText, 700),
AaCode(AddressOf RefreshText, 800),
AaOpacity(PathLeft, -1, 100, 70),
AaX(PathLeft, -5, 180, 20, New AniEaseOutFluent),
AaY(PathLeft, -6, 180, 20, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 70),
AaX(PathRight, 5, 180, 20, New AniEaseOutFluent),
AaY(PathRight, -6, 180, 20, New AniEaseOutFluent),
AaCode(Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
Else
AniStart({
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
@@ -241,6 +208,8 @@ Public Class MyLoading
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
If ShowProgress Then
End If
End Sub
@@ -291,6 +260,7 @@ Public Interface ILoadingTrigger
ReadOnly Property IsLoader As Boolean
Property LoadingState As MyLoadingState
Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState)
Event ProgressChanged(NewProgress As Double, OldProgress As Double)
End Interface
Public Class MyLoadingStateSimulator
@@ -310,4 +280,5 @@ Public Class MyLoadingStateSimulator
Public ReadOnly Property IsLoader As Boolean = False Implements ILoadingTrigger.IsLoader
Public Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
End Class
@@ -6,6 +6,8 @@
Dim IconControl As Shapes.Path = GetTemplateChild("Icon")
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If
'对父级设置透明度
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
End Sub
'基础
@@ -58,11 +58,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -63,11 +63,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -56,11 +56,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
+27 -21
View File
@@ -29,21 +29,28 @@
'逐个进入动画
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
For Each Element As FrameworkElement In GetAllAnimControls(True)
If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变(#2436)
Element.Opacity = 1
Element.RenderTransform = New TranslateTransform(0, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
Else
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Id += 1
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
End If
@@ -74,23 +81,22 @@
End Sub
'遍历获取所有需要生成动画的控件
Private Function GetAllAnimControls() As List(Of FrameworkElement)
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(AnimatedControl, AllControls)
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement))
If Element.Visibility = Visibility.Collapsed Then Exit Sub
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is MyListItem Then
CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls)
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls, IgnoreInvisibility)
ElseIf TypeOf Element Is Panel Then
For Each Element2 As FrameworkElement In CType(Element, Panel).Children
GetAllAnimControls(Element2, AllControls)
GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
Next
Else
AllControls.Add(Element)
+23 -9
View File
@@ -2,6 +2,18 @@
Inherits AdornerDecorator
Public PageUuid As Integer = GetUuid()
'“返回顶部” 按钮检测的滚动区域
Public Property PanScroll As MyScrollViewer
Get
Return GetValue(PanScrollProperty)
End Get
Set(value As MyScrollViewer)
SetValue(PanScrollProperty, value)
End Set
End Property
Private Shared ReadOnly PanScrollProperty =
DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing))
'当前状态
Public Enum PageStates
Empty '默认状态,页面全空
@@ -62,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
@@ -77,7 +89,7 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else
Dim Input = Nothing
@@ -95,7 +107,7 @@
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
@@ -152,6 +164,7 @@
''' </summary>
Public Sub PageOnExit()
If ModeDebug Then Log("[UI] 已触发 PageOnExit")
RaiseEvent PageExit()
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
PageState = PageStates.PageExit
@@ -168,6 +181,7 @@
Case PageStates.PageExit, PageStates.Empty
End Select
End Sub
Public Event PageExit()
''' <summary>
''' 即将切换到其他页面,需要强制完成页面状态清理。
''' 需要立即切换至 Empty。
@@ -4,6 +4,6 @@
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -252,7 +252,7 @@
End If
Catch ex As Exception
Log(ex, "刷新按钮颜色出错")
Log(ex, "刷新单选按钮颜色出错")
End Try
End Sub
+1 -1
View File
@@ -128,7 +128,7 @@ Public Class MyResizer
Private Declare Function GetMonitorInfo Lib "user32" (hMonitor As IntPtr, lpmi As MONITORINFO) As Boolean
Friend Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
Private Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
Private Sub connectMouseHandlers(element As UIElement)
AddHandler element.MouseLeftButtonDown, AddressOf Me.element_MouseLeftButtonDown
@@ -8,19 +8,25 @@
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso
((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
End If
PerformVerticalOffsetDelta(-e.Delta)
e.Handled = True
PerformVerticalOffsetDelta(-e.Delta)
'关闭 Tooltip (#2552)
For Each TooltipBorder In Application.ShowingTooltips
AniStart(AaOpacity(TooltipBorder, -1, 100), $"Hide Tooltip {GetUuid()}")
Next
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double)
RealOffset = MathRange(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
End Sub
@@ -1,7 +1,7 @@
Class MySearchBox
Inherits MyCard
Public Event TextChanged(ByVal sender As Object, ByVal e As EventArgs)
Public Event TextChanged(sender As Object, e As EventArgs)
Private Sub MySearchBox_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
TextBox.Focus()
End Sub
@@ -11,7 +11,7 @@
Get
Return TextBox.HintText
End Get
Set(ByVal value As String)
Set(value As String)
TextBox.HintText = value
End Set
End Property
@@ -19,7 +19,7 @@
Get
Return TextBox.Text
End Get
Set(ByVal value As String)
Set(value As String)
TextBox.Text = value
End Set
End Property
@@ -28,7 +28,7 @@
Set(newValue As Integer)
Try
newValue = MathRange(newValue, 0, MaxValue)
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
'触发 Preview 事件,修改新值
@@ -88,7 +88,7 @@
AniStop("MySlider KeyPopup " & Uuid)
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
@@ -91,7 +91,7 @@
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
@@ -101,7 +101,7 @@
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
+10 -7
View File
@@ -1,10 +1,13 @@
<Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher 2 " AllowsTransparency="True" MinHeight="470" MinWidth="810" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher " AllowsTransparency="True" MinHeight="470" MinWidth="810"
ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None"
ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500"
RenderTransformOrigin="0.5,0.5">
<Window.TaskbarItemInfo>
<TaskbarItemInfo ThumbnailClipMargin="{Binding Margin, ElementName=PanForm}" />
</Window.TaskbarItemInfo>
@@ -131,7 +134,7 @@
<Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
<local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28"
LogoScale="0.87" Logo="M1097.162313 584.707482 250.272424 584.707482 562.833701 896.95123C591.749274 925.859979 591.749274 972.659975 562.833701 1001.568724 533.91812 1030.477473 487.058315 1030.477473 458.142742 1001.568724L21.580946 565.451235C6.757449 550.631234-0.361728 531.131238 0.028357 511.679985L0.028357 511.631236 0.028357 511.582486C-0.361728 492.13124 6.757449 472.582488 21.580946 457.762487L458.142742 21.644997C487.058315-7.215002 533.91812-7.215002 562.833701 21.644997 591.749274 50.553746 591.749274 97.4025 562.833701 126.262499L250.272424 438.55499 1097.162313 438.55499C1137.585605 438.55499 1170.304578 471.266238 1170.304578 511.631236 1170.304578 551.947483 1137.585605 584.707482 1097.162313 584.707482L1097.162313 584.707482Z" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,0,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
</Grid>
</Grid>
<Grid x:Name="PanLeft" Grid.Row="1" HorizontalAlignment="Left" SnapsToDevicePixels="True">
File diff suppressed because it is too large. Load diff
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.8 KiB

After

Width:  |  Height:  |  Size: 3.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

@@ -577,10 +577,10 @@ Public Module ModAnimation
Public Class AniEaseLinear
Inherits AniEase
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1)
Return MathClamp(t, 0, 1)
End Function
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
Return MathRange(t1, 0, 1) - MathRange(t0, 0, 1)
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
End Function
End Class
@@ -595,7 +595,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1) ^ p
Return MathClamp(t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -608,7 +608,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return 1 - MathRange(1 - t, 0, 1) ^ p
Return 1 - MathClamp(1 - t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -636,7 +636,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
End Function
End Class
@@ -650,7 +650,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
End Function
End Class
@@ -694,7 +694,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -708,7 +708,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = 1 - MathRange(t, 0, 1)
t = 1 - MathClamp(t, 0, 1)
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -766,7 +766,7 @@ Public Module ModAnimation
''' <summary>
''' 开始动画执行。
''' </summary>
Public Sub AniStartRun()
Public Sub AniStart()
'初始化计时器
AniLastTick = GetTimeTick()
AniFPSTimer = AniLastTick
@@ -777,12 +777,12 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathRange(GetTimeTick() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathRange(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -869,7 +869,7 @@ NextAni:
Loop
'如果当前动画组都执行完毕则删除
If Entry.Data.Count = 0 Then
If Not Entry.Data.Any() Then
'为了避免新添加的动画影响顺序,不能 RemoveAt(i)
'为了允许动画在执行中添加同名动画组,不能按名字移除
For Current = 0 To AniGroups.Count - 1
@@ -904,7 +904,7 @@ NextAni:
Case AniTypeSub.Y
DeltaTop(Ani.Obj, Delta)
Case AniTypeSub.Opacity
Ani.Obj.Opacity = MathRange(Ani.Obj.Opacity + Delta, 0, 1)
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
Case AniTypeSub.Width
Dim Obj As FrameworkElement = Ani.Obj
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
File diff suppressed because it is too large. Load diff
@@ -153,10 +153,14 @@
End Select
End Get
Set(value As Double)
If _Progress = value Then Exit Property
Dim OldValue = _Progress
_Progress = value
RaiseEvent ProgressChanged(value, OldValue)
End Set
End Property
Private _Progress As Double = -1
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
''' <summary>
''' 计算总进度时的权重。它应该为预计时间(秒)。
''' </summary>
@@ -236,12 +240,16 @@
''' </summary>
Public ReadOnly Property IsAborted As Boolean
Get
Return LastRunningThread Is Nothing OrElse
Not ReferenceEquals(Thread.CurrentThread, LastRunningThread) OrElse
State = LoadState.Aborted
Return IsAbortedWithThread(Thread.CurrentThread)
End Get
End Property
''' <summary>
''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。
''' </summary>
Public Function IsAbortedWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted
End Function
''' <summary>
''' 在输入相同时使用原有结果的超时,单位为毫秒。
''' </summary>
Public ReloadTimeout As Integer = -1
@@ -258,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
@@ -437,10 +445,6 @@
For Each Loader In Loaders
Loader.Abort()
Next
'从列表删除
SyncLock LoaderTaskbarLock
If LoaderTaskbar.Contains(Me) Then LoaderTaskbar.Remove(Me)
End SyncLock
End Sub)
End Sub
@@ -486,7 +490,7 @@
Select Case Loader.State
Case LoadState.Finished
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
@@ -496,7 +500,7 @@
End If
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
@@ -513,9 +517,9 @@ Restart:
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
ElseIf LoaderType.StartsWith("LoaderDownload") Then
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else
Throw New Exception("未知的加载器类型(" & LoaderType & ")")
@@ -541,7 +545,7 @@ Restart:
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List)
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
Next
End Sub
''' <summary>
@@ -562,40 +566,33 @@ Restart:
End Class
'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
End SyncLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
Dim RemovedTask As New List(Of LoaderBase)
For i = 0 To LoaderTaskbar.Count - 1
If (IsAllDownloadTaskCompleted OrElse LoaderTaskbar(i).State = LoadState.Aborted) AndAlso LoaderTaskbar(i).Show Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(LoaderTaskbar(i))
RemovedTask.Add(LoaderTaskbar(i))
End If
Next
For Each Task In RemovedTask
LoaderTaskbar.Remove(Task)
Next
End SyncLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.TryTake(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
@@ -604,7 +601,7 @@ Restart:
End If
RunInUi(Sub() FrmMain.BtnExtraDownload.Progress = LoaderTaskbarProgress)
'更新任务栏信息
If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then
If Not LoaderTaskbar.Any() OrElse LoaderTaskbarProgress = 1 Then
NewState = Shell.TaskbarItemProgressState.None
ElseIf LoaderTaskbarProgress < 0.015 Then
NewState = Shell.TaskbarItemProgressState.Indeterminate
@@ -623,15 +620,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
Total += LoaderTaskbar(i).Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathRange(Total / Count, 0, 1)
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
File diff suppressed because it is too large. Load diff
@@ -76,7 +76,7 @@ Public Class ValidateHttp
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1)
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
Return ""
End Function
@@ -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.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If Str.IndexOfF(Ch, True) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch)
End If
@@ -220,13 +220,13 @@ Public Class ValidateFolderName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -273,13 +273,13 @@ Public Class ValidateFileName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -319,7 +319,7 @@ Public Class ValidateFolderPath
Public Overrides Function Validate(Str As String) As String
'去除尾部斜线,统一为 \
Str = Str.Replace("/", "\")
If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\")
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
@@ -327,15 +327,15 @@ Public Class ValidateFolderPath
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查开头
If Str.StartsWith("\\Mac\") Then GoTo Fin
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return ""
If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
Next
Return "文件夹路径头存在错误!"
Fin:
'对首层以外的路径检查
For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
For i = If(Str.StartsWithF("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
Dim SubStr As String = Str.Split("\")(i)
'检查是否为空
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
@@ -344,10 +344,10 @@ Fin:
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查尾部小数点
If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If SubStr.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
@@ -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
+15 -32
View File
@@ -28,7 +28,7 @@ Public Class MyBitmap
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
Try
Dim size = rect.Width * rect.Height * 4
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride)
@@ -54,7 +54,8 @@ Public Class MyBitmap
End Sub
Public Sub New(FilePathOrResourceName As String)
Try
If FilePathOrResourceName.StartsWith(PathImage) Then
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic
@@ -73,10 +74,10 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, "加载位图失败(" & FilePathOrResourceName & ")")
Log(ex, $"加载位图失败({FilePathOrResourceName})")
Throw
Else
Log(ex, "指定类型有误的位图加载(" & FilePathOrResourceName & ")", LogLevel.Developer)
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try
End If
End Try
@@ -104,45 +105,27 @@ Public Class MyBitmap
End Using
End Sub
''' <summary>
''' 获取旋转的图片,这个方法不会导致原对象改变且会返回一个新的对象。图片长宽必须相等。
''' </summary>
''' <param name="angle">旋转角度(单位为角度)。</param>
Public Function Rotation(angle As Double) As System.Drawing.Bitmap
Dim img As System.Drawing.Image = Me.Pic
Dim bitSize As Single = img.Width
Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize), img.PixelFormat)
bmp.SetResolution(img.HorizontalResolution, img.VerticalResolution)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.NearestNeighbor
g.TranslateTransform(bitSize / 2, bitSize / 2)
g.RotateTransform(angle)
g.TranslateTransform(-bitSize / 2, -bitSize / 2)
g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width))
End Using
Return bmp
End Function
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap
Dim img As System.Drawing.Image = Pic
Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height, img.PixelFormat)
bmp.SetResolution(img.HorizontalResolution, img.VerticalResolution)
Public Function Clip(X As Integer, Y As Integer, Width As Integer, Height As Integer) As MyBitmap
Dim bmp As New System.Drawing.Bitmap(Width, Height, Pic.PixelFormat)
bmp.SetResolution(Pic.HorizontalResolution, Pic.VerticalResolution)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.NearestNeighbor
g.DrawImageUnscaled(img, rect.X, rect.Y)
g.TranslateTransform(-X, -Y)
g.DrawImage(Pic, New System.Drawing.Rectangle(0, 0, Pic.Width, Pic.Height))
End Using
Return bmp
End Function
''' <summary>
''' 获取左右翻转的图片,这个方法不会导致原对象改变。
''' 获取旋转或翻转后的图片,这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function LeftRightFilp() As System.Drawing.Bitmap
Public Function RotateFlip(Type As System.Drawing.RotateFlipType) As MyBitmap
Dim bmp As New System.Drawing.Bitmap(Pic)
bmp.RotateFlip(System.Drawing.RotateFlipType.RotateNoneFlipX)
bmp.SetResolution(Pic.HorizontalResolution, Pic.VerticalResolution)
bmp.RotateFlip(Type)
Return bmp
End Function
@@ -152,7 +135,7 @@ Public Class MyBitmap
Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream = New System.IO.FileStream(FilePath, FileMode.Create)
Using fileStream As New FileStream(FilePath, FileMode.Create)
encoder.Save(fileStream)
End Using
End Sub
File diff suppressed because it is too large. Load diff
@@ -80,7 +80,7 @@
Log(ex, "确认崩溃日志时间失败(" & LogFile & ")")
End Try
Next
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件")
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
@@ -94,7 +94,7 @@
Log(ex, "读取可能的崩溃日志文件失败(" & FilePath & ")")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
@@ -110,33 +110,34 @@
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1:自主导入日志文件")
'解压压缩包
'尝试视作压缩包解压
Try
Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
'解压成功
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件:" & FilePath)
Else
'解压失败
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件:" & FilePath)
GoTo Extracted
End If
Catch ex As Exception
Log(ex, "解压导入文件中的压缩包失败")
Catch
End Try
'并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件:" & FilePath)
Extracted:
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then
If TargetFile.Name.StartsWith("crash-") Then
If TargetFile.Name.StartsWithF("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
Else
File.Delete(TargetFile.FullName)
End If
Catch ex As Exception
Log(ex, "导入单个日志文件失败")
@@ -167,10 +168,10 @@
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
If MatchName.StartsWith("hs_err") Then
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
ElseIf MatchName.StartsWith("crash-") Then
ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
@@ -185,13 +186,13 @@
Else
TargetType = AnalyzeFileType.ExtraLog
End If
ElseIf MatchName.EndsWith(".log") OrElse MatchName.EndsWith(".txt") Then
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraLog
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If LogFile.Value.Count = 0 Then
If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
@@ -206,7 +207,7 @@
For Each File In TotalFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If SelectedFiles.Count = 0 Then Continue For
If Not SelectedFiles.Any() Then Continue For
Try
'根据文件类别判断
Select Case SelectType
@@ -235,6 +236,7 @@
End If
Case AnalyzeFileType.MinecraftLog
LogMc = ""
LogMcDebug = ""
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
@@ -272,11 +274,21 @@
Exit For
End If
Next
'查找 Debug Log
For Each FileName As String In {"debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft Debug 日志")
Exit For
End If
Next
'检查错误
If LogMc = "" Then
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
End If
If LogMcDebug = "" Then LogMcDebug = Nothing
Case AnalyzeFileType.ExtraLog
'全部丢过去
For Each SelectedFile In SelectedFiles
@@ -294,28 +306,42 @@
If ResultCount = 0 Then
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
Else
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
End If
Return ResultCount
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
'3:根据文本分析崩溃原因
Private LogMc As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing
Private LogMc As String = Nothing, LogMcDebug As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing
Private LogAll As String
'可能导致崩溃的原因与附加信息
Private CrashReasons As New Dictionary(Of CrashReason, List(Of String))
@@ -324,6 +350,7 @@
''' </summary>
Private Enum CrashReason
Mod文件被解压
MixinBootstrap缺失
内存不足
使用JDK
显卡不支持OpenGL
@@ -340,13 +367,13 @@
光影或资源包导致OpenGL1282错误
文件或内容校验失败
确定Mod导致游戏崩溃
怀疑Mod导致游戏崩溃
Mod配置文件导致游戏崩溃
ModMixin失败
Mod加载器报错
Mod初始化失败
崩溃日志堆栈分析发现关键字
崩溃日志堆栈分析发现Mod名称
MC日志堆栈分析发现关键字
堆栈分析发现关键字
堆栈分析发现Mod名称
OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
特定方块导致崩溃
特定实体导致崩溃
@@ -365,65 +392,69 @@
ShadersMod与Optifine同时安装
Forge安装不完整
Mod需要Java11
Mod缺少前置或MC版本错误
End Enum
''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = (If(LogMc, "") & If(LogHs, "") & If(LogCrash, "")).ToLower
LogAll = (If(LogMc, "") & If(LogMcDebug, "") & If(LogHs, "") & If(LogCrash, ""))
'1. 精准日志匹配 1
'1. 精准日志匹配,中/高优先级
AnalyzeCrit1()
If CrashReasons.Count > 0 Then GoTo Done
If CrashReasons.Any Then GoTo Done
AnalyzeCrit2()
If CrashReasons.Any Then GoTo Done
'2. 堆栈分析
If LogAll.Contains("forge") OrElse LogAll.Contains("fabric") OrElse LogAll.Contains("liteloader") Then
'来源崩溃日志的分析
If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then
Dim Keywords As New List(Of String)
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Dim StackLogs As String = LogCrash.Split("System Details").First
Dim Keywords = AnalyzeStackKeyword(StackLogs)
If Keywords.Count > 0 Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.崩溃日志堆栈分析发现关键字, Keywords)
Else
AppendReason(CrashReason.崩溃日志堆栈分析发现Mod名称, Names)
End If
GoTo Done
End If
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
End If
'来自 Minecraft 日志的分析
'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.Count > 0 Then
Dim Keywords As New List(Of String)
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
If Keywords.Count > 0 Then
AppendReason(CrashReason.MC日志堆栈分析发现关键字, Keywords.Distinct.ToList)
GoTo Done
End If
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
End If
'虚拟机日志
If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'Mod 名称分析
If Keywords.Any Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.堆栈分析发现关键字, Keywords)
Else
AppendReason(CrashReason.堆栈分析发现Mod名称, Names)
End If
GoTo Done
End If
Else
Log("[Crash] 可能并未安装 Mod,不进行堆栈分析")
End If
'3. 精准日志匹配 2
AnalyzeCrit2()
'3. 精准日志匹配,低优先级
AnalyzeCrit3()
'输出到日志
Done:
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因")
Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "(" & Join(Reason.Value, ";") & ")", ""))
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", ""))
Next
End If
End Sub
@@ -439,7 +470,7 @@ Done:
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "(" & Join(Additional, ";") & ")", ""))
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", ""))
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -469,12 +500,12 @@ Done:
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>(net.minecraft.resources.ResourceLocation, ") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'java.lang.String com.mojang.blaze3d.systems.RenderSystem.getBackendDescription") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>(int[], int, net.minecraft.core.Direction, net.minecraft.client.renderer.texture.TextureAtlasSprite, boolean, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.addRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.removeRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'net.minecraft.network.chat.FormattedText net.minecraft.client.gui.Font.ellipsize(net.minecraft.network.chat.FormattedText, int)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraftforge.client.gui.overlay.ForgeGui.renderSelectedItemName") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'net.minecraft.network.chat.FormattedText net.minecraft.client.gui.Font.ellipsize") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("java.lang.NoSuchFieldException: ucp") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
@@ -482,8 +513,9 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.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错误)
@@ -496,7 +528,8 @@ Done:
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.UnsupportedClassVersionError: net/fabricmc/loader/impl/launch/knot/KnotClient : Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("java.lang.IllegalArgumentException: The requested compatibility level JAVA_11 could not be set. Level is not supported by the active JRE or ASM version") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("Invalid maximum heap size") Then AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
If LogMc.Contains("Could not reserve enough space") Then
If LogMc.Contains("for 1048576KB object heap") Then
@@ -505,31 +538,18 @@ Done:
AppendReason(CrashReason.内存不足)
End If
End If
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复安装
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("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("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'仅当没有其他分析结果时显示
If CrashReasons.Count = 0 Then
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
'Mod 缺少前置
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
End If
End If
@@ -550,31 +570,74 @@ 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))
End If
End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' 进行精准日志匹配。匹配优先级高于堆栈分析的崩溃,但低于上面的。
''' 如果第一步已经找到了原因则不执行该检测。
''' </summary>
Private Sub AnalyzeCrit2()
'游戏日志分析
If LogMc IsNot Nothing Then
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso
LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
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))
'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(".json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
Else
'在 #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)
End If
'Mixin 失败可以导致大量 Mod 实例创建失败
@@ -593,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)
@@ -603,17 +670,17 @@ Done:
'If Not Stack.Contains(".") Then Continue For
For Each IgnoreStack In {
"java", "sun", "javax", "jdk", "oolloo",
"org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"com.electronwill.nightconfig", "it.unimi.dsi",
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
PossibleStacks.Add(Stack.Trim)
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
If PossibleStacks.Count = 0 Then Return New List(Of String)
If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Next
@@ -624,20 +691,21 @@ NextStack:
Dim Splited = Stack.Split(".")
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
"fastutil", "optifine", "scheduler", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity", "platform"
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"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
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
Return New List(Of String)
@@ -647,7 +715,7 @@ NextStack:
End Function
''' <summary>
''' 根据 Mod 关键词与详细信息(崩溃报告第二部分)与,获取实际的 Mod 名称。
''' 根据 Mod 关键词尝试获取实际的 Mod 名称。
''' 若失败则返回 Nothing。
''' </summary>
Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String)
@@ -662,69 +730,111 @@ NextStack:
Next
Keywords = RealKeywords
'获取崩溃报告对应部分
If LogCrash Is Nothing Then Return Nothing
If Not LogCrash.Contains("A detailed walkthrough of the error") Then Return Nothing
Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨")
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 检测到 Fabric Mod 信息格式")
End If
Details = Details.Split("¨").Last
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModName As String In HintLines
Log("[Crash] - " & ModName)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
'从崩溃报告获取 Mod 信息
If LogCrash IsNot Nothing AndAlso LogCrash.Contains("A detailed walkthrough of the error") Then
Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨")
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
ModFileNames = ModFileNames.Distinct.ToList
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Next
Details = Details.After("¨")
Return If(ModFileNames.Count = 0, Nothing, ModFileNames)
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ContainsF(".jar", True) OrElse
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 崩溃报告中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
End If
'从 debug.log 获取 Mod 信息
If LogMcDebug IsNot Nothing Then
'Forge: Found valid mod file YungsBetterStrongholds-1.20-Forge-4.0.1.jar with {betterstrongholds} mods - versions {1.20-Forge-4.0.1}
Dim ModNameLines As List(Of String) = RegexSearch(LogMcDebug, "(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Log("[Crash] Debug 信息中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
If ModString.Contains($"{{{KeyWord}}}") Then HintLines.Add(ModString)
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] Debug 信息中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
Name = RegexSeek(Line, ".*(?= with)")
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
End If
'输出
ModFileNames = ModFileNames.Distinct.ToList
If Not ModFileNames.Any() Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Next
Return ModFileNames
End If
End Function
''' <summary>
''' 尝试获取 Mod 名称,若失败则返回原关键字。
''' 尝试从关键字获取 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)
@@ -737,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))
@@ -771,7 +881,10 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile)))
Dim FileEncoding As Encoding = GetEncoding(OutputFile)
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
End If
Next
'导出报告
@@ -791,13 +904,11 @@ NextStack:
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'没有结果的处理
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。"
Else
Return "很抱歉,你的游戏出现了一些问题……" & vbCrLf &
"如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf &
"你也可以查看错误报告,其中可能会有出错的原因。"
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请导出错误报告并发给他人,而不是发送这个窗口的截图。"
End If
End If
@@ -809,7 +920,7 @@ NextStack:
Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
Case CrashReason.内存不足
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是因为电脑内存不足、游戏分配的内存不足,或是配置要求过高。\n\n你可以尝试在 更多 → 百宝箱 中选择 内存优化,然后再启动游戏。\n如果还是不行,请在启动设置中增加为游戏分配的内存,并删除配置要求较高的材质、Mod、光影。\n如果依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Case CrashReason.使用OpenJ9
Results.Add("游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。")
Case CrashReason.使用JDK
@@ -820,47 +931,55 @@ NextStack:
Results.Add("游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。")
Case CrashReason.Mod名称包含特殊字符
Results.Add("由于有 Mod 的名称包含特殊字符,导致游戏崩溃。\n请尝试修改 Mod 文件名,让它只包含英文字母、数字、减号(-)、下划线(_)和小数点,然后再启动游戏。")
Case CrashReason.MixinBootstrap缺失
Results.Add("由于缺失 MixinBootstrap,导致游戏崩溃。\n请尝试安装 MixinBootstrap。若安装后依然崩溃,可以尝试在文件名前添加英文感叹号。")
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
Results.Add("你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。")
Else
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
End If
Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字
If Additional.Count = 1 Then
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.崩溃日志堆栈分析发现Mod名称
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h")
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else
Results.Add("可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h")
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If
Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then
Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
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
@@ -885,7 +1004,7 @@ NextStack:
Case CrashReason.ShadersMod与Optifine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java")
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
@@ -904,7 +1023,7 @@ NextStack:
End If
Case CrashReason.材质过大或显卡配置不足
Results.Add("你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h")
Case CrashReason.材质过大或显卡配置不足
Case CrashReason.NightConfig的Bug
Results.Add("由于 Night Config 存在问题,导致了游戏崩溃。\n你可以尝试安装 Night Config Fixes 模组,这或许能解决此问题。\h")
Case CrashReason.光影或资源包导致OpenGL1282错误
Results.Add("你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h")
@@ -945,18 +1064,16 @@ NextStack:
End Select
Next
'整理多个原因
IsHandAnalyze = False
Return Join(Results, "\n\n此外,").
Replace("\n", vbCrLf).
Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWith("\h")) OrElse IsHandAnalyze, "",
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 文件下载信息")
@@ -19,14 +23,7 @@
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable Then
'是否跳过
Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
Case 0 '使用全局设置
Case 1 '开启
IsSetupSkip = False
Case 2 '关闭
IsSetupSkip = True
End Select
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
End If
@@ -52,7 +49,7 @@
If IndexUrl = "" Then
Return Nothing
Else
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl, False), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
End If
End Function
@@ -64,43 +61,33 @@
#Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载支持库文件(主加载器)", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16})
#End Region
#Region "下载资源文件"
Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
Case 0
'使用全局设置
Case 1
'开启
IsSetupSkip = False
Case 2
'关闭
IsSetupSkip = True
End Select
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
'要求独立更新索引
@@ -108,27 +95,34 @@
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新:每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引")
Task.Abort()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台更新资源文件索引")
Log("[Download] 开始后台检查资源文件索引")
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
@@ -230,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>
@@ -238,9 +232,7 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json",
BackupUrl:="https://download.mcbbs.net/mc/game/version_manifest.json",
IsJson:=True)
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -249,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
@@ -267,7 +259,7 @@
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
@@ -300,6 +292,7 @@
''' </summary>
Public Value As List(Of DlOptiFineListEntry)
End Structure
Public Class DlOptiFineListEntry
''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
@@ -325,7 +318,7 @@
Return _inherit
End Get
Set(value As String)
If value.EndsWith(".0") Then value = Left(value, value.Length - 2)
If value.EndsWithF(".0") Then value = Left(value, value.Length - 2)
_inherit = value
End Set
End Property
@@ -371,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).ToLower.Contains("pre"),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToLower.Contains("pre"), "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>
@@ -401,15 +398,14 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList",
BackupUrl:="https://download.mcbbs.net/optifine/versionList", IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -420,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
@@ -472,7 +468,7 @@
''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -486,8 +482,7 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default,
BackupUrl:="https://download.mcbbs.net/forge/minecraft")
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
@@ -499,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>
@@ -525,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>
@@ -610,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -622,7 +628,7 @@
Dim Versions As New List(Of DlForgeVersionEntry)
Try
'分割版本信息
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("</table>")).Split("<td class=""download-version")
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
'获取所有版本信息
For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i)
@@ -634,30 +640,28 @@
'分支获取
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"
Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
0, DateTimeKind.Utc) '以 UTC 时间作为标准
Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy/MM/dd HH:mm") '时区与格式转换
Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm") '时区与格式转换
'分类与 MD5 获取
Dim MD5 As String, Category As String
If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
@@ -665,15 +669,15 @@
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 Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
@@ -681,8 +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,
BackupUrl:="https://download.mcbbs.net/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)
@@ -715,27 +720,150 @@
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")
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 Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
#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 DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
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
@@ -756,6 +884,7 @@
''' </summary>
Public OfficialError As Exception
End Structure
Public Class DlLiteLoaderListEntry
''' <summary>
''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
@@ -816,12 +945,12 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("http://dl.liteloader.com/versions/versions.json", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True)
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -829,13 +958,13 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
.JsonToken = RealEntry
})
Next
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
@@ -844,13 +973,12 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json",
BackupUrl:="https://download.mcbbs.net/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -858,13 +986,13 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
.JsonToken = RealEntry
})
Next
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
@@ -922,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
@@ -931,14 +1059,13 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions",
BackupUrl:="https://download.mcbbs.net/fabric-meta/v2/versions", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True)
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
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
@@ -956,38 +1083,121 @@
#End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {MojangBase.Replace("https://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
MojangBase,
MojangBase.Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
}
Public Function DlSourceResourceGet(Original As String) As String()
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
}
End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String()
Return {MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"),
MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"),
MojangBase,
MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
}
Public Function DlSourceLibraryGet(Original As String) As String()
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
If IsStatic Then
Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
}
Else
Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
}
End If
Public Function DlSourceModGet(Original As String) As String
Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
}
End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 4
Public JavaListCacheVersion As Integer = 7
''' <summary>
''' 目前所有可用的 Java。
@@ -62,7 +62,7 @@
Public ReadOnly Property HasEnvironment As Boolean
Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
Return PathEnv.Replace("\", "").Replace("/", "").ToLower.Contains(PathFolder.Replace("\", "").ToLower)
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
End Get
End Property
@@ -78,8 +78,8 @@
''' </summary>
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")," & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function
'构造
@@ -87,7 +87,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWith("\") Then Folder += "\"
If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\")
Me.IsUserImport = IsUserImport
End Sub
@@ -111,26 +111,35 @@
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
If Output = "" Then Throw New Exception("尝试运行该 Java 失败")
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
Do While VersionString.Split(".").Count < 4
If VersionString.StartsWith("1.") Then
If VersionString.StartsWithF("1.") Then
VersionString = VersionString & ".0"
Else
VersionString = "1." & VersionString
End If
Loop
If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为:{vbCrLf}{Output}", "")}")
Version = New Version(VersionString)
If Version.Minor = 0 Then
Log("[Java] 疑似 X.0.X.X 格式版本号:" & Version.ToString)
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)
'无论如何不允许使用 JRE 16,它完全是炸的,安 OptiFine、Forge 和启动 MC 都会炸
If IsJre AndAlso VersionCode = 16 Then Throw New Exception("由于 JRE 16 对 Minecraft 的兼容性很差,因此不再允许使用")
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
Throw ex
Catch ex As ThreadInterruptedException
Throw ex
Catch ex As Exception
Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex)
@@ -178,7 +187,7 @@
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
If JavaList.Count = 0 Then
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
JavaSearchLoader.Start(0)
Else
@@ -190,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
@@ -206,6 +220,8 @@
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList
@@ -213,7 +229,7 @@
Next
'检查特定的 Java
If TargetJavaList.Count > 0 Then
If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java:")
For Each Java In TargetJavaList
@@ -226,22 +242,30 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
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()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("LaunchArgumentJavaSelect")
@@ -281,7 +305,7 @@ RetryGet:
Next
'若未找到适合的 Java,尝试触发搜索
If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
@@ -318,9 +342,9 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If Setup.Get("LaunchAdvanceJava") Then
If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then
'直接跳过弹窗
Hint("设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", HintType.Critical)
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf &
@@ -342,7 +366,7 @@ ExitUserJavaCheck:
#End Region
'若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
If Not AllowedJavaList.Any() Then Return Nothing
'优先使用特定目录下的 Java
For Each Java In AllowedJavaList
@@ -435,11 +459,11 @@ NoUserJava:
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
If Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWith(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then
If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If
'2. 尽量使用 64 位
If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True
@@ -449,8 +473,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...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 12, 15, 13, 9, 8, 7, 11, 31, 30, 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
@@ -490,7 +514,7 @@ NoUserJava:
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next
@@ -523,19 +547,19 @@ NoUserJava:
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Continue For
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit
#End Region
@@ -556,7 +580,7 @@ NoUserJava:
'确保可用并获取详细信息,转入正式列表
Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In Distinct(JavaPreList.ToList, Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter)
@@ -590,21 +614,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 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
@@ -641,37 +667,22 @@ Wait:
'确认目录存在
If Not OriginalPath.Exists Then Exit Sub
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWith("\") Then Path += "\"
If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 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("software") 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("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
@@ -688,67 +699,74 @@ Wait:
''' <summary>
''' 提示 Java 缺失,并弹窗确认是否自动下载。返回玩家选择是否下载。
''' 支持下载 Java 8、14、17,输入其他 VersionCode 会要求玩家自行下载。
''' </summary>
Public Function JavaDownloadConfirm(VersionCode As String) As Boolean
If VersionCode = 8 OrElse VersionCode = 14 OrElse VersionCode = 17 Then
Return MyMsgBox($"PCL 未找到 Java {VersionCode},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 Java {VersionCode},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
Else
MyMsgBox($"PCL 未找到 Java {VersionCode}。" & vbCrLf &
$"请自行搜索并安装 Java {VersionCode},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean
If ForcedManualDownload Then
MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
$"请自行搜索并安装 {VersionDescription},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
"未找到 Java")
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
End If
End Function
''' <summary>
''' 获取下载 Java 8/14/17 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Return New LoaderCombo(Of Integer)($"下载 Java {Version}", {
Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", {
New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10},
JavaDownloadLoader,
JavaSearchLoader
})
AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug)
DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing
End If
End Sub
JavaDownloadLoader.HasOnStateChangedThread = True
Return Loader
End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetGetCodeByDownload(
{"https://download.mcbbs.net/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
IsJson:=True)
'获取下载地址
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWith(Loader.Input))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表
Dim ListFileStr As String = NetGetCodeByDownload(
{Address.Replace("piston-meta.mojang.com", "download.mcbbs.net"),
Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"),
Address},
IsJson:=True)
Dim BaseDir As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
Dim ListFileStr As String = NetGetCodeByDownload({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
Dim Info As JObject = CType(File.Value, JObject)("downloads")("raw")
Dim Checker As New FileChecker(ActualSize:=Info("size"), Hash:=Info("sha1"))
If Checker.Check(BaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
If Checker.Hash = "12976a6c2b227cbac58969c1455444596c894656" OrElse Checker.Hash = "c80e4bab46e34d02826eab226a4441d0970f2aba" OrElse Checker.Hash = "84d2102ad171863db04e7ee22a259d1f6c5de4a5" Then
'跳过 3 个无意义大量重复文件(#3827)
Continue For
End If
If Checker.Check(LastJavaBaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
Dim Url As String = Info("url")
Results.Add(New NetFile(
{Url.Replace("piston-data.mojang.com", "download.mcbbs.net"),
Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"),
Url},
BaseDir & File.Name, Checker))
Results.Add(New NetFile({Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"), Url}, LastJavaBaseDir & File.Name, Checker))
Next
Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件,目标文件夹:{BaseDir}")
Log($"[Java] 需要下载 {Results.Count} 个文件,目标文件夹:{LastJavaBaseDir}")
End Sub
#End Region
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
@@ -96,7 +96,7 @@
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{time}", Date.Now.ToShortTimeString)
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
@@ -116,7 +116,7 @@
Get
Return _State
End Get
Set(ByVal value As MinecraftState)
Set(value As MinecraftState)
If _State = value Then Exit Property
_State = value
WatcherStateChanged()
@@ -143,7 +143,7 @@
'输出文本
Dim Copyed As New List(Of String)
SyncLock WaitingLogLock
If WaitingLog.Count = 0 Then Exit Sub
If Not WaitingLog.Any() Then Exit Sub
Copyed = WaitingLog
WaitingLog = New List(Of String)(1000)
End SyncLock
@@ -192,7 +192,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2
ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
WatcherLog("日志 3/5:LWJGL 版本已确认")
LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -269,23 +269,25 @@
If MinecraftWindow Is Nothing Then Exit Sub
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
'已找到窗口
If Not MinecraftWindowName.StartsWith("FML") Then
If Not MinecraftWindowName.StartsWithF("FML") Then
'已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle
WatcherLog("Minecraft 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")")
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
RunInNewThread(
Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
ElseIf Not IsWindowAppeared Then
'已找到 FML 窗口
@@ -316,7 +318,7 @@
Dim WindowText As String = str.ToString
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
'部分版本会搞个 GLFW message window 出来所以得反选
If Not (WindowText.StartsWith("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWith("GLFW")) Then Exit Sub
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
'获取窗口关联的进程
Dim ProcessId As Integer
GetWindowThreadProcessId(hwnd, ProcessId)
@@ -346,6 +348,7 @@
'崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……")
FeedbackInfo()
RunInNewThread(Sub()
Try
Thread.Sleep(2000)
@@ -29,15 +29,15 @@
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Foreground="{DynamicResource ColorBrush1}" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,0,0">
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="1,0,3,0.5"
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,0.5"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
IsHitTestVisible="True" SnapsToDevicePixels="False" UseLayoutRounding="False"
ToolTipService.InitialShowDelay="100" ToolTipService.BetweenShowDelay="100"
@@ -1,8 +1,9 @@
Public Class MyCompItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
#Region "Logo"
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
@@ -13,15 +14,15 @@
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -44,43 +45,116 @@
End Try
End Set
End Property
Private Sub LogoLoader(Address As String)
Dim Retry As Boolean = False
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
NetDownload(_Logo, Address & DownloadEnd)
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(Sub()
Try
'在地址更换时取消加载
If Not Address = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(Address & DownloadEnd)
Catch ex As Exception
Log(ex, "读取资源工程图标失败(" & Address & ")")
File.Delete(Address & DownloadEnd)
LoadError = ex
End Try
End Sub)
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(Address) Then
File.Delete(Address & DownloadEnd)
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(Address & DownloadEnd, Address)
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retry Then
Retry = True
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Public Property Title As String
Get
Return LabTitle.Text
End Get
Set(value As String)
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
#End Region
#Region "点击"
@@ -94,11 +168,43 @@ RetryStart:
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
End If
End Sub
Private Sub ProjectClick(sender As MyCompItem, e As EventArgs) Handles Me.Click
'记录当前展开的卡片标题(#2712)
Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseOver Then IsMouseDown = True
If IsMouseOver AndAlso CanInteraction Then IsMouseDown = True
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
@@ -139,9 +245,12 @@ RetryStart:
#End Region
Private StateLast As String
Public HasAnimation As Boolean = True
''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' </summary>
Public CanInteraction As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
If Not HasAnimation Then Exit Sub
If Not CanInteraction Then Exit Sub
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
@@ -188,20 +297,4 @@ RetryStart:
End If
End Sub
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
End Class
@@ -0,0 +1,60 @@
<Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
<ColumnDefinition Width="7" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="4" x:Name="ColumnPaddingRight" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="17" />
<RowDefinition Height="18" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<local:MyIconTextButton Grid.Column="2" Text="更新" />
</Grid>-->
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid>
@@ -0,0 +1,538 @@
Imports System.Windows.Forms
Public Class MyLocalModItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
End Try
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Private _Title As String
Public Property Title As String
Get
Return _Title
End Get
Set(value As String)
Dim RawValue = value
Select Case Entry.State
Case McMod.McModState.Fine
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavaliable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
_Title = RawValue
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
'相关联的 Mod
Public Property Entry As McMod
Get
Return Tag
End Get
Set(value As McMod)
Tag = value
End Set
End Property
#End Region
#Region "点击与勾选"
'触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
Log("[Control] 按下本地 Mod 列表项:" & LabTitle.Text)
End If
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If Not IsMouseDirectlyOver Then Exit Sub
IsMouseDown = True
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'滑动选中
Private Shared SwipeStart As Integer, SwipeEnd As Integer
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
SwipeEnd = Index
Swiping = True
SwipToState = Not Checked
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
FrmVersionMod.CardSelect.IsHitTestVisible = True
Exit Sub
End If
'计算滑动范围
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Math.Min(SwipeStart, Index)
SwipeEnd = Math.Max(SwipeEnd, Index)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
Item.InitLate(Item, e)
Item.Checked = SwipToState
Next
End Sub
'勾选状态
Public Event Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs)
Private _Checked As Boolean = False
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
Try
'触发属性值修改
Dim RawValue = _Checked
If value = _Checked Then Exit Property
_Checked = value
Dim ChangedEventArgs As New RouteEventArgs(False)
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Property
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(False)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Property
End If
'更改动画
If IsVisibleInForm() Then
Dim Anim As New List(Of AniData)
If Checked Then
'由无变有
Dim Delta = 32 - RectCheck.ActualHeight
Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak)))
Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"), 200))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(LabTitle.TextDecorations Is Nothing, "ColorBrush1", "ColorBrushGray4"), 120))
End If
AniStart(Anim, "MyLocalModItem Checked " & Uuid)
Else
'不在窗口上时直接设置
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Set
End Property
#End Region
#Region "后加载内容"
'右下角状态指示图标
Private ImgState As Image
'指向背景
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(3),
.RenderTransform = New ScaleTransform(0.8, 0.8),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
'按钮
Public ButtonHandler As Action(Of MyLocalModItem, EventArgs)
Public ButtonStack As FrameworkElement
Private _Buttons As IEnumerable(Of MyIconButton)
Public Property Buttons As IEnumerable(Of MyIconButton)
Get
Return _Buttons
End Get
Set(value As IEnumerable(Of MyIconButton))
_Buttons = value
'移除原 Stack
If ButtonStack IsNot Nothing Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
If Not value.Any() Then Exit Property
'添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
End Set
End Property
'勾选条
Private _RectCheck As Border
Public ReadOnly Property RectCheck As Border
Get
If _RectCheck Is Nothing Then
_RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
.HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-3, 6, 0, 6), New Thickness(-3, 0, 0, 0))}
_RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(_RectCheck, 10)
Children.Add(_RectCheck)
End If
Return _RectCheck
End Get
End Property
#End Region
Public Sub Refresh()
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable
NewDescription = GetFileNameFromPath(Entry.Path)
End Select
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误,无法获取信息"
End If
Description = NewDescription
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
End If
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavaliable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
InitLate(sender, e)
'触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData)
'ButtonStack
If ButtonStack IsNot Nothing Then
If IsMouseOver Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
Else
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
End If
'RectBack
If IsMouseOver OrElse Checked Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub
'触发虚拟化内容
Private Sub InitLate(sender As Object, e As EventArgs)
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
End Sub
'显示更新日志
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
OpenWebsite(Entry.ChangelogUrls.First)
Else
Select Case MyMsgBox("要在哪个网站上查看更新日志?", "查看更新日志", "Modrinth", "CurseForge", "取消")
Case 1
OpenWebsite(ModrinthUrl)
Case 2
OpenWebsite(CurseForgeUrl)
End Select
End If
End Sub
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
FrmVersionMod.UpdateMods({Entry})
End Sub
End Class
@@ -0,0 +1,3 @@
Public Module ModDevelop
End Module
+48 -33
View File
@@ -13,39 +13,48 @@
Case "打开网页"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
End If
Hint("正在打开网页,请稍候……")
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
Try
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)
'确认实际路径
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)
Case "启动游戏"
If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
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) & "……")
End If
@@ -54,6 +63,7 @@
Case "刷新主页"
FrmLaunchRight.ForceRefresh()
If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
Case "刷新帮助"
PageOtherLeft.RefreshHelp()
@@ -65,15 +75,21 @@
RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
Case "清理垃圾"
PageOtherTest.RubbishClear()
RunInThread(Sub() PageOtherTest.RubbishClear())
Case "弹出窗口"
MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
Case "切换页面"
FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
Case "导入整合包", "安装整合包"
RunInUi(Sub() ModpackInstall())
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的协议。", "事件执行失败")
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
@@ -93,16 +109,15 @@
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
'网页确认
If RelativeUrl.ToLower.StartsWith("http") Then
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
Try
RawFileName = GetFileNameFromPath(RelativeUrl)
If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
"例如:" & vbCrLf &
+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
+62 -43
View File
@@ -5,7 +5,7 @@
''' <summary>
''' 接下来要播放的音乐文件路径。未初始化时为 Nothing。
''' </summary>
Public MusicToplayList As List(Of String) = Nothing
Public MusicWaitingList As List(Of String) = Nothing
''' <summary>
''' 全部音乐文件路径。未初始化时为 Nothing。
''' </summary>
@@ -22,20 +22,19 @@
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In My.Computer.FileSystem.GetFiles(Path & "PCL\Musics\", FileIO.SearchOption.SearchAllSubDirectories, "*.*")
For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Extend As String = File.Split(".").Last.ToLower
If Not (Extend = "ini" OrElse Extend = "jpg" OrElse Extend = "txt" OrElse Extend = "cfg" OrElse Extend = "png") Then
MusicAllList.Add(File)
End If
Dim Ext As String = File.Extension.ToLower
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName)
Next
End If
'打乱顺序播放
MusicToplayList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicToplayList.Count = 0 AndAlso MusicToplayList(0) = IgnoreFirst Then
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicToplayList.RemoveAt(0)
MusicToplayList.Add(IgnoreFirst)
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -46,12 +45,11 @@
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing Then MusicListInit(False)
If MusicAllList.Count = 0 Then Throw New Exception("在没有音乐时尝试获取音乐路径")
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicToplayList(0)
MusicToplayList.RemoveAt(0)
If MusicToplayList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
#End Region
@@ -65,22 +63,31 @@
RunInUi(Sub()
Try
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
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))
@@ -106,7 +113,8 @@
Case MusicStates.Play
MusicPause()
Case Else
Hint("音乐目前为停止状态!", HintType.Critical)
Log("[Music] 音乐目前为停止状态,已强制尝试开始播放", LogLevel.Debug)
MusicRefreshPlay(False)
End Select
End If
End Sub
@@ -116,13 +124,14 @@
''' </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
@@ -161,7 +170,7 @@
Try
MusicListInit(True)
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
Else
@@ -198,13 +207,15 @@
''' </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
@@ -212,15 +223,17 @@
''' 继续音乐播放,返回是否成功切换了状态。
''' </summary>
Public Function MusicResume() As Boolean
If MusicState = MusicStates.Pause Then
RunInThread(Sub()
MusicNAudio.Play()
MusicRefreshUI()
Log("[Music] 已恢复播放")
End Sub)
Return True
Else
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Log($"[Music] 无需继续播放,当前状态为 {MusicState}")
Return False
Else
RunInThread(
Sub()
Log("[Music] 已恢复播放")
MusicNAudio?.Play()
MusicRefreshUI()
End Sub)
Return True
End If
End Function
@@ -265,19 +278,25 @@
Thread.Sleep(100)
End While
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Thread.Sleep(1000000000)
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
Log(ex, "播放音乐失败(" & MusicCurrent & ")", LogLevel.Developer)
If MusicAllList.Count > 1 Then
Thread.Sleep(1000)
MusicStartPlay(DequeueNextMusicAddress)
Thread.Sleep(1000)
If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If
Finally
If CurrentWave IsNot Nothing Then CurrentWave.Dispose()
+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"
'用于微软登录的 ClientId
Public Const OAuthClientId As String = ""
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 调用:需要你自行申请 API Key,然后添加到 SecretHeadersSign 方法中
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
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)
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 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.open.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 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.open.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
@@ -25,7 +25,7 @@ Public Class CookieWebClient
''' </summary>
Public Timeout As Integer = 600000
Protected Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest
Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
Dim r As WebRequest = MyBase.GetWebRequest(address)
Dim request = TryCast(r, HttpWebRequest)
@@ -37,19 +37,19 @@ Public Class CookieWebClient
Return r
End Function
Protected Overrides Function GetWebResponse(ByVal request As WebRequest, ByVal result As IAsyncResult) As WebResponse
Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request, result)
ReadCookies(response)
Return response
End Function
Protected Overrides Function GetWebResponse(ByVal request As WebRequest) As WebResponse
Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request)
ReadCookies(response)
Return response
End Function
Private Sub ReadCookies(ByVal r As WebResponse)
Private Sub ReadCookies(r As WebResponse)
Dim response = TryCast(r, HttpWebResponse)
If response IsNot Nothing Then
Dim cookies As CookieCollection = response.Cookies
@@ -8,11 +8,11 @@ Imports System.Runtime.InteropServices
'查看程序集特性的值
<Assembly: AssemblyTitle("Plain Craft Launcher 2 启动器")>
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
<Assembly: AssemblyDescription("Minecraft 启动器 (制作:龙腾猫跃)")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher 2")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2023. All Rights Reserved.")>
<Assembly: AssemblyProduct("Plain Craft Launcher")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.3.0")>
<Assembly: AssemblyFileVersion("2.6.3.0")>
<Assembly: AssemblyVersion("2.8.4.0")>
<Assembly: AssemblyFileVersion("2.8.4.0")>
<Assembly: NeutralResourcesLanguage("")>
File diff suppressed because it is too large. Load diff
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
@@ -39,10 +39,16 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -55,9 +61,8 @@
Next
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean
Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date)
End Function)
Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next
'清空当前
PanMain.Children.Clear()
@@ -65,11 +70,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -78,7 +83,7 @@
PanMain.Children.Add(CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -88,7 +93,7 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
<Grid.RowDefinitions>
@@ -16,7 +16,6 @@
<StackPanel Orientation="Horizontal" Height="35">
<local:MyButton x:Name="BtnIntroWeb" MinWidth="140" Text="转到 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="转到 MC 百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="转到 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroCopy" MinWidth="140" Text="复制名称" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</StackPanel>
</StackPanel>
@@ -1,6 +1,5 @@
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
Private Project As CompProject
#Region "加载器"
@@ -9,9 +8,19 @@
'初始化加载器信息
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Project = FrmMain.PageCurrent.Additional
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Sub PageDownloadCompDetail_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
'Initialized 只会执行一次
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State
@@ -39,23 +48,8 @@
End Sub
End Class
Private Sub Load_OnFinish()
'获取目标版本与 Mod 加载器
Dim TargetVersion As String = ""
Select Case Project.Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
Dim TargetLoader = CompModLoaderType.Any
If Project.Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
End If
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"目标版本:{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
$"所选版本:{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
'初始化字典
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName))
Dict.Add("未知版本", New List(Of CompFile))
@@ -67,10 +61,10 @@
TargetCard = "未知版本"
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
TargetCard = "快照版本"
ElseIf GameVersion.Split(".").Count >= 2 Then
TargetCard = GameVersion
ElseIf GameVersion.StartsWith("1.0") Then
TargetCard = "远古版本"
Else
TargetCard = "未知版本"
TargetCard = GameVersion
End If
'实际进行添加
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
@@ -94,7 +88,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
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}
@@ -102,7 +96,9 @@
NewCard.SwapControl = NewStack
PanMain.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TargetCardName Then
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
Else
NewCard.IsSwaped = True
@@ -128,7 +124,7 @@
Private IsFirstInit As Boolean = True
Public Sub Init() Handles Me.PageEnter
AniControlEnabled += 1
Project = FrmMain.PageCurrent.Additional
Project = FrmMain.PageCurrent.Additional(0)
PanBack.ScrollToHome()
'重启加载器
@@ -142,13 +138,13 @@
'放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem)
'决定按钮显示
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
BtnIntroMCBBS.Visibility = If(Project.MCBBS = 0, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
End Sub
@@ -174,24 +170,25 @@
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
Sub()
If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = 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()
@@ -201,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
@@ -214,11 +211,11 @@
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Count > 0 Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
ElseIf Project.ModLoaders.Any Then '从工程中获取
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
@@ -234,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
@@ -256,7 +253,7 @@
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If SuitableVersions.Count = 0 Then
If Not SuitableVersions.Any() Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
@@ -264,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 & ")")
@@ -279,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
@@ -303,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})
@@ -326,9 +324,6 @@
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub
Private Sub BtnIntroMCBBS_Click(sender As Object, e As EventArgs) Handles BtnIntroMCBBS.Click
OpenWebsite("https://www.mcbbs.net/thread-" & Project.MCBBS & "-1-1.html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CompItem.LabTitle.Text)
End Sub
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadFabric"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadFabric"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Fabric 简介" x:Name="CardTip">
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadForge"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Forge 简介" x:Name="CardTip">
@@ -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")
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadInstall"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadInstall"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,10,25,25">
@@ -21,12 +21,13 @@
<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*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<local:MyListItem Grid.Column="0" x:Name="ItemSelect" IsHitTestVisible="False" Margin="-7,0,0,0" Height="42" PaddingRight="15" SnapsToDevicePixels="True" Type="None" />
<local:MyListItem Grid.Column="0" x:Name="ItemSelect" IsHitTestVisible="False" Margin="-7,0,0,0" Height="42" SnapsToDevicePixels="True" Type="None" />
<local:MyButton Grid.Column="1" HorizontalAlignment="Right" ColorType="Highlight" Text="开始安装" Margin="0,2,0,0" x:Name="BtnSelectStart" MinWidth="140" Padding="13,0" Height="35" VerticalAlignment="Center" />
</Grid>
<Grid Margin="0,0,0,5">
@@ -61,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">
@@ -99,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">
@@ -135,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">
@@ -178,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,13 +27,14 @@
LoadLiteLoader.State = DlLiteLoaderListLoader
LoadFabric.State = DlFabricListLoader
LoadFabricApi.State = DlFabricApiLoader
LoadNeoForge.State = DlNeoForgeListLoader
LoadOptiFabric.State = DlOptiFabricLoader
End Sub
#Region "页面切换"
'页面切换动画
Private IsInSelectPage As Boolean = False
Public IsInSelectPage As Boolean = False
Private IsFirstLoaded As Boolean = False
Private Sub EnterSelectPage()
If IsInSelectPage Then Exit 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)
@@ -273,11 +300,13 @@
End If
End Sub
Private IsReloading As Boolean = False '#3742 中,LoadOptiFineGetError 会初始化 LoadOptiFine,触发事件 LoadOptiFine.StateChanged,导致再次调用 SelectReload
''' <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
If SelectedMinecraftId Is Nothing Then Exit Sub
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
'主预览
SelectNameUpdate()
ItemSelect.Title = TextSelectName.Text
@@ -303,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()
@@ -331,59 +365,99 @@
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
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
@@ -396,6 +470,14 @@
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
End Sub
''' <summary>
''' 清空已选择的项目。
@@ -407,6 +489,7 @@
SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing
SelectedForge = Nothing
SelectedNeoForge = Nothing
SelectedFabric = Nothing
SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing
@@ -422,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"
@@ -441,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"
@@ -460,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
@@ -523,10 +614,16 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -549,11 +646,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 15, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -562,7 +659,7 @@
PanMinecraft.Children.Insert(0, CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
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 = 7}
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}
@@ -597,7 +694,8 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFineGetError() As String
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
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:全部不兼容
If SelectedForge IsNot Nothing AndAlso
@@ -632,10 +730,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
'限制展开
@@ -656,13 +756,14 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
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
@@ -679,6 +780,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
@@ -688,6 +790,7 @@
CardOptiFine.IsSwaped = True
e.Handled = True
Forge_Loaded()
NeoForge_Loaded()
SelectReload()
End Sub
@@ -700,7 +803,7 @@
''' </summary>
Private Function LoadLiteLoaderGetError() As String
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "没有可用版本"
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadLiteLoader.State, Object).Error.Message
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Return Nothing
@@ -724,7 +827,7 @@
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanLiteLoader.Children.Clear()
For Each Version In Versions
@@ -773,6 +876,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
@@ -802,16 +906,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 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub
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))
@@ -839,18 +942,79 @@
#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>
''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadFabricGetError() As String
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message
For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite") Then
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
Return Nothing
End If
Next
@@ -870,7 +1034,7 @@
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
'获取版本列表
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader")
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanFabric.Children.Clear()
PanFabric.Tag = Versions
@@ -908,16 +1072,16 @@
Public Shared Function IsSuitableFabricApi(DisplayName As String, MinecraftVersion As String) As Boolean
Try
If DisplayName Is Nothing OrElse MinecraftVersion Is Nothing Then Return False
DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.ToLower
DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").ToLower
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a)
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
@@ -945,11 +1109,16 @@
''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadFabricApiGetError() As String
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabricApi.State, Object).Error.Message
If DlFabricApiLoader.Output Is Nothing Then
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return "正在获取版本列表……"
End If
For Each Version In DlFabricApiLoader.Output
If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Return Nothing
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return Nothing
Next
Return "没有可用版本"
End Function
@@ -978,7 +1147,7 @@
Versions.Add(Version)
End If
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
PanFabricApi.Children.Clear()
@@ -1032,14 +1201,21 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return "正在获取版本列表……"
End If
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Return Nothing
If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135#
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return Nothing '通过检查
Next
Return "没有可用版本"
End Function
@@ -1061,7 +1237,7 @@
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
@@ -1071,7 +1247,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)
@@ -1103,7 +1280,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 &
@@ -1114,10 +1291,12 @@
'提交安装申请
Dim Request As New McInstallRequest With {
.TargetVersionName = TextSelectName.Text,
.TargetVersionFolder = $"{PathMcFolder}versions\{TextSelectName.Text}\",
.MinecraftJson = SelectedMinecraftJsonUrl,
.MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine,
.ForgeEntry = SelectedForge,
.NeoForgeEntry = SelectedNeoForge,
.FabricVersion = SelectedFabric,
.FabricApi = SelectedFabricApi,
.OptiFabric = SelectedOptiFabric,
@@ -5,7 +5,7 @@
<StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
@@ -13,10 +13,10 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
LogoScale="1.02" Logo="M292.693 787.627c0 30.72-24.746 55.466-55.466 55.466s-55.467-24.746-55.467-55.466 24.747-55.467 55.467-55.467c30.72-0.853 55.466 24.747 55.466 55.467z M1000.96 241.493c-2.56-5.973-4.267-11.946-6.827-17.92-0.853-6.826-4.266-12.8-8.533-17.92-7.68-9.386-18.773-15.36-31.573-15.36-6.827 0-13.654 1.707-19.627 5.12l-15.36 15.36-17.067 17.067-21.333 21.333L749.227 381.44c-14.507 14.507-38.4 14.507-52.907 0l-54.613-54.613c-14.507-14.507-14.507-38.4 0-52.907l132.266-132.267 14.507-14.506 20.48-20.48 16.213-16.214c3.414-5.973 5.12-11.946 5.12-19.626 0-12.8-5.973-24.747-16.213-32.427-5.973-4.267-11.947-6.827-18.773-7.68-5.12-2.56-10.24-4.267-16.214-5.973-36.693-12.8-76.8-19.627-117.76-19.627-7.68 0-14.506 0-22.186 0.853-188.587 11.947-337.92 168.107-337.92 360.96 0 16.214 0.853 32.427 3.413 48.64L56.32 663.04c-73.387 74.24-73.387 193.707 0 267.093l33.28 33.28c73.387 73.387 193.707 73.387 267.093 0l240.64-241.493c21.334 4.267 42.667 5.973 64 5.973 190.294 0 346.454-146.773 360.107-333.653 0.853-8.533 0.853-17.92 0.853-27.307 0.854-44.373-6.826-86.186-21.333-125.44zM658.773 639.147c-28.16 0-54.613-4.267-79.36-11.094-4.266 7.68-10.24 14.507-16.213 21.334l-258.56 258.56c-43.52 43.52-115.2 43.52-158.72 0l-29.013-29.014c-43.52-44.373-43.52-115.2 0-158.72l212.48-212.48 46.08-46.08c5.973-5.973 12.8-11.093 19.626-15.36-8.533-26.453-12.8-54.613-12.8-83.626v-1.707c0-152.747 123.734-275.627 276.48-275.627 18.774 0 37.547 1.707 55.467 5.974L597.333 207.36c-52.053 52.053-52.053 137.387 0 189.44l29.867 29.867c52.053 52.053 137.387 52.053 189.44 0L930.987 312.32c2.56 16.213 4.266 33.28 4.266 50.347 0 152.746-123.733 276.48-276.48 276.48z" />
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
LogoScale="0.98" Logo="M989.7 510.8l-202.3-101c-10.8-5.4-17.7-16.5-17.7-28.6V172.7c0-26.7-16.6-50.6-41.6-59.9L550.5 46.3c-24.2-9-50.8-9-74.9 0.1l-176.9 66.8c-24.9 9.4-41.4 33.2-41.4 59.9v207.1c0 12.1-6.9 23.2-17.7 28.6l-204 101.9C13.9 521.6 0.1 543.8 0.2 568.1l0.5 226c0 23.2 12.6 44.5 32.9 55.8l223.8 124.6 1.2 0.7c18.9 10.5 41.9 10.4 60.8-0.2l2-1.1L497 873.2c9.9-5.7 22.1-5.6 32 0.1l176.7 102.5c18.9 10.7 42 10.8 61 0.3l3-1.7L992.4 851c20.4-11.3 33-32.8 33-56l-0.3-226.9c0-24.3-13.7-46.5-35.4-57.3zM321 192l115.3 46.1c27 10.8 44.7 36.9 44.7 66v163c0 5.9-6.2 9.8-11.6 7.2L339 409.5c-10.9-5.4-17.7-16.5-17.8-28.6L321 192z m-63.7 703.4L82.5 809.6c-10.9-5.4-17.9-16.5-17.9-28.7l-0.4-189.5L217.9 668c24.1 12 39.4 36.7 39.4 63.6v163.8z m64-274.3c-20.1 10.1-43.7 10-63.8 0l-0.2-0.1-149.1-75 149.1-74.4 16.8-8.4c9.2-4.6 20-4.5 29.1 0.3l18.1 9.4 129.8 64.3c5.8 2.9 6 11.1 0.2 14.2l-130 69.7z m141.9 203.8l-141.8 70.6-0.8-163.6c-0.1-27 15.1-51.8 39.2-63.9l108.8-54.5c5.3-2.7 11.6 1.2 11.6 7.1l0.8 175.6c0 12.1-6.9 23.2-17.8 28.7zM385 144l128-48 128 48-103 38.6c-16.1 6-33.8 6-49.9 0L385 144z m320 48l0.6 187.8c0 12.2-6.8 23.3-17.7 28.7l-131.4 65.7c-5.3 2.7-11.6-1.2-11.6-7.2V304.1c0-29.1 17.7-55.2 44.7-66L705 192z m0.7 710.3l-143.8-77.2c-10.4-5.6-16.9-16.4-16.9-28.2v-176c0-5.9 6.3-9.8 11.6-7.2l109.3 54.6c24 12 39.2 36.5 39.3 63.4l0.5 170.6z m-2-280.5l-129.2-70.5c-5.7-3.1-5.5-11.3 0.3-14.2l131-65.3 16.1-8.5c9.1-4.8 19.9-4.9 29.1-0.3l18.7 9.3L916.9 546l-146.2 76.4c-21.1 11-46.2 10.8-67-0.6z m66 279.4l-0.6-169.1c-0.1-27 15.1-51.7 39.3-63.8L961 592v188.7c0 11.9-6.6 22.7-17 28.3l-174.3 92.2z">
<!--Logo="M469.333333 213.333333V128a42.666667 42.666667 0 1 1 85.333334 0v85.333333h127.829333C847.722667 213.333333 981.333333 347.029333 981.333333 512.149333v319.936A106.496 106.496 0 0 1 874.730667 938.666667h-85.461334c-48.661333 0-107.221333-29.290667-136.469333-68.266667l-64-85.333333c-6.144-8.170667-23.957333-17.066667-34.24-17.066667h-85.12c-10.282667 0-28.096 8.896-34.24 17.066667l-64 85.333333c-29.226667 38.976-87.808 68.266667-136.469333 68.266667H149.269333A106.496 106.496 0 0 1 42.666667 832.085333V512.149333C42.666667 347.029333 176.277333 213.333333 341.504 213.333333H469.333333z m213.162667 85.333334H341.504A213.333333 213.333333 0 0 0 128 512.149333v319.936c0 11.818667 9.450667 21.248 21.269333 21.248h85.461334c21.802667 0 55.082667-16.64 68.202666-34.133333l64-85.333333c22.272-29.696 65.408-51.2 102.506667-51.2h85.12c37.098667 0 80.213333 21.504 102.506667 51.2l64 85.333333c13.12 17.493333 46.4 34.133333 68.202666 34.133333h85.461334a21.162667 21.162667 0 0 0 21.269333-21.248V512.149333A213.333333 213.333333 0 0 0 682.496 298.666667zM362.666667 469.333333h42.666666a42.666667 42.666667 0 1 1 0 85.333334h-42.666666v42.666666a42.666667 42.666667 0 1 1-85.333334 0v-42.666666h-42.666666a42.666667 42.666667 0 1 1 0-85.333334h42.666666v-42.666666a42.666667 42.666667 0 1 1 85.333334 0v42.666666z m341.333333-21.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m0 213.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m-106.666667-106.666666a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z m213.333334 0a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z">-->
<local:MyListItem.Buttons>
@@ -25,7 +25,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine"
<local:MyListItem x:Name="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine"
LogoScale="1.00" Logo="M439.667 538.133l-323.311-174.763c-6.554-3.641-13.836-5.098-20.389-5.098-23.301 0-45.147 20.389-45.147 48.788v341.516c0 35.681 18.205 67.721 48.060 83.741l323.311 174.763c6.554 3.641 13.836 5.825 20.389 5.825 23.301 0 45.147-21.117 45.147-49.516v-341.516c0-34.953-18.205-67.721-48.060-83.741zM414.909 920.427l-281.805-152.189c-4.369-2.913-9.467-9.467-9.467-19.661v-298.553l281.805 152.189c5.825 3.641 9.467 11.651 9.467 19.661v298.553zM952.304 358.274c-6.554 0-13.836 1.456-20.389 5.098l-323.311 175.491c-29.855 16.020-48.060 48.788-48.060 84.468v340.059c0 28.399 21.845 49.516 45.147 49.516 6.554 0 13.836-1.456 20.389-5.098l323.311-175.491c29.127-16.020 48.060-48.060 48.060-83.741v-341.516c0-28.399-21.845-48.788-45.147-48.788zM924.634 747.849c0 10.194-5.098 17.476-9.467 19.661l-281.805 152.917v-297.097c0-10.194 5.098-17.476 9.467-19.661l281.805-153.646v297.825zM902.060 283.272c15.292-8.010 22.574-21.845 21.117-34.953 1.456-13.836-5.825-26.943-21.117-34.953l-329.136-171.85c-14.563-8.010-31.312-11.651-48.788-11.651 0 0 0 0 0 0 0 0 0 0 0 0s-34.224 3.641-49.516 11.651l-329.865 171.122c-15.292 8.010-21.845 21.845-21.117 35.681-0.729 13.107 5.825 26.943 21.117 34.953l329.136 171.122c14.563 8.010 32.039 11.651 49.516 11.651 0 0 0 0 0.729 0 0 0 0 0 0.729 0s34.224-3.641 49.516-11.651l327.68-171.122zM523.407 393.227c-5.825 0-11.651-1.456-16.020-3.641l-272.338-141.266 272.338-141.995c4.369-2.185 10.194-3.641 16.748-3.641 5.825 0 11.651 1.456 16.020 3.641l272.338 141.995-273.067 141.266c-3.641 2.185-9.467 3.641-16.020 3.641z">
<!--Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z">-->
<local:MyListItem.Buttons>
@@ -34,7 +34,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge"
<local:MyListItem x:Name="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge"
LogoScale="1.00" Logo="M402.807089 481.189274c-12.040221-6.991228-27.412326-2.797719-34.397415 9.242502l-8.387018 14.512529c-6.987135 12.035104-2.793626 27.40721 9.246595 34.392298 12.040221 6.985088 27.408233 2.797719 34.393321-9.242502l8.387018-14.511505C418.930301 503.437997 414.842193 488.063845 402.807089 481.189274L402.807089 481.189274zM495.028467 919.955342 59.056024 919.955342c-18.485003 0-33.532721 15.046694-33.532721 33.536814 0 18.485003 15.046694 33.532721 33.532721 33.532721l435.972443 0c18.49012 0 33.537837-15.046694 33.537837-33.532721C528.566304 935.002037 513.518586 919.955342 495.028467 919.955342L495.028467 919.955342zM997.431901 660.155295 590.482469 446.039729l90.935082-157.474544c18.485003-32.031531 7.520277-73.090669-24.51023-91.581812L395.496589 46.070268c-32.031531-18.485003-73.094762-7.520277-91.579765 24.51023L18.74697 564.277644c-18.485003 32.031531-7.521301 73.089645 24.51023 91.579765l261.408685 150.907988c32.031531 18.491143 73.095785 7.526417 91.581812-24.505114l91.364871-158.330028 392.332527 239.48128c16.016789 9.247618 36.544311 3.76372 45.792952-12.249999l83.838454-145.219429C1019.033895 689.930435 1013.444597 669.39882 997.431901 660.155295L997.431901 660.155295zM355.078041 719.704552c-9.242502 16.012695-29.774117 21.497617-45.787836 12.251022L105.923448 614.57826c-16.016789-9.242502-21.497617-29.774117-12.255115-45.787836l251.522524-435.653171c9.246595-16.012695 29.774117-21.497617 45.792952-12.249999l203.25624 117.376291c16.018835 9.242502 21.497617 29.774117 12.255115 45.786813L355.078041 719.704552 355.078041 719.704552zM884.568391 788.601712 522.115382 564.492538l33.537837-58.048067L934.875147 701.539844 884.568391 788.601712 884.568391 788.601712zM520.184403 277.8174c-12.040221-6.987135-27.41335-2.792603-34.399461 9.246595l-75.456552 130.702807c-6.985088 12.040221-2.791579 27.412326 9.242502 34.397415 12.040221 6.987135 27.412326 2.791579 34.397415-9.242502l75.458599-130.706901C536.307615 300.174594 532.219507 284.807604 520.184403 277.8174L520.184403 277.8174zM520.184403 277.8174">
<!--Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">-->
<local:MyListItem.Buttons>
@@ -43,39 +43,47 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
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" PaddingRight="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" PaddingRight="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" PaddingRight="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)
@@ -99,11 +105,13 @@
Case FormMain.PageSubType.DownloadMod
PageDownloadMod.Storage = New CompProjectStorage
PageDownloadMod.Page = 0
CompProjectCache.Clear()
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
PageDownloadPack.Page = 0
CompProjectCache.Clear()
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
@@ -115,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
@@ -152,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
@@ -168,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
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="LiteLoader 简介" x:Name="CardTip">
@@ -28,7 +28,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -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
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索 Mod" Margin="0,0,0,15" x:Name="PanAlways">
@@ -33,19 +33,21 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -54,6 +56,7 @@
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320">
@@ -96,6 +99,7 @@
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
@@ -32,9 +32,7 @@
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing,
Loader.Input.ModLoader = CompModLoaderType.Any, AddressOf ProjectClick))
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader = CompModLoaderType.Any))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -42,12 +40,21 @@
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
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -68,12 +75,6 @@
End Select
End Sub
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
@@ -90,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 "搜索"
@@ -114,13 +116,18 @@
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
'版本选择
Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged
'#3067:当下拉菜单展开时,程序会被 WPF 挂起,因而无法更新 Grid 布局,所以必须延迟到下拉菜单收起后才能更新
Private Sub TextSearchVersion_TextChanged() Handles TextSearchVersion.TextChanged
If Not TextSearchVersion.IsDropDownOpen Then UpdateSearchLoaderVisibility()
End Sub
Private Sub UpdateSearchLoaderVisibility() Handles TextSearchVersion.DropDownClosed
If TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w") Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
@@ -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
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadOptiFine"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadOptiFine"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip">
@@ -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
@@ -32,7 +32,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -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
@@ -1,9 +1,9 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
d:DesignWidth="778.571" d:DesignHeight="90.857">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索整合包" Margin="0,0,0,15" x:Name="PanAlways">
@@ -32,19 +32,21 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -59,7 +61,7 @@
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
@@ -86,6 +88,7 @@
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
@@ -31,8 +31,7 @@
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True, AddressOf ProjectClick))
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -40,12 +39,21 @@
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
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -66,12 +74,6 @@
End Select
End Sub
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
@@ -116,6 +118,7 @@
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
@@ -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
@@ -5,7 +5,7 @@
'皮肤储存
Private _Address As String
Public Property Address() As String
Public Property Address As String
Get
Return _Address
End Get
@@ -76,12 +76,19 @@
''' </summary>
Public Sub Load()
Try
Address = Loader.Output
'检查文件存在
If Address = "" Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
Address = Loader.Output
If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
If Not Address.StartsWith(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
'加载
Dim Image As New MyBitmap(Address)
Dim Image As MyBitmap
Try
Image = New MyBitmap(Address)
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏:{Address}", LogLevel.Hint)
File.Delete(Address)
Exit Sub
End Try
ImgBack.Tag = Address
'大小检查
Dim Scale As Integer = Image.Pic.Width / 64
@@ -97,7 +104,7 @@
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso '或是头部颜色和透明区均不一样
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2) <> Image.Pic.GetPixel(Scale * 41, Scale * 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 40, Scale * 8, Scale * 8, Scale * 8))
ImgFore.Source = Image.Clip(Scale * 40, Scale * 8, Scale * 8, Scale * 8)
Else
ImgFore.Source = Nothing
End If
@@ -105,7 +112,7 @@
ImgFore.Source = Nothing
End If
'脸层
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 8, Scale * 8, Scale * 8, Scale * 8))
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功:" & Loader.Name)
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", LogLevel.Hint)
@@ -138,26 +145,27 @@
'由于 Abort 不是实时的,暂时不会释放文件,会导致删除报错,故只能取消执行
Hint("有正在获取中的皮肤,请稍后再试!", HintType.Info)
Else
RunInThread(Sub()
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
IniClearCache(PathTemp & "Cache\Uuid\Mojang.ini")
'刷新控件
For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs})
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
Hint("已刷新头像!", HintType.Finish)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
IniClearCache(PathTemp & "Cache\Uuid\Mojang.ini")
'刷新控件
For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs})
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
Hint("已刷新头像!", HintType.Finish)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
End Try
End Sub)
End If
End Sub
''' <summary>
@@ -165,21 +173,22 @@
''' </summary>
''' <param name="SkinAddress">新的正版皮肤完整地址。</param>
Public Shared Sub ReloadCache(SkinAddress As String)
RunInThread(Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress))
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
'完成提示
Hint("更改皮肤成功!", HintType.Finish)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
End Try
End Sub)
RunInThread(
Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress))
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
Next
'完成提示
Hint("更改皮肤成功!", HintType.Finish)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
End Try
End Sub)
End Sub
'披风
@@ -209,57 +218,61 @@
Hint("正在获取披风列表,请稍候……")
IsChanging = True
'开始实际获取
RunInNewThread(Sub()
Try
RunInNewThread(
Sub()
Try
Retry:
'获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风
Dim SelId As Integer? = Nothing
RunInUiWait(Sub()
Try
Dim CapeNames As New Dictionary(Of String, String) From {
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"},
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
SelectionControl.Add(New MyRadioBox With {.Text = CapeName})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Exit Sub
'发送请求
Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, "DELETE", "PUT"),
If(SelId = 0, "", "{""capeId"": """ & SkinData("capes")(SelId - 1)("id").ToString & """}"),
"application/json", Headers:=New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage"), HintType.Critical)
Exit Sub
Else
Hint("更改披风成功!", HintType.Finish)
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
Finally
IsChanging = False
End Try
End Sub, "Cape Change")
'获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风
Dim SelId As Integer? = Nothing
RunInUiWait(
Sub()
Try
Dim CapeNames As New Dictionary(Of String, String) From {
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"},
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
SelectionControl.Add(New MyRadioBox With {.Text = CapeName})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Exit Sub
'发送请求
Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, "DELETE", "PUT"),
If(SelId = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelId - 1)("id"))).ToString(0)),
"application/json", Headers:=New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage"), HintType.Critical)
Exit Sub
Else
Hint("更改披风成功!", HintType.Finish)
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
Finally
IsChanging = False
End Try
End Sub, "Cape Change")
End Sub
End Class
@@ -33,7 +33,7 @@
<Path Name="PathTypeOne" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center"
Data="">
<Path.RenderTransform>
<ScaleTransform ScaleX="1.2" ScaleY="1.2" />
<ScaleTransform ScaleX="1.05" ScaleY="1.05" />
</Path.RenderTransform>
</Path>
<TextBlock Name="LabTypeOne" Text="" FontSize="14" VerticalAlignment="Center" Grid.Column="1" Foreground="{DynamicResource ColorBrush3}" Margin="15,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
@@ -19,51 +19,84 @@
RefreshButtonsUI()
'加载版本
RunInNewThread(Sub()
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'确认 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
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & 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 McVersionList.Count = 0 OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
End If
End If
RunInUi(Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
RunInNewThread(
Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
'确认自动安装
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Setup.Set("LaunchFolderSelect", "$.minecraft\")
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If
End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Dim InstallLoader = ModpackInstall(PackInstallPath)
If InstallLoader Is Nothing Then
Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
Else
Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
End If
End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
'无效的版本
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
End If
End If
RunInUi(
Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面
Dim LoginType As McLoginType = Setup.Get("LoginType")
@@ -79,7 +112,45 @@
''' 切换至启动中页面。
''' </summary>
Public Sub PageChangeToLaunching()
LaunchingPreload()
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
Case McLoginType.Ms
LabLaunchingMethod.Text = "正版登录"
Case McLoginType.Nide
LabLaunchingMethod.Text = "统一通行证"
Case McLoginType.Auth
LabLaunchingMethod.Text = "Authlib-Injector"
End Select
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Opacity = 0.6
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownload.Text = "0 B/s"
LabLaunchingDownload.Opacity = 0
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Opacity = 0
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
ProgressLaunchingFinished.Width = New GridLength(0, GridUnitType.Star)
ProgressLaunchingUnfinished.Width = New GridLength(1, GridUnitType.Star)
PanLaunchingHint.Opacity = 0
PanLaunchingHint.Visibility = Visibility.Collapsed
PanLaunchingInfo.Width = Double.NaN '重置宽度改变动画
McLaunchProcess = Nothing
McLaunchWatcher = Nothing
'获取 “你知道吗” 提示
LabLaunchingHint.Text = PageOtherTest.GetRandomHint()
'初始化其他页面
PanInput.IsHitTestVisible = False
PanLaunching.IsHitTestVisible = False
LoadLaunching.State.LoadingState = MyLoading.MyLoadingState.Run
@@ -248,7 +319,7 @@ UnknownType:
Setup.Set("LoginType", McLoginType.Ms)
PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonMs)
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonShield)
LabTypeOne.Text = "正版登录"
RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Collapsed
@@ -257,7 +328,7 @@ UnknownType:
Setup.Set("LoginType", McLoginType.Legacy)
PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonUser)
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
LabTypeOne.Text = "离线登录"
Case 3 '统一通行证
If Setup.Get("CacheNideAccess") = "" Then
@@ -360,7 +431,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")}
@@ -531,7 +602,8 @@ Finish:
End Sub
'启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled OrElse FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentStay Then Exit Sub
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled OrElse
(FrmMain.PageRight IsNot Nothing AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentStay AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentEnter) Then Exit Sub
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!")
@@ -578,7 +650,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候"
FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
@@ -633,55 +705,6 @@ ExitRefresh:
PageVersionLeft.Version = McVersionCurrent
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
End Sub
'刷新 UI
Public Sub LaunchingPreload()
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
Case McLoginType.Ms
LabLaunchingMethod.Text = "正版登录"
Case McLoginType.Nide
LabLaunchingMethod.Text = "统一通行证"
Case McLoginType.Auth
LabLaunchingMethod.Text = "Authlib-Injector"
End Select
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Opacity = 0.6
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownload.Text = "0 B/s"
LabLaunchingDownload.Opacity = 0
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Opacity = 0
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
ProgressLaunchingFinished.Width = New GridLength(0, GridUnitType.Star)
ProgressLaunchingUnfinished.Width = New GridLength(1, GridUnitType.Star)
PanLaunchingHint.Opacity = 0
PanLaunchingHint.Visibility = Visibility.Collapsed
PanLaunchingInfo.Width = Double.NaN '重置宽度改变动画
McLaunchProcess = Nothing
McLaunchWatcher = Nothing
'获取 “你知道吗” 提示
Dim Hint As String = PageOtherTest.GetRandomHint()
Try
Dim RawHints = ReadFile(Path & "PCL\hints.txt").Split(vbCrLf.ToCharArray).Where(Function(s) Not String.IsNullOrWhiteSpace(s)).ToList
If RawHints.Count > 0 Then Hint = RandomOne(RawHints)
Catch ex As Exception
Log(ex, "获取自定义 你知道吗 提示失败", LogLevel.Hint)
End Try
LabLaunchingHint.Text = Hint
End Sub
Private ShowProgress As Double = 0
''' <summary>
''' 每 0.2s 执行一次,刷新启动的数据 UI 显示。
''' </summary>
@@ -765,6 +788,7 @@ ExitRefresh:
Log(ex, "刷新启动信息失败", LogLevel.Feedback)
End Try
End Sub
Private ShowProgress As Double = 0
'尺寸改变动画
Private IsWidthAnimating As Boolean = False
Private ActualUsedWidth As Double
@@ -1,18 +1,20 @@
<local:MyPageRight x:Class="PageLaunchRight"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"> <!-- 不知道为啥只有这个文件不能在 XAML 设置 PanScroll -->
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<StackPanel x:Name="PanCustom">
</StackPanel>
<local:MyCard Margin="0,0,0,15" Title="快照版提示" x:Name="PanHint">
<StackPanel Margin="25,40,23,12">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" />
<TextBlock x:Name="LabHint2" TextWrapping="Wrap" Margin="0,0,0,2" />
<local:MyIconButton LogoScale="1.1" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z"
Height="20" Margin="10" HorizontalAlignment="Right" VerticalAlignment="Top"
x:Name="BtnHintClose" />
<StackPanel Margin="25,38,23,15">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
<TextBlock x:Name="LabHint2" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="启动日志" x:Name="PanLog">
@@ -2,101 +2,226 @@
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
PanScroll = PanBack '不知道为啥不能在 XAML 设置
PanLog.Visibility = If(ModeDebug, Visibility.Visible, Visibility.Collapsed)
'刷新主页
If ShouldRefresh Then
ShouldRefresh = False
RefreshCustom()
End If
'快照版提示
#If BETA Then
PanHint.Visibility = Visibility.Collapsed
#Else
PanHint.Title = "快照版提示"
PanHint.Visibility = If(ThemeCheckGold(), Visibility.Collapsed, Visibility.Visible)
LabHint1.Text = "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!如果发现了 Bug,可以在 更多 → 反馈 中提交!"
LabHint2.Text = "你可以通过赞助¥23.33 档位换取解锁码来隐藏这个提示。"
LabHint1.Text = "快照版包含尚未正式发布的测试功能,仅用于赞助者本人尝鲜。请不要发给其他人或者用来制作整合包哦!"
LabHint2.Text = $"若已累积赞助¥23.33,在爱发电私信发送 {vbLQ}解锁码{vbRQ} 即可永久隐藏此提示。"
#End If
End Sub
Private LatestFileContent As String = ""
Private LatestFileLink As String = Nothing
Private IsRefreshing As Boolean = False
Public ShouldRefresh As Boolean = True
'暂时关闭快照版提示
#If Not BETA Then
Private Sub BtnHintClose_Click(sender As Object, e As EventArgs) Handles BtnHintClose.Click
AniDispose(PanHint, True)
End Sub
#End If
#Region "自定义主页"
''' <summary>
''' 刷新自定义的主页。返回是否成功。
''' 刷新自定义主页。
''' </summary>
Private Sub RefreshCustom()
If IsRefreshing Then
ShouldRefresh = True
Exit Sub
End If
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(
Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub
Private Sub RefreshReal()
Dim Content As String = ""
Dim Url As String
Select Case Setup.Get("UiCustomType")
Case 1
'加载本地文件
Log("[Page] 主页自定义数据来源:本地文件")
Content = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Case 2
Url = Setup.Get("UiCustomNet")
Download:
'加载联网文件
If String.IsNullOrWhiteSpace(Url) Then Exit Select
If Url = Setup.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then
'缓存可用
Log("[Page] 主页自定义数据来源:联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml")
'后台更新缓存
OnlineLoader.Start(Url)
Else
'缓存不可用
Log("[Page] 主页自定义数据来源:联网全新下载")
Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent("")) '在加载结束前清空页面
Setup.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(Url) '下载完成后将会再次触发更新
Exit Sub
End If
Case 3
Select Case Setup.Get("UiCustomPreset")
Case 0
Log("[Page] 主页预设:你知道吗")
Content = "
<local:MyCard Title=""你知道吗?"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{hint}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
<local:MyIconButton Height=""22"" Width=""22"" Margin=""9"" VerticalAlignment=""Top"" HorizontalAlignment=""Right""
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 1
Log("[Page] 主页预设:回声洞")
Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{cave}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
<local:MyIconButton Height=""22"" Width=""22"" Margin=""9"" VerticalAlignment=""Top"" HorizontalAlignment=""Right""
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 2
Log("[Page] 主页预设:Minecraft 新闻")
Url = "http://pcl.mcnews.thestack.top"
GoTo Download
Case 3
Log("[Page] 主页预设:简单主页")
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4
Log("[Page] 主页预设:每日整合包推荐")
Url = "https://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))
End Sub
Private RefreshLock As New Object
'联网获取自定义主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化
Try
IsRefreshing = True
PanCustom.Children.Clear()
RunInNewThread(Sub()
Dim FileContent As String = ""
Select Case Setup.Get("UiCustomType")
Case 0
'啥也不干
Case 1
'加载本地文件
FileContent = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Log("[System] 尝试从本地文件读取主页自定义数据(" & FileContent.Length & ")")
Case 2
'加载联网文件
Try
Dim Link As String = Setup.Get("UiCustomNet")
If Link = LatestFileLink Then
FileContent = LatestFileContent
Log("[System] 尝试缓存加载主页自定义数据(" & FileContent.Length & ")")
ElseIf Not String.IsNullOrWhiteSpace(Link) Then
Log("[System] 开始从网络读取主页自定义数据(" & Link & ")")
FileContent = NetGetCodeByRequestRetry(Link)
Log("[System] 尝试从网络读取主页自定义数据(" & FileContent.Length & ")")
End If
LatestFileLink = Link
LatestFileContent = FileContent
Catch ex As Exception
Log(ex, "获取 PCL 主页自定义信息失败", LogLevel.Msgbox)
LatestFileLink = ""
End Try
End Select
If FileContent = "" Then
IsRefreshing = False
Exit Sub
End If
FileContent = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & FileContent & "</StackPanel>"
FileContent = FileContent.Replace("{path}", Path)
RunInUi(Sub()
Try
Log("[System] 加载主页自定义数据")
PanCustom.Children.Add(GetObjectFromXML(FileContent))
IsRefreshing = False
Catch ex As Exception
IsRefreshing = False
Log("[System] 自定义信息内容:" & vbCrLf & FileContent)
If MyMsgBox(ex.Message, "加载自定义主页失败", "重试", "取消") = 1 Then
LatestFileLink = Nothing
LatestFileContent = ""
RefreshCustom()
End If
End Try
End Sub)
End Sub, "主页自定义刷新")
'获取版本校验地址
Dim VersionAddress As String
If Address.Contains(".xaml") Then
VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else
VersionAddress = Address.Before("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version"
If Address.Contains("?") Then VersionAddress += Address.After("?")
End If
'校验版本
Dim Version As String = ""
Dim NeedDownload As Boolean = True
Try
Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000)
If Version.Length > 100 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
NeedDownload = False
Else
Log($"[Page] 需要下载联网自定义主页,当前版本:{Version},检查源:{VersionAddress}")
End If
Catch exx As Exception
Log(exx, $"联网获取自定义主页版本失败", LogLevel.Developer)
Log($"[Page] 无法检查联网自定义主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
If NeedDownload Then
Dim FileContent As String = NetGetCodeByRequestRetry(Address)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
End If
'要求刷新
Refresh()
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
IsRefreshing = False
If Setup.Get("CacheSavedPageVersion") = "" Then
Log(ex, $"联网下载自定义主页失败({Address})", LogLevel.Msgbox)
Else
Log(ex, $"联网下载自定义主页失败({Address})")
End If
End Try
End Sub
Public Sub ForceRefresh(Optional ShowHint As Boolean = True)
ShouldRefresh = True
LatestFileContent = ""
LatestFileLink = Nothing
If ShowHint Then Hint("已刷新主页!", HintType.Finish)
FrmMain.PageChange(FormMain.PageType.Launch)
Init()
''' <summary>
''' 立即强制刷新自定义主页。
''' 必须在 UI 线程调用。
''' </summary>
Public Sub ForceRefresh()
Log("[Page] 要求强制刷新自定义主页")
ClearCache()
'实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
PanBack.ScrollToHome()
Refresh()
Else
FrmMain.PageChange(FormMain.PageType.Launch)
End If
End Sub
''' <summary>
''' 清空自定义主页缓存信息。
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = ""
Setup.Set("CacheSavedPageUrl", "")
Setup.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空自定义主页缓存")
End Sub
''' <summary>
''' 从文本内容中加载自定义主页。
''' 必须在 UI 线程调用。
''' </summary>
Private Sub LoadContent(Content As String)
SyncLock LoadContentLock
'如果加载目标内容一致则不加载
Dim Hash = Content.GetHashCode()
If Hash = LoadedContentHash Then Exit Sub
LoadedContentHash = Hash
'实际加载内容
PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化:清空自定义主页 UI,来源为空")
Return
End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Try
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
Log("[Page] 加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.Message}", "加载自定义主页失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁
End If
End Try
Log($"[Page] 实例化:加载自定义主页 UI 完成")
End SyncLock
Return
Refresh:
ForceRefresh()
End Sub
Private LoadedContentHash As Integer = -1
Private LoadContentLock As New Object
#End Region
End Class
@@ -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
Loaded 100 of 153 files, more files were not shown because too many files have changed in this diff. Show more