Compare commits

...
148 Commits
Author SHA1 Message Date
龙腾猫跃 503244a0de 2.9.1 2025-02-22 01:20:08 +08:00
龙腾猫跃 1a0c7b0520 Merge pull request #4758 from youzi-3222/feat-98
导出整合包 复活
2025-02-22 00:15:16 +08:00
龙腾猫跃 a6ebf3b43d Merge pull request #5650 from tangge233/FixModrinthApi
修复:没读取 loaders 字段
2025-02-12 23:14:20 +08:00
tangge233 bbb8e97712 fix: not read loader info on modrinth 2025-02-12 21:27:11 +08:00
龙腾猫跃 bcc63bebe9 Merge pull request #5634 from 3gf8jv4dv/fix-dirtpath-term
Revise GrassPath translation
2025-02-12 18:41:19 +08:00
龙腾猫跃 dbe09a3283 Merge pull request #5526 from Txt-Text/main
读取MMC整合包instance.cfg中的JvmArgs参数
2025-02-12 18:32:46 +08:00
龙腾猫跃 b7e7126572 Merge pull request #5523 from Silverteal/patch-1
修改 Referer 的字段顺序以符合正常语义
2025-02-12 18:18:08 +08:00
龙腾猫跃 51490a637a Merge pull request #5508 from LuoYo-Team/Remove-ClientToken
Chore:移除 ClientToken & 对 ModLaunch 刷新请求部分进行解耦合
2025-02-12 18:12:33 +08:00
龙腾猫跃 406d19b678 Merge pull request #5647 from Muqingxue-Studio/main
Fix:硬编码路径导致编译问题
2025-02-12 17:37:04 +08:00
慕轻雪 1db1323273 Merge pull request #1 from Muqingxue-Studio/mqingxue-patch-1
ci:use context
2025-02-12 15:31:53 +08:00
慕轻雪andallMagicNB f31a5b14bc ci:use context
Co-authored-by: allMagicNB <[email protected]>
2025-02-12 15:31:35 +08:00
慕轻雪 b5407ad644 Fix:Self-hosted runner 不会自动清理文件导致编译失败 2025-02-12 14:44:59 +08:00
慕轻雪 5740b16325 Fix:使用了错误的变量名 2025-02-12 14:18:59 +08:00
慕轻雪 9ff7f89f86 Update build.yml 2025-02-12 14:09:47 +08:00
慕轻雪 c27dfff84c Fix:使用字符串模板插入&修改命名以避免与自带变量冲突 2025-02-12 14:06:15 +08:00
慕轻雪 25f9363170 Fix:路径拼接 2025-02-12 14:02:10 +08:00
慕轻雪 74730f6102 Chore:自动获取工作目录 2025-02-12 13:55:42 +08:00
3gf8jv4dv 2441c52526 Revise GrassPath translation
Ref: History section on https://minecraft.wiki/w/Dirt_Path

Resolves Hex-Dragon#5633
2025-02-10 19:01:22 +08:00
龙腾猫跃 aa7ee23039 Merge pull request #5611 from Muqingxue-Studio/main
Feat:优化 Actions 文件
2025-02-07 17:55:29 +08:00
慕轻雪 e48f39ef5b Test 2025-02-07 13:19:34 +08:00
慕轻雪 df2cc61c27 Add Description 2025-02-06 22:39:44 +08:00
慕轻雪 4f2e20ff4e Format Code 2025-02-06 22:35:00 +08:00
慕轻雪 cde644c1e1 done 2025-02-06 22:22:43 +08:00
慕轻雪 aa3e08a7fb test 2025-02-06 22:10:39 +08:00
慕轻雪 4c1e9ccf72 Fix bug 2025-02-06 22:04:44 +08:00
慕轻雪 f8cbbf8092 test 2025-02-06 22:01:35 +08:00
无聊的小洛 b0e4ca9cbc Chore:格式化源代码 2025-02-06 21:29:30 +08:00
无聊的小洛and慕轻雪 9118b1d20e Update Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
Co-authored-by: 慕轻雪 <[email protected]>
2025-02-06 21:05:03 +08:00
youzi-3222 fc1519e9b1 👌 🐛 ✨ 修改 @MoYuan-CN 的 Review,修复已知问题 2025-02-03 21:53:49 +08:00
龙腾猫跃 c5197e2f2d 2.8.13 正式版 2025-01-27 23:39:43 +08:00
Txt-Text 72a33fe2cc Update ModModpack.vb
读取JvmArgs参数,删除一些废话注释
2025-01-27 11:18:37 +08:00
Txt-Text 847c433310 Update ModModpack.vb
让PCL能够正确读取MMC整合包instance.cfg中的JvmArgs
2025-01-27 09:52:00 +08:00
Silverteal 30579e6f41 修改Referer的字段顺序以符合正常语义 2025-01-26 22:41:05 +08:00
无聊的小洛 feade470a4 移除 LittleSkin OAuth 代码 2025-01-25 22:34:51 +08:00
无聊的小洛 3eed7c5b7f 移除 ClientToken 2025-01-25 22:24:56 +08:00
龙腾猫跃 70636a9a77 2.8.13 2025-01-25 03:00:46 +08:00
youzi-3222 86b0e6d459 🔥 删除 Logo 相关代码 2025-01-23 08:56:44 +08:00
youzi-3222 1b8d164061 🐛 修复已知问题 2025-01-23 08:00:59 +08:00
龙腾猫跃 107a5ae016 再次明确第六条 2025-01-22 18:38:13 +08:00
龙腾猫跃 391d50ce34 明确“相似功能”的限制 2025-01-21 22:11:07 +08:00
youzi-3222 74a9d18fc5 ♿ 👌 导出整合包改用 Loader 2025-01-17 14:02:08 +08:00
youzi-3222 08ad8e6682 ✨ 👌 允许多个链接 2025-01-16 18:24:25 +08:00
youzi-3222 1e5d5f0377 🐛 👌 Mod 文件保留原始文件名 2025-01-16 17:33:40 +08:00
youzi-3222 e6e9ebd5dc 💄 👌 合并预览与信息卡片 2025-01-16 16:27:56 +08:00
龙腾猫跃 604bcd0997 Merge pull request #5404 from hadesanc1/hadesanc1/issue5402
当在版本设置中连续按下mod右侧的“删除”按钮时,g概率导致PCL2崩溃。
2025-01-16 00:25:57 +08:00
龙腾猫跃 96a4bd05bd Merge pull request #5400 from hadesanc1/hadesanc1/issue5366
“设置/个性化/功能隐藏”字样在PCL2小窗口时不能完整显示文本
2025-01-16 00:18:26 +08:00
龙腾猫跃 36df43ad8a Merge pull request #5414 from hadesanc1/hadesanc1/issue5241
加载图标过于靠下
2025-01-16 00:07:16 +08:00
龙腾猫跃 46713b3870 Merge pull request #5398 from hadesanc1/hadesanc1/issue5259
搜索部分mod时未在mod下载详情页出现MC版本筛选
2025-01-16 00:04:53 +08:00
龙腾猫跃 58dfc9a25d Merge pull request #5413 from hadesanc1/hadesanc1/issue5248
[mod前置数量显示错误]在有前置的mod详情界面,离开再回来,mod前置显示增加
2025-01-16 00:02:03 +08:00
龙腾猫跃 51751f2464 Merge pull request #5354 from wuliaodexiaoluo/main
Fix:语言标头问题
2025-01-15 23:59:52 +08:00
龙腾猫跃 eaf7a93b52 Merge pull request #5337 from Silverteal/dpi-patch-1
通过修改 DPI 配置增强多屏幕 DPI 体验
2025-01-15 23:58:06 +08:00
龙腾猫跃 718d61af29 Merge pull request #5293 from PlayMcBKuwu/main
修复: 判断语言是否为中文 -> 判断语言是否为中文(中国大陆)
2025-01-15 23:51:58 +08:00
龙腾猫跃 49c2318ece Merge pull request #5260 from Pigeon0v0/office-cape
添加办公室披风翻译
2025-01-15 23:50:13 +08:00
龙腾猫跃 3a90962001 Merge pull request #5412 from hadesanc1/hadesanc1/issue5255
[可视化mod列表出错...]搜索Sand Filter时必报错
2025-01-15 22:44:58 +08:00
youzi-3222 838cb79420 🎨 取消测试时的注释 2025-01-14 16:50:51 +08:00
youzi-3222 f6cbb0f986 ♻️ 🐛 修复关闭版本隔离时的问题 2025-01-14 16:47:28 +08:00
youzi-3222 1dd235d313 Merge branch 'feat-98' of https://github.com/youzi-3222/PCL2 into feat-98 2025-01-14 15:12:53 +08:00
youzi-3222 fa778eedb7 🔀 合并上游分支 2025-01-14 14:21:40 +08:00
hadesanc1 836260478c 加载图标过于靠下
Fixes #5241
2025-01-13 20:33:13 +08:00
hadesanc1 96c35a3bed [mod前置数量显示错误]在有前置的mod详情界面,离开再回来,mod前置显示增加
Fixes #5248
2025-01-13 20:06:41 +08:00
hadesanc1 81cf8c1901 [可视化mod列表出错...]搜索Sand Filter时必报错
Fixes #5255
2025-01-13 19:36:28 +08:00
hadesanc1 3b1ab78fb9 当在版本设置中连续按下mod右侧的“删除”按钮时,g概率导致PCL2崩溃。
Fixes #5402
2025-01-12 12:21:00 +08:00
hadesanc1 df83b248f8 “设置/个性化/功能隐藏”字样在PCL2小窗口时不能完整显示文本
Fixes #5366
2025-01-12 03:05:19 +08:00
hadesanc1 8b0694fdd0 搜索部分mod时未在mod下载详情页出现MC版本筛选
Fixes #5259
2025-01-12 00:31:09 +08:00
无聊的小洛 28c32765ce Fix:语言标头问题 2025-01-01 13:48:29 +08:00
Silverteal 5e55e48259 Update App.config 2024-12-26 15:18:00 +08:00
Silverteal ed72973cef Update app.manifest 2024-12-26 15:13:46 +08:00
鹿目 まどか Advancedand3gf8jv4dv a1da68a8c2 修复: 判断语言是否为中文 -> 判断语言是否为中文(中国大陆)
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-12-15 22:11:18 +08:00
鹿目 まどか Advanced 53f7aa0b40 修复: 判断语言是否为中文 -> 判断语言是否为中文(中国) 2024-12-15 22:06:33 +08:00
Pigeon0v0 68bb80fc81 add: 办公室披风翻译 2024-12-14 08:59:38 +08:00
龙腾猫跃 a8bb82b033 2.8.12 正式版 2024-12-13 18:16:06 +08:00
龙腾猫跃 7083b0f4f4 2.8.12 2024-12-11 20:16:31 +08:00
龙腾猫跃 6ed0c6e4fe 2.8.11(重新上传) 2024-12-08 22:09:43 +08:00
龙腾猫跃 f678dfe853 fix: #5238 2024-12-08 21:11:57 +08:00
龙腾猫跃 b37c264e32 Update PageOtherTest.xaml.vb 2024-12-08 20:58:40 +08:00
龙腾猫跃 68f8b3eeac 2.8.11 2024-12-08 20:21:23 +08:00
龙腾猫跃 37354d15f7 Merge pull request #5229 from allMagicNB/main
自动编译时添加 Help.zip
2024-12-08 19:40:47 +08:00
allMagicNB 38b3cefa89 fix 2024-12-08 19:29:23 +08:00
allMagicNB bce8e71571 fix 2024-12-08 06:59:23 +08:00
allMagicNB f300858ced fix 2024-12-07 23:39:29 +08:00
allMagicNB bdcbab700e + PCL2Help.zip 2024-12-07 23:07:41 +08:00
龙腾猫跃 b8eb669351 Merge pull request #5225 from Ad-closeNN/main
[优化] 为 option.txt 加上 s
2024-12-07 19:28:02 +08:00
Ad-closeNN b9d69a3258 为 option.txt 加上 s 2024-12-07 19:17:46 +08:00
龙腾猫跃 e454f0c640 Merge pull request #5212 from 3gf8jv4dv/download-page-version-filter
Change the download page version filter item
2024-12-05 23:55:05 +08:00
龙腾猫跃 454c9ea377 Merge pull request #5129 from Hill23333/main
修复32位Java提示错误
2024-12-05 21:29:21 +08:00
龙腾猫跃 4f258c8078 Merge pull request #5098 from lactobionicAcid/branch
Fix #5096
2024-12-05 20:41:24 +08:00
龙腾猫跃 4b2e2d8eef Merge pull request #5073 from tangge233/homepage
优化:请求头逻辑
2024-12-05 18:58:53 +08:00
龙腾猫跃 1242d97a1c Update LICENCE 2024-12-05 02:07:04 +08:00
龙腾猫跃 6225391afa Update LICENCE 2024-12-05 02:04:46 +08:00
龙腾猫跃 b1a0e9a79d 允许分发衍生内容 2024-12-05 01:28:49 +08:00
龙腾猫跃 347bc8fb82 Update README.md 2024-12-05 01:20:17 +08:00
3gf8jv4dv 6bdf7e235a Change the download page version filter item
- Remove 1.21.3
- Add 1.21.4
2024-12-03 21:45:43 +08:00
Hill23333 d7424d4d2b Merge branch 'Hex-Dragon:main' into main 2024-11-24 18:23:18 +08:00
龙腾猫跃 37561a842b Delete .github/workflows/issue_similarity.yml 2024-11-18 19:00:37 +08:00
Hill23333 e04e462737 少了个“Not” 2024-11-16 22:58:19 +08:00
Hill23333 ba262a1741 修复32位Java提示错误 2024-11-16 22:38:55 +08:00
乳糖酸酱 df11fa5a9d Merge branch 'Hex-Dragon:main' into branch 2024-11-16 02:39:57 +08:00
龙腾猫跃 b6a52f90f6 Update README.md 2024-11-12 14:53:32 +08:00
lactobionicAcid 531706e73b Update ModMusic.vb 2024-11-10 16:12:29 +08:00
lactobionicAcid 66a2406e0a Update ModMusic.vb 2024-11-10 16:10:03 +08:00
lactobionicAcid 6ec48abe77 Fix #5096 2024-11-10 15:51:07 +08:00
tangge233 9aecc1920a fix: 目录问题…… 2024-11-09 09:43:04 +08:00
tangge233 75cc86d2a2 feat: 自己下 2024-11-08 22:09:52 +08:00
tangge233 8abf4707a1 chore: 漏了一个,问题不大 2024-11-08 17:05:21 +08:00
tangge233 b6cc6c10c3 fix: 不是每个请求都需要的 Header 2024-11-08 16:54:29 +08:00
tangge233 5d16cf24bb chore: 换一个方式 2024-11-08 16:51:38 +08:00
tangge233 05acfc6b51 fix: B站图床 2024-11-08 16:19:14 +08:00
游子柚子andPigeon0v0 f27822b005 💬 高级选项提示文案
Co-authored-by: Pigeon0v0 <[email protected]>
2024-10-13 20:51:52 +08:00
youzi-2333 10e4bc0bbb 🐛 Tag: resources -> resourcepacks
我是傻逼。
2024-08-20 15:33:14 +08:00
tangge233 37eacb00c5 comment: 同步下注释 2024-08-20 14:28:25 +08:00
tangge233 ef5b0ba1f7 fix: 搁这最强大脑呢? 2024-08-20 14:24:40 +08:00
youzi-2333 ddfc6897d7 🐛 修复一些问题 2024-08-20 12:27:12 +08:00
youzi-2333 86bace4d13 👌 修改 LTCatt 的审核 2024-07-31 08:57:26 +08:00
youzi-2333 690e73eab1 🚸 优化弹出 explorer 2024-07-25 17:29:21 +08:00
youzi-2333 6808620083 🐛 空文件夹造成选中判断错误 2024-07-23 09:05:48 +08:00
youzi-2333 1095a33a44 💥 🚸 显示部分选中的文件夹 2024-07-23 08:49:19 +08:00
youzi-2333 43511b0a49 🐛 空文件夹总是判定为被选中 2024-07-22 08:57:49 +08:00
youzi-2333 3d18a5acc5 🚧 UI 设计(未完成) 2024-07-21 22:18:48 +08:00
youzi-2333 de9afd3ece 🚧 UI 设计(未完成) 2024-07-19 22:46:09 +08:00
youzi-2333andluolinlin768 898f53428f 🚸 修复一些问题
Co-authored-by: luolinlin768
2024-07-18 13:33:12 +08:00
youzi-2333 3bd39de728 🐛 修复整合包描述 Reload 时被覆盖的问题 2024-07-18 13:09:17 +08:00
youzi-2333 4547b81d68 🚧 添加整合包描述的设置 2024-07-16 13:18:41 +08:00
youzi-2333 aacaf792ef 🐛 修复图标设置的问题 2024-07-15 22:29:29 +08:00
youzi-2333 13d0cb725e 🐛 修复问题 2024-07-15 08:21:15 +08:00
youzi-2333 33581b5be9 Merge branch 'luolinlin768-feat-98' into feat-98 2024-07-12 21:46:15 +08:00
youzi-2333 00fdf1f3d3 🔀 Merge from luolinlin768/feat-98 to youzi-2333/feat-98 2024-07-12 21:45:18 +08:00
youzi-2333 ca07edc707 🚧 修改一些龙猫的审查 2024-07-12 21:42:07 +08:00
淋淋 落 6850cd6764 修改了“包含启动器”和“启动器全局配置”的位置 2024-07-12 13:17:33 +08:00
淋淋 落 a1b98308d4 Revert "修改了“导出整合包”的和边界的距离,21改为20"
This reverts commit 1284f464c1.
2024-07-12 11:11:19 +08:00
淋淋 落 1284f464c1 修改了“导出整合包”的和边界的距离,21改为20 2024-07-12 10:56:23 +08:00
淋淋 落 bc5b37cce5 修改了文案 2024-07-12 10:43:58 +08:00
淋淋 落 82c398dee0 更改了一些错误,修改了标题,添加了提示,修改了间距 2024-07-12 10:30:57 +08:00
淋淋 落 c4974bbf5a 删除了多余的换行 2024-07-12 09:31:03 +08:00
淋淋 落 465a38163b 在基础选项里添加了服务器文件的选择,优化了基础选项里的排版 2024-07-12 09:30:12 +08:00
淋淋 落 b28c707cb5 修改了导出整合包UI 2024-07-12 09:02:15 +08:00
youzi-2333 ae4f1b8672 👌 排除 log4j2.xml 2024-07-11 14:11:44 +08:00
youzi-2333 32803b1b67 👌 排除 HMCL 版本配置 2024-07-11 13:35:47 +08:00
youzi-2333 4c69defb42 ✨ 对齐 mr 整合包的输入框
强迫症快乐.jpg
2024-07-11 13:28:19 +08:00
youzi-2333 b7118be391 💬 修改包含存档的 Tooltip 2024-07-11 13:17:37 +08:00
youzi-2333 05b175b5ef ⏪ 回滚 vbproj 文件 2024-07-11 13:06:30 +08:00
youzi-2333 dce9892f61 🔀 Merge from remote 2024-07-11 13:02:28 +08:00
youzi-2333andPigeon0v0 a74e59baf4 💬 更新文案
Co-authored-by: Pigeon0v0 <[email protected]>
2024-07-11 13:00:28 +08:00
柚子柚子andPigeon0v0 bc58fdaf39 Update Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb
Co-authored-by: Pigeon0v0 <[email protected]>
2024-07-11 12:59:22 +08:00
youzi-2333 92f30181d5 ✨ 完成 UI 2024-07-11 12:58:48 +08:00
youzi-2333 49db56856d ✨ 导出整合包:Modrinth 2024-07-11 10:07:59 +08:00
youzi-2333 87e1fb0b1e 🐛 修复导出压缩包的问题 2024-07-10 22:14:55 +08:00
youzi-2333 ad41b4e377 🎨 修复工程设置问题 2024-07-09 11:49:49 +08:00
youzi-2333 09e896dc26 🚧 导出整合包:压缩包 2024-07-09 10:50:49 +08:00
93 changed files with 5115 additions and 1839 deletions

No files matched your search

+21
View File
@@ -17,27 +17,48 @@ jobs:
strategy:
matrix:
configuration: [Debug, Release]
steps:
- name: Checkout
uses: actions/checkout@v4
with:
fetch-depth: 0
- name: Set Describe
shell: bash
run: |
describe=`git describe --tags --always`
echo "describe=$describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2
with:
msbuild-architecture: x64
- name: Update Help
run: |
$workpath = [System.Environment]::CurrentDirectory
Set-Location ..
git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
Set-Location PCL2Help
Remove-Item -Path *.* -Recurse -Force
Compress-Archive -Path .\* -DestinationPath .\Help.zip
Copy-Item -Path .\Help.zip -Destination "${{ GITHUB.WORKSPACE }}\Plain Craft Launcher 2\Resources\Help.zip" -Force
Set-Location ..
Remove-Item PCL2Help -Recurse -Force
Set-Location ${{ GITHUB.WORKSPACE }}
- name: Replace
run: |
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb"
- name: Build
run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }}
- name: Upload a Build Artifact
uses: actions/upload-artifact@v4
with:
-18
View File
@@ -1,18 +0,0 @@
name: Issues Similarity Analysis
on:
issues:
types: [opened, edited]
jobs:
similarity-analysis:
runs-on: ubuntu-latest
steps:
- name: Issues Similarity Analysis
uses: actions-cool/[email protected]
with:
filter-threshold: 0.65
comment-title: '### 反馈重复性检测 | Issues Similarity Analysis'
comment-body: '${index}. ${similarity} #${number}'
show-footer: false
show-mentioned: true
+8 -7
View File
@@ -2,24 +2,25 @@
一、承诺与声明。
  开发者承诺,在您遵守本指南的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  开发者承诺,在您遵守本指南且善意使用的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。
  如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。
  3、使用本指南文件作为协议,不得附加额外条款。
  4、该衍生作品不能被允许用于再次分发。包括但不限于用于制作整合包。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助功能,或是其他作用相似的功能。包括但不限于主题功能、回声洞投稿功能等。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
  3、给出适当的说明,以明确表示该衍生作品是非官方内容。
  4、使用本指南文件作为协议,不得附加额外条款。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀。例如 “PCL 整合包优化版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助解锁功能,或与其相近的功能或内容。例如将配色修改为蓝色色系以外的颜色。
  7、以善意目的进行合理使用,不要用 PCL 来干坏事、恰烂钱、整烂活。开发者可能会将撤销所有授权作为最终手段。
————————————
+29 -27
View File
@@ -1,33 +1,35 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<system.net>
<settings>
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<system.net>
<settings>
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup>
<runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<generatePublisherEvidence enabled="false"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
<runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<AppContextSwitchOverrides value="Switch.System.Windows.DoNotScaleForDpiChanges=false"/> <!-- #5337 -->
<AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" /> <!-- 长路径支持 -->
<generatePublisherEvidence enabled="false"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>
+6
View File
@@ -13,6 +13,12 @@
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
</ResourceDictionary.MergedDictionaries>
<!-- Converter -->
<local:AdditionConverter x:Key="AdditionConverter"/>
<local:MultiplicationConverter x:Key="MultiplicationConverter"/>
<local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
<local:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
<!-- 颜色表 -->
<SolidColorBrush x:Key="ColorBrush1">#343d4a</SolidColorBrush>
+2 -2
View File
@@ -31,7 +31,7 @@ Public Class Application
'内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try
PageOtherTest.MemoryOptimizeInternal()
PageOtherTest.MemoryOptimizeInternal(False)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败")
Environment.Exit(-1)
@@ -114,7 +114,7 @@ WaitRetry:
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!" & vbCrLf & "程序目前在临时文件夹中运行,设置、游戏存档等可能无法保存,且部分功能将无法使用。", "环境警告", "我知道了", IsWarn:=True)
MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
@@ -7,7 +7,7 @@
<Border.RenderTransform>
<ScaleTransform />
</Border.RenderTransform>
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" Text="Button" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock.RenderTransform>
<ScaleTransform />
</TextBlock.RenderTransform>
@@ -1,22 +1,30 @@
Public Class MyButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return LabText.Text
Return GetValue(TextProperty)
End Get
Set(value As String)
LabText.Text = value
SetValue(TextProperty, value)
End Set
End Property '显示文本
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub)))
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If sender IsNot Nothing Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub)))
Public Property TextPadding As Thickness
Get
Return LabText.Padding
+23 -14
View File
@@ -36,6 +36,11 @@
'属性
Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return MainTextBlock.Inlines
End Get
End Property
Public Property Title As String
Get
Return GetValue(TitleProperty)
@@ -62,7 +67,7 @@
If IsLoad Then Exit Sub
IsLoad = True
'初次加载限定
If Title <> "" AndAlso MainTextBlock Is Nothing Then
If 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})
@@ -222,20 +227,21 @@
'高度增加较大,使用弹起动画
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))
})
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))
})
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathClamp(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()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AnimList.Add(AaCode(
Sub()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True
@@ -253,7 +259,8 @@
#End Region
'折叠
#Region "折叠"
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object
@@ -294,7 +301,7 @@
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
@@ -303,7 +310,7 @@
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
@@ -320,6 +327,8 @@
IsMouseDown = False
End Sub
#End Region
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
@@ -4,7 +4,7 @@
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8">
<TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<TextBlock IsHitTestVisible="False" FontSize="13" x:FieldModifier="Public" x:Name="LabText" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" />
<Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z">
<Path.RenderTransform>
@@ -1,4 +1,7 @@
Public Class MyCheckBox
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyCheckBox
'基础
@@ -14,29 +17,32 @@
End Sub '使外部程序引发本控件的 Change 事件
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
Return GetValue(CheckedProperty)
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False)
End Set
End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyCheckBox), New PropertyMetadata(False,
Sub(d As MyCheckBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Public Sub SetChecked(value As Boolean, user As Boolean)
Try
If value = _Checked Then Exit Sub
If value = Checked Then Exit Sub
'Preview 事件
If value AndAlso user Then
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewChange(Me, e)
@@ -48,60 +54,67 @@
End If
End If
_Checked = value
SetValue(CheckedProperty, value)
If IsLoaded Then RaiseEvent Change(Me, user)
'更改动画
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
SyncUI()
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -110,10 +123,10 @@
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckbox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckbox).LabText.Text = e.NewValue
End Sub)))
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckBox).LabText.Text = e.NewValue
End Sub)))
'点击事件
@@ -123,7 +136,7 @@
If Not MouseDowned Then Exit Sub
Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
MouseDowned = False
SetChecked(Not Checked, True, True)
SetChecked(Not Checked, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
@@ -0,0 +1,33 @@
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton"
RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="52">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
<Border x:Name="PanClick" BorderThickness="0.001" Background="{StaticResource ColorBrushSemiTransparent}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}"/>
<Grid x:Name="PanScale" IsHitTestVisible="False" RenderTransformOrigin="0.5,0.5" Margin="0,10,0,0">
<Grid.RenderTransform>
<ScaleTransform />
</Grid.RenderTransform>
<Border x:Name="PanColor" BorderThickness="0.001" Background="{DynamicResource ColorBrush3}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}">
<Border.Effect>
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<StackPanel Orientation="Horizontal" Margin="24,0" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Path x:Name="Path" Stretch="Uniform" Margin="0,12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<ScaleTransform />
</Path.RenderTransform>
</Path>
<TextBlock x:Name="LabText" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush8}" FontSize="16"
Margin="11,0,-2,1.2" />
</StackPanel>
</Grid>
</Grid>
@@ -0,0 +1,158 @@
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyExtraTextButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
_Logo = value
Path.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 Path IsNot Nothing Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
'显示文本
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
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(MyExtraTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If sender IsNot Nothing Then CType(sender, MyExtraTextButton).LabText.Text = e.NewValue
End Sub)))
'动画
Private _Show As Boolean = False
Public Property Show As Boolean
Get
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
_Show = value
RunInUi(
Sub()
If value Then
'有了
Opacity = 0
AniStart({
AaOpacity(Me, 1 - Opacity, 80, 50),
AaScaleTransform(Me, 0.15 - CType(RenderTransform, ScaleTransform).ScaleX, 400, 50, New AniEaseOutBack),
AaScaleTransform(Me, 0.85, 160, 50, New AniEaseOutFluent(AniEasePower.Middle))
}, "MyExtraTextButton MainScale " & Uuid)
Else
'没了
AniStart({
AaOpacity(Me, -Opacity, 50, 50),
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak))
}, "MyExtraTextButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
End Set
End Property
'触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then
Log("[Control] 按下附加按钮" & If(ToolTip = "", "", ":" & ToolTip.ToString))
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
End If
End Sub
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsLeftMouseHeld As Boolean = False
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
End If
IsLeftMouseHeld = True
Focus()
End Sub
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
End If
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles PanClick.MouseLeave
IsLeftMouseHeld = False
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If IsMouseOver Then
'指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraTextButton Color " & Uuid)
Else
'普通
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush3", AnimationColorOut), "MyExtraTextButton Color " & Uuid)
End If
Else
AniStop("MyExtraTextButton Color " & Uuid)
If IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
End If
Catch ex As Exception
Log(ex, "刷新图标按钮颜色出错")
End Try
End Sub
End Class
+1 -1
View File
@@ -17,7 +17,7 @@
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" Text="提示文本" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid>
@@ -1,4 +1,7 @@
Public Class MyHint
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyHint
Public Uuid As Integer = GetUuid()
@@ -30,6 +33,11 @@
End Set
End Property
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return LabText.Text
@@ -1,4 +1,7 @@
Public Class MyIconTextButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyIconTextButton
'基础
@@ -30,6 +33,11 @@
End Set
End Property
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -39,9 +47,9 @@
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)))
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
+5 -2
View File
@@ -128,14 +128,17 @@ RetryStart:
'下载
ActualSource = LoadingSource '显示加载中图片
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
NetDownload(Url, TempDownloadingPath, True)
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载,以避免携带 Header(#5072)
Using Client As New Net.WebClient
Client.DownloadFile(Url, TempDownloadingPath)
End Using
If Url <> Source AndAlso Url <> FallbackSource Then
'已经更换了地址
File.Delete(TempDownloadingPath)
ElseIf EnableCache Then
'保存缓存并显示
If File.Exists(TempPath) Then File.Delete(TempPath)
Rename(TempDownloadingPath, TempPath)
FileSystem.Rename(TempDownloadingPath, TempPath)
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
@@ -1,4 +1,7 @@
Public Class MyListItem
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyListItem
Implements IMyRadio
Public Event Click(sender As Object, e As MouseButtonEventArgs)
@@ -161,6 +164,11 @@
End Property
'标题
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabTitle.Inlines
End Get
End Property
Public Property Title As String
Get
Return GetValue(TitleProperty)
@@ -654,6 +662,8 @@
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
EventType = Nothing
EventData = Nothing
End Try
End If
End Sub
+16 -7
View File
@@ -353,6 +353,10 @@
If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing
Next
For Each Control As FrameworkElement In GetAllAnimControls(Element)
If TypeOf Control Is MyExtraTextButton Then
CType(Control, MyExtraTextButton).Show = True
Continue For
End If
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
@@ -379,6 +383,10 @@
Dim Delay As Integer = 0
For Each Element In RealElements
For Each Control As FrameworkElement In GetAllAnimControls(Element)
If TypeOf Control Is MyExtraTextButton Then
CType(Control, MyExtraTextButton).Show = False
Continue For
End If
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
@@ -392,12 +400,13 @@
AniList.Add(AaTranslateX(Scroll, 10 - CType(Scroll.RenderTransform, TranslateTransform).X, 90, 0, New AniEaseInFluent))
End If
'结束
AniList.Add(AaCode(Sub()
For Each Element In RealElements
Element.Visibility = Visibility.Collapsed
Next
PageOnExitAnimationFinished()
End Sub,, True))
AniList.Add(AaCode(
Sub()
For Each Element In RealElements
Element.Visibility = Visibility.Collapsed
Next
PageOnExitAnimationFinished()
End Sub,, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
End Sub
@@ -409,7 +418,7 @@
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
Dim Content = CType(Element, ContentControl).Content
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid>
@@ -1,4 +1,7 @@
Public Class MyRadioBox
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioBox
Implements IMyRadio
'基础
@@ -10,27 +13,29 @@
Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
Return GetValue(CheckedProperty)
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False)
End Set
End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyRadioBox), New PropertyMetadata(False,
Sub(d As MyRadioBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Public Sub SetChecked(value As Boolean, user As Boolean)
Try
'Preview 事件
If value AndAlso user Then
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewCheck(Me, e)
@@ -41,28 +46,24 @@
End If
'自定义属性基础
Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not value = _Checked Then
_Checked = value
If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not value = Checked Then
SetValue(CheckedProperty, value)
IsChanged = True
End If
'保证只有一个单选框选中
If Parent Is Nothing Then Exit Sub
Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children
For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
If TypeOf Control Is MyRadioBox Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
End If
Next
'判断选中情况
Select Case CheckedCount
Select Case CheckedCount '判断选中情况
Case 0
'没有任何单选框被选中,选择第一个
RadioboxList(0).Checked = True
@@ -87,67 +88,74 @@
Next
End If
End Select
'End If
'更改动画
If Not IsChanged Then Exit Sub
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
If IsChanged Then
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
End If
'更改动画
SyncUI()
Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try
End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -165,9 +173,9 @@
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
MouseDowned = False
Log("[Control] 按下单选框:" & Text)
SetChecked(True, True, True)
SetChecked(True, True)
MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
@@ -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,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -1,4 +1,7 @@
Public Class MyRadioButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioButton
'基础
@@ -108,6 +111,12 @@
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
End Try
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -45,4 +45,7 @@
ScrollBar = GetTemplateChild("PART_VerticalScrollBar")
End Sub
Private Sub MyScrollViewer_PreviewGotKeyboardFocus(sender As Object, e As KeyboardFocusChangedEventArgs) Handles Me.PreviewGotKeyboardFocus
If e.NewFocus IsNot Nothing AndAlso TypeOf e.NewFocus Is MySlider Then e.Handled = True '#3854,阻止获得焦点时自动滚动
End Sub
End Class
+1 -1
View File
@@ -133,7 +133,7 @@
</Grid>
<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" />
LogoScale="0.87" Logo="M1097 584 250 584 562 896C591 925 591 972 562 1001 533 1030 487 1030 458 1001L21 565C6 550-0 531 0 511L0 511 0 511C-0 492 6 472 21 457L458 21C487-7 533-7 562 21 591 50 591 97 562 126L250 438 1097 438C1137 438 1170 471 1170 511 1170 551 1137 584 1097 584L1097 584Z" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
</Grid>
</Grid>
+131 -243
View File
@@ -10,178 +10,112 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 352 Then 'Release 2.9.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:导出整合包功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:支持在超长路径下安装、启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 1.21 OptiFine"))
FeatureCount += 23
BugCount += 10
End If
If LastVersion < 349 Then 'Release 2.8.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络环境不佳时,Mod、整合包页面的加载速度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:部分电脑无法打开程序"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法识别、更新 Mod"))
FeatureCount += 6
BugCount += 14
End If
If LastVersion < 347 Then 'Release 2.8.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 管理页面添加下载 Mod、安装 Mod 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 详情页面支持按加载器、游戏版本进行分类和筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:支持安装同时包含 modpack 文件和启动器的懒人包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:整合包导入流程"))
FeatureCount += 43
BugCount += 37
End If
If LastVersion < 342 Then 'Release 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:搜索后启用/禁用 Mod 时出错"))
FeatureCount += 17
BugCount += 13
End If
If LastVersion < 340 Then 'Release 2.8.8
If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug"))
If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
BugCount += 7
End If
If LastVersion < 338 Then 'Release 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法加载部分 Mod 的图标"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在 Mod 管理页面删除 Mod 导致报错"))
FeatureCount += 11
BugCount += 21
End If
If LastVersion < 336 Then 'Release 2.8.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 19
BugCount += 24
End If
If LastVersion < 332 Then 'Release 2.8.3
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 330 Then 'Release 2.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 323 Then 'Release 2.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 22
BugCount += 21
End If
If LastVersion < 321 Then 'Release 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 319 Then 'Release 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10
End If
#Else
'5: FEAT+
'4: IMP+ FEAT*
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 351 Then 'Snapshot 2.9.1
If LastVersion = 350 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:对导出整合包功能进行了 7 项优化,详见完整更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法进行第三方登录"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在部分版本下,打开导出页面会导致启动器崩溃"))
BugCount += 1
End If
BugCount += 2
End If
If LastVersion < 350 Then 'Snapshot 2.9.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:导出整合包功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:支持在超长路径下安装、启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 1.21 OptiFine"))
FeatureCount += 21
BugCount += 10
End If
If LastVersion < 348 Then 'Snapshot 2.8.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络环境不佳时,Mod、整合包页面的加载速度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:部分电脑无法打开程序"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法识别、更新 Mod"))
FeatureCount += 6
BugCount += 14
End If
If LastVersion < 346 Then 'Snapshot 2.8.12
If LastVersion = 345 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:帮助页面报错"))
End If
If LastVersion < 345 Then 'Snapshot 2.8.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 管理页面添加下载 Mod、安装 Mod 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 详情页面支持按加载器、游戏版本进行分类和筛选"))
FeatureCount += 23
BugCount += 21
End If
If LastVersion < 343 Then 'Snapshot 2.8.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 详情页面会按 Mod 加载器分类卡片"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装同时包含 modpack 文件和启动器的懒人包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化整合包导入流程"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:支持安装同时包含 modpack 文件和启动器的懒人包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:整合包导入流程"))
FeatureCount += 20
BugCount += 16
End If
If LastVersion < 341 Then 'Snapshot 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:搜索后启用/禁用 Mod 时出错"))
FeatureCount += 17
BugCount += 13
End If
If LastVersion < 339 Then 'Snapshot 2.8.8
If LastVersion = 337 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug"))
If LastVersion = 337 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
BugCount += 7
End If
If LastVersion < 337 Then 'Snapshot 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法加载部分 Mod 的图标"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在 Mod 管理页面删除 Mod 导致报错"))
FeatureCount += 11
BugCount += 21
End If
If LastVersion < 335 Then 'Snapshot 2.8.6
BugCount += 2
End If
If LastVersion < 334 Then 'Snapshot 2.8.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
If LastVersion = 333 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug"))
End If
FeatureCount += 6
BugCount += 7
End If
If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 13
BugCount += 17
End If
If LastVersion < 331 Then 'Snapshot 2.8.3
If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 329 Then 'Snapshot 2.8.2
If LastVersion >= 327 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Beta 版 NeoForge 的整合包的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复自动安装无法选择部分 OptiFine 的 Bug"))
End If
FeatureCount += 4
BugCount += 8
End If
If LastVersion < 328 Then 'Snapshot 2.8.1
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.12.2- 的 Bug"))
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 Bug"))
If LastVersion = 327 Then BugCount += 1
End If
If LastVersion < 327 Then 'Snapshot 2.8.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 11
BugCount += 14
End If
If LastVersion < 325 Then 'Snapshot 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 324 Then 'Snapshot 2.7.3
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
BugCount += 18
End If
If LastVersion < 320 Then 'Snapshot 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 318 Then 'Snapshot 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10
End If
#End If
'整理更新日志文本
Dim ContentList As New List(Of String)
@@ -295,10 +229,10 @@ Public Class FormMain
Height = MinHeight + 100
Width = MinWidth + 100
End Try
#If DEBUG Then
MinHeight = 50
MinWidth = 50
#End If
'#If DEBUG Then
' MinHeight = 50
' MinWidth = 50
'#End If
Topmost = False
If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
'更改窗口
@@ -329,7 +263,7 @@ Public Class FormMain
'EULA 提示
If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1
Setup.Set("SystemEula", True)
Case 2
@@ -343,6 +277,7 @@ Public Class FormMain
DlClientListMojangLoader.Start(1)
RunCountSub()
ServerLoader.Start(1)
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
End Try
@@ -443,7 +378,7 @@ Public Class FormMain
Log("[Start] 已从老版本迁移微软登录结果")
End If
'输出更新日志
If LastVersionCode = 0 Then Exit Sub
If LastVersionCode <= 0 Then Exit Sub
If LowerVersionCode >= VersionCode Then Exit Sub
ShowUpdateLog(LowerVersionCode)
End Sub
@@ -634,6 +569,7 @@ Public Class FormMain
End Sub
Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
'鼠标侧键返回上一级
If FrmMain.PanMsg.Children.Count > 0 OrElse WaitingMyMsgBox.Any Then Exit Sub '弹窗中(#5513)
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub
Private Sub TriggerPageBack()
@@ -782,47 +718,8 @@ Public Class FormMain
End Sub)
Exit Sub
End If
'Mod 安装
If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'检查回收站:回收站中的文件有错误的文件名
If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
Hint("请先将文件从回收站还原,再拖入 PCL!", HintType.Critical)
Exit Sub
End If
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
'正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
Try
For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
'刷新列表
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
End Try
End If
Exit Sub
End If
'安装 Mod
If PageVersionMod.InstallMods(FilePathList) Then Exit Sub
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
@@ -1003,6 +900,7 @@ Install:
VersionSetup = 1
VersionMod = 2
VersionModDisabled = 3
VersionExport = 4
End Enum
''' <summary>
''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
@@ -1063,9 +961,6 @@ Install:
Case PageType.Download
If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
Return FrmDownloadLeft.PageID
Case PageType.Link
If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
Return FrmLinkLeft.PageID
Case PageType.Setup
If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
Return FrmSetupLeft.PageID
@@ -1134,9 +1029,6 @@ Install:
CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "")
IsChangingPage = False
Select Case Stack.Page
Case PageType.Link
If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
Case PageType.Download
If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
@@ -1165,14 +1057,6 @@ Install:
If IsChangingPage Then Exit Sub
PageChangeActual(Val(sender.Tag))
End Sub
Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick
If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
"PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
"联机功能已暂时关闭", "查看详情", "确定") = 1 Then
OpenWebsite("https://www.bilibili.com/read/cv19845645")
End If
e.Handled = True
End Sub
''' <summary>
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
@@ -1203,9 +1087,9 @@ Install:
If PageStack.Any Then
'子页面 → 另一个子页面,更新
AniStart({
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer")
If PageStack.Contains(Stack) Then
'返回到更上层的子页面
@@ -1299,37 +1183,41 @@ Install:
AniControlEnabled -= 1
'执行动画
AniStart({
AaCode(Sub()
AniControlEnabled += 1
'把新页面添加进容器
PanMainLeft.Child = PageLeft
PageLeft.Opacity = 0
PanMainLeft.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
PageLeft.Opacity = 1
PageLeft.TriggerShowAnimation()
End Sub, 30, True)
AaCode(
Sub()
AniControlEnabled += 1
'把新页面添加进容器
PanMainLeft.Child = PageLeft
PageLeft.Opacity = 0
PanMainLeft.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
End Sub, 130),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
PageLeft.Opacity = 1
PageLeft.TriggerShowAnimation()
End Sub, 30, True)
}, "FrmMain PageChangeLeft")
AniStart({
AaCode(Sub()
AniControlEnabled += 1
CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
'把新页面添加进容器
PanMainRight.Child = PageRight
PageRight.Opacity = 0
PanMainRight.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
PageRight.Opacity = 1
PageRight.PageOnEnter()
End Sub, 30, True)
AaCode(
Sub()
AniControlEnabled += 1
CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
'把新页面添加进容器
PanMainRight.Child = PageRight
PageRight.Opacity = 0
PanMainRight.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
End Sub, 130),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
PageRight.Opacity = 1
PageRight.PageOnEnter()
End Sub, 30, True)
}, "FrmMain PageChangeRight")
End Sub
''' <summary>
@@ -1342,12 +1230,12 @@ Install:
PanTitleMain.IsHitTestVisible = True
PanTitleInner.IsHitTestVisible = False
AniStart({
AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Clear()
Else
'主页面 → 主页面,无事发生
@@ -1366,16 +1254,16 @@ Install:
If NewWidth > 0 Then
'宽度足够,显示
AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
Else
'宽度不足,隐藏
AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
End If
Else
+240 -45
View File
@@ -12,13 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.10" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.10." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.9.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.9.1." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 342 'Release
Public Const VersionCode As Integer = 352 'Release
#Else
Public Const VersionCode As Integer = 343 'Snapshot
Public Const VersionCode As Integer = 351 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -957,25 +957,25 @@ Public Module ModBase
''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
''' <param name="FileName">默认的文件名。</param>
Public Function SelectAs(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional DefaultDir As String = Nothing) As String
Public Function SelectSaveFile(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional InitialDirectory As String = Nothing) As String
Using fileDialog As New Forms.SaveFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
fileDialog.Title = Title
fileDialog.FileName = FileName
If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
If DefaultDir IsNot Nothing Then fileDialog.InitialDirectory = DefaultDir
If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
fileDialog.ShowDialog()
SelectAs = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
Log("[UI] 选择文件返回:" & SelectAs)
SelectSaveFile = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
Log("[UI] 选择文件返回:" & SelectSaveFile)
End Using
End Function
''' <summary>
''' 弹出选取文件对话框并且要求选取文件。
''' 弹出选取文件对话框,要求选择一个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
Public Function SelectFile(FileFilter As String, Title As String) As String
Public Function SelectFile(FileFilter As String, Title As String, Optional InitialDirectory As String = Nothing) As String
Using fileDialog As New Forms.OpenFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
@@ -984,13 +984,34 @@ Public Module ModBase
fileDialog.Multiselect = False
fileDialog.Title = Title
fileDialog.ValidateNames = True
If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
fileDialog.ShowDialog()
SelectFile = fileDialog.FileName
Log("[UI] 选择文件返回:" & SelectFile)
Log("[UI] 选择单个文件返回:" & fileDialog.FileName)
Return fileDialog.FileName
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框并且要求选取文件夹,以 \ 结尾。如果没有选择就返回空字符串。
''' 弹出选取文件对话框,要求选择多个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
Public Function SelectFiles(FileFilter As String, Title As String) As String()
Using fileDialog As New Forms.OpenFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
fileDialog.CheckFileExists = True
fileDialog.Filter = FileFilter
fileDialog.Multiselect = True
fileDialog.Title = Title
fileDialog.ValidateNames = True
fileDialog.ShowDialog()
Log("[UI] 选择多个文件返回:" & fileDialog.FileNames.Join(","))
Return fileDialog.FileNames
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框,要求选取文件夹。
''' 返回以 \ 结尾的完整路径,如果没有选择则返回空字符串。
''' </summary>
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
@@ -1060,6 +1081,37 @@ Re:
End Try
End Function
''' <summary>
''' 获取文件 SHA512,若失败则返回空字符串。
''' </summary>
Public Function GetFileSHA512(FilePath As String) As String
Dim Retry As Boolean = False
Re:
Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA512
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha512 As SHA512 = New SHA512CryptoServiceProvider()
Dim retval As Byte() = sha512.ComputeHash(file)
file.Close()
Dim Result As New StringBuilder()
For i As Integer = 0 To retval.Length - 1
Result.Append(retval(i).ToString("x2"))
Next
Return Result.ToString
Catch ex As Exception
If Retry OrElse TypeOf ex Is FileNotFoundException Then
Log(ex, "获取文件 SHA512 失败:" & FilePath)
Return ""
Else
Retry = True
Log(ex, "获取文件 SHA512 可重试失败:" & FilePath, LogLevel.Normal)
Thread.Sleep(RandomInteger(200, 500))
GoTo Re
End If
End Try
End Function
''' <summary>
''' 获取文件 SHA256,若失败则返回空字符串。
''' </summary>
Public Function GetFileSHA256(FilePath As String) As String
@@ -1070,8 +1122,8 @@ Re:
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA256
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA256 = New SHA256CryptoServiceProvider()
Dim retval As Byte() = sha1.ComputeHash(file)
Dim sha256 As SHA256 = New SHA256CryptoServiceProvider()
Dim retval As Byte() = sha256.ComputeHash(file)
file.Close()
Dim Result As New StringBuilder()
For i As Integer = 0 To retval.Length - 1
@@ -1120,7 +1172,7 @@ Re:
End Try
End Function
''' <summary>
''' 获取流 SHA1,若失败则返回空字符串。
''' 获取流的 SHA1,若失败则返回空字符串。
''' </summary>
Public Function GetAuthSHA1(Stream As Stream) As String
Try
@@ -1312,11 +1364,22 @@ RetryDir:
''' 遍历文件夹中的所有文件。
''' </summary>
Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
Dim Info As New DirectoryInfo(Directory)
Dim Info As New DirectoryInfo(ShortenPath(Directory))
If Not Info.Exists Then Return New List(Of FileInfo)
Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
End Function
''' <summary>
''' 若路径长度大于指定值,则将长路径转换为短路径。
''' </summary>
Public Function ShortenPath(LongPath As String, Optional ShortenThreshold As Integer = 247) As String
If LongPath.Length <= ShortenThreshold Then Return LongPath
Dim ShortPath As New StringBuilder(260)
GetShortPathName(LongPath, ShortPath, 260)
Return ShortPath.ToString
End Function
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As StringBuilder, ByVal cchBuffer As Integer) As Integer
#End Region
#Region "文本"
@@ -1326,8 +1389,8 @@ RetryDir:
''' <summary>
''' 提取 Exception 的具体描述与堆栈。
''' </summary>
''' <param name="ShowAllTrace">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllTrace As Boolean = False) As String
''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
If Ex Is Nothing Then Return "无可用错误信息!"
'获取最底层的异常
@@ -1338,19 +1401,20 @@ RetryDir:
'获取各级错误的描述与堆栈信息
Dim DescList As New List(Of String)
Dim StackList As New List(Of String)
Dim IsInner As Boolean = False
Do Until Ex Is Nothing
DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
DescList.Add(If(IsInner, "→ ", "") & Ex.Message.Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
If Ex.StackTrace IsNot Nothing Then
For Each St As String In Ex.StackTrace.Split(vbCrLf)
If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then StackList.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
For Each Stack As String In Ex.StackTrace.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
If ShowAllStacks OrElse Stack.ContainsF("pcl", True) Then
DescList.Add(Stack.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
End If
Next
End If
If Ex.GetType.FullName <> "System.Exception" Then DescList.Add(" 错误类型:" & Ex.GetType.FullName)
Ex = Ex.InnerException
IsInner = True
Loop
DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")
'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
@@ -1363,20 +1427,15 @@ RetryDir:
ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
CommonReason = "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
End If
'获取错误类型
Dim TypeDesc As String = If(InnerEx.GetType.FullName = "System.Exception", "", vbCrLf & "错误类型:" & InnerEx.GetType.FullName)
'构造输出信息
If CommonReason Is Nothing Then
Return Desc & Stack & TypeDesc
Return DescList.Join(vbCrLf)
Else
Dim Result As String = CommonReason & vbCrLf & DescList.First & vbCrLf & "————————————" & vbCrLf
DescList(0) = "详细错误信息:"
Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc
Return CommonReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
End If
End Function
''' <summary>
@@ -1420,7 +1479,7 @@ RetryDir:
Return CommonReason & "详细错误:" & DescList.First
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
Return Join(DescList, " ← ")
End If
End Function
@@ -1698,6 +1757,21 @@ RetryDir:
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
''' <summary>
''' 为字符串进行 Like 关键字转义。
''' </summary>
Public Function EscapeLikePattern(input As String) As String
Dim sb As New StringBuilder()
For Each c As Char In input
Select Case c
Case "["c, "]"c, "*"c, "?"c, "#"c
sb.Append("["c).Append(c).Append("]"c)
Case Else
sb.Append(c)
End Select
Next
Return sb.ToString()
End Function
'正则
''' <summary>
@@ -1880,6 +1954,8 @@ RetryDir:
''' </summary>
Public Class SafeList(Of T)
Inherits SynchronizedCollection(Of T)
Implements IEnumerable, IEnumerable(Of T)
'构造函数
Public Sub New()
MyBase.New()
End Sub
@@ -1892,7 +1968,13 @@ RetryDir:
Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T)
Return New List(Of T)(Data)
End Operator
Public Overloads Function GetEnumerator() As IEnumerator(Of T)
'基于 SyncLock 覆写
Public Overloads Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
End Function
Private Overloads Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
@@ -1947,10 +2029,10 @@ RetryDir:
End Function
''' <summary>
''' 判断当前系统语言是否为中文。
''' 判断当前系统语言是否为 zh-CN。
''' </summary>
Public Function IsSystemLanguageChinese() As Boolean
Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
Return CultureInfo.CurrentCulture.Name = "zh-CN" OrElse CultureInfo.CurrentUICulture.Name = "zh-CN"
End Function
Private Uuid As Integer = 1
@@ -2048,7 +2130,7 @@ NextElement:
GetTimeSpanString = TotalMonthes & " 个月"
ElseIf TotalMonthes >= 1 Then
'1~4 月,“2 个月 13 天”
GetTimeSpanString = TotalMonthes & " 个月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
ElseIf Span.TotalDays >= 4 Then
'4~30 天,“23 天”
GetTimeSpanString = Span.Days & " 天"
@@ -2102,6 +2184,7 @@ NextElement:
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
FileName = ShortenPath(FileName)
Using Program As New Process
Program.StartInfo.Arguments = Arguments
Program.StartInfo.FileName = FileName
@@ -2147,7 +2230,7 @@ NextElement:
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = If(WorkingDirectory, Path.TrimEnd("\"c))
.WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c)))
}
If WorkingDirectory IsNot Nothing Then
If Info.EnvironmentVariables.ContainsKey("appdata") Then
@@ -2256,6 +2339,27 @@ NextElement:
Return New List(Of T)(list)
End Function
''' <summary>
''' 尝试从字典中获取某项,如果该项不存在,则返回默认值。
''' </summary>
<Extension> Public Function GetOrDefault(Of TKey, TValue)(Dict As Dictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue
If Dict.ContainsKey(Key) Then
Return Dict(Key)
Else
Return DefaultValue
End If
End Function
''' <summary>
''' 将某项添加到以列表作为值的字典中。
''' </summary>
<Extension> Public Sub AddToList(Of TKey, TValue)(Dict As Dictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
If Dict.ContainsKey(Key) Then
Dict(Key).Add(Value)
Else
Dict.Add(Key, New List(Of TValue) From {Value})
End If
End Sub
''' <summary>
''' 获取程序启动参数。
''' </summary>
@@ -2305,11 +2409,18 @@ NextElement:
End Try
End Sub
''' <summary>
''' 打开 explorer。注意参数中的路径要尽量加上双引号!
''' 打开 explorer。
''' 若不以 \ 结尾,则将视作文件路径,打开并选中此文件。
''' </summary>
Public Sub OpenExplorer(Argument As String)
Public Sub OpenExplorer(Location As String)
Try
ShellOnly("explorer.exe", Argument)
Location = ShortenPath(Location.Replace("/", "\").Trim(" "c, """"c))
Log("[System] 正在打开资源管理器:" & Location)
If Location.EndsWith("\") Then
ShellOnly(Location)
Else
ShellOnly("explorer", $"/select,""{Location}""")
End If
Catch ex As Exception
Log(ex, "打开资源管理器失败,请尝试关闭安全软件(如 360 安全卫士)", LogLevel.Msgbox)
End Try
@@ -2760,7 +2871,7 @@ Retry:
On Error Resume Next
FeedbackInfo()
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
OpenExplorer("""" & Path & "PCL\""")
OpenExplorer(Path & "PCL\Log1.txt")
End If
OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
End Sub
@@ -2836,4 +2947,88 @@ Retry:
#End Region
End Module
End Module
#Region "WPF"
''' <summary>
''' 对数据绑定进行加法运算,使用参数决定加数。
''' </summary>
Public Class AdditionConverter
Implements IValueConverter
Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
If value Is Nothing Then Return 0
Dim before As Double
If Not Double.TryParse(value.ToString(), before) Then Return 0
Dim scale As Double = 1
If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
Return before + scale
End Function
Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
If value Is Nothing Then Return Binding.DoNothing
Dim before As Double
If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
Dim scale As Double = 1
If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
If scale = 0 Then Return Binding.DoNothing
Return before - scale
End Function
End Class
''' <summary>
''' 对数据绑定进行乘法运算,使用参数决定乘数。
''' </summary>
Public Class MultiplicationConverter
Implements IValueConverter
Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
If value Is Nothing Then Return 0
Dim before As Double
If Not Double.TryParse(value.ToString(), before) Then Return 0
Dim scale As Double = 1
If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
Return before * scale
End Function
Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
If value Is Nothing Then Return Binding.DoNothing
Dim before As Double
If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
Dim scale As Double = 1
If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
If scale = 0 Then Return Binding.DoNothing
Return before / scale
End Function
End Class
''' <summary>
''' 将取反的 Boolean 绑定到 Visibility。
''' </summary>
Public Class InverseBooleanToVisibilityConverter
Implements IValueConverter
Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
If value Is Nothing Then Return Visibility.Visible
Dim boolValue As Boolean
Return If(Boolean.TryParse(value.ToString(), boolValue), If(boolValue, Visibility.Collapsed, Visibility.Visible), Visibility.Visible)
End Function
Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
If value Is Nothing Then Return False
Return If(TypeOf value Is Visibility, value <> Visibility.Visible, False)
End Function
End Class
''' <summary>
''' 将 Boolean 取反。
''' </summary>
Public Class InverseBooleanConverter
Implements IValueConverter
Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
If value Is Nothing Then Return False
Dim boolValue As Boolean
Return If(Boolean.TryParse(value.ToString(), boolValue), Not boolValue, False)
End Function
Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
If value Is Nothing Then Return False
Return If(Boolean.TryParse(value.ToString(), value), Not value, False)
End Function
End Class
#End Region
@@ -315,23 +315,26 @@
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已" & If(IsForceRestarting, "强制", "") & "启动")
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsAborted Then
Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束,输出被弃用(最新线程:" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & ")", LogLevel.Developer)
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Else
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效
End If
Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted
Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断")
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Exit Sub
Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer)
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
End Try
@@ -347,7 +350,7 @@
End Sub
Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Exit Sub
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断")
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
LastRunningThread = Nothing
End Sub
+43 -13
View File
@@ -220,12 +220,12 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Url">网页的 Url。</param>
Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Public Function NetGetCodeByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & ")")
NetGetCodeByDownload = ReadFile(Temp)
NetGetCodeByLoader = ReadFile(Temp)
File.Delete(Temp)
Finally
NewTask.Abort()
@@ -235,12 +235,12 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Urls">网页的 Url 列表。</param>
Public Function NetGetCodeByDownload(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Public Function NetGetCodeByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls.First & ")")
NetGetCodeByDownload = ReadFile(Temp)
NetGetCodeByLoader = ReadFile(Temp)
File.Delete(Temp)
Finally
NewTask.Abort()
@@ -248,13 +248,12 @@ RequestFinished:
End Function
''' <summary>
''' 从网络中直接下载文件。这不能下载 CDN 中的文件。
''' 使用 WebClient 从网络中下载文件。这不能下载 CDN 中的文件。
''' </summary>
''' <param name="Url">网络 Url。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownload(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
Public Sub NetDownloadByClient(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
Log("[Net] 直接下载文件:" & Url)
'初始化
Try
'建立目录
@@ -262,9 +261,8 @@ RequestFinished:
'尝试删除原文件
File.Delete(LocalFile)
Catch ex As Exception
Throw New WebException("预处理下载文件路径失败(" & LocalFile & ")。", ex)
Throw New WebException($"预处理下载文件路径失败({LocalFile})", ex)
End Try
'下载
Using Client As New WebClient
Try
@@ -272,10 +270,41 @@ RequestFinished:
Client.DownloadFile(Url, LocalFile)
Catch ex As Exception
File.Delete(LocalFile)
Throw New WebException("直接下载文件失败(" & Url & ")。", ex)
Throw New WebException($"直接下载文件失败({Url})", ex)
End Try
End Using
End Sub
''' <summary>
''' 简单的多线程下载文件。可以下载 CDN 中的文件。
''' </summary>
''' <param name="Url">文件的 Url。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownloadByLoader(Url As String, LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, LocalFile, Check, UseBrowserUserAgent)})
Try
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败({Url})", ex)
Finally
NewTask.Abort()
End Try
End Sub
''' <summary>
''' 简单的多线程下载文件。可以下载 CDN 中的文件。
''' </summary>
''' <param name="Urls">文件的 Url 列表。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, LocalFile, Check, UseBrowserUserAgent)})
Try
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex)
Finally
NewTask.Abort()
End Try
End Sub
''' <summary>
@@ -930,7 +959,7 @@ RequestFinished:
'条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
@@ -1819,6 +1848,7 @@ Retry:
Private Sub RefreshStat()
Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
If DeltaTime = 0 Then Return
RefreshStatLast += DeltaTime
#Region "刷新整体速度"
'计算瞬时速度
@@ -1884,7 +1914,7 @@ Retry:
For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
Next
'为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
@@ -1904,7 +1934,7 @@ Retry:
'新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
Next
End While
Catch ex As Exception
@@ -360,6 +360,16 @@
'Tags & ModLoaders
Tags = New List(Of String)
ModLoaders = New List(Of CompModLoaderType)
If Data.ContainsKey("loaders") Then
For Each Category In Data("loaders").Select(Function(t) t.ToString)
Select Case Category
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
End Select
Next
End If
For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category
'加载器
@@ -392,7 +402,7 @@
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("大杂烩")
Case "kitchen-sink" : Tags.Add("水槽包/大杂烩")
Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res
End Select
@@ -435,7 +445,7 @@
'获取版本描述
Dim GameVersionDescription As String
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
GameVersionDescription = "未知"
GameVersionDescription = "仅快照版本" '#5412
Else
Dim SpaVersions As New List(Of String)
Dim IsOld As Boolean = False
@@ -458,14 +468,14 @@
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
If EndVersion <= 10 Then
If EndVersion < 10 Then
SpaVersions.Clear()
SpaVersions.Add("全版本")
Exit For
Else
SpaVersions.Add("1." & EndVersion & "+")
End If
ElseIf EndVersion <= 10 Then
ElseIf EndVersion < 10 Then
SpaVersions.Add("1." & StartVersion & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
@@ -478,25 +488,32 @@
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Select Case ModLoaders.Count
Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
Select Case ModLoadersForDesc.Count
Case 0
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
If ModLoaders.Count = 1 Then
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
End If
Case 1
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Case 2, 3
If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else
Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99)
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
ModLoaderDescriptionFull = ModLoaders.Join(" / ")
ModLoaderDescriptionPart = ModLoaders.Join(" / ")
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
End If
Case Else
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
End Select
'实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
@@ -1067,7 +1084,7 @@ Retry:
If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Task.Input.CanContinue Then
If Task.Input.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
Log("[Comp] 将继续尝试加载下一页")
GoTo Retry
Else
@@ -1156,7 +1173,7 @@ Retry:
''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <summary>
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
''' </summary>
Public ReadOnly GameVersions As List(Of String)
''' <summary>
@@ -1257,10 +1274,7 @@ Retry:
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies
@@ -1272,7 +1286,7 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1313,7 +1327,7 @@ Retry:
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1335,6 +1349,19 @@ Retry:
End If
End If
End Sub
''' <summary>
''' 重新整理 CurseForge 的下载地址。
''' </summary>
Public Shared Function HandleCurseForgeDownloadUrls(Url As String) As List(Of String)
Return {
Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url
}.Distinct.ToList
End Function
''' <summary>
''' 将当前实例转为可用于保存缓存的 Json。
''' </summary>
@@ -1420,14 +1447,12 @@ Retry:
''' <summary>
''' 已知文件信息的缓存。
''' </summary>
Private CompFilesCache As New Dictionary(Of String, List(Of CompFile))
Public CompFilesCache As New Dictionary(Of String, List(Of CompFile))
''' <summary>
''' 获取某个工程下的全部文件列表。
''' 必须在工作线程执行,失败会抛出异常。
''' </summary>
Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
'使用缓存
If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
'获取工程对象
Dim TargetProject As CompProject
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
@@ -1438,25 +1463,26 @@ Retry:
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If
'获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId)
Dim ResultJsonArray As JArray
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回,这时候前置 Mod 可能没获取(#5173)
Log("[Comp] 开始获取文件列表:" & ProjectId)
Dim ResultJsonArray As JArray
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If
Else
'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If
Else
'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
'获取前置 Mod 列表
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
Dim Deps As List(Of String) = CompFilesCache(ProjectId).
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息
If UndoneDeps.Any Then
@@ -1477,7 +1503,7 @@ Retry:
For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId)
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
File.Dependencies.Add(DepProject.Id)
If Not File.Dependencies.Contains(DepProject.Id) Then File.Dependencies.Add(DepProject.Id)
End If
Next
Next
@@ -1,24 +1,10 @@
Public Class CrashAnalyzer
Private Shared IsAnalyzeCacheCleared As Boolean = False
Private Shared IsAnalyzeCacheClearedLock As New Object
'构造函数
Private TempFolder As String
Public Sub New(UUID As Integer)
'清理缓存
SyncLock IsAnalyzeCacheClearedLock
If Not IsAnalyzeCacheCleared Then
Try
DeleteDirectory(PathTemp & "CrashAnalyzer\")
Catch ex As Exception
Log(ex, "清理崩溃分析缓存失败")
End Try
IsAnalyzeCacheCleared = True
End If
End SyncLock
'构建文件结构
TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\"
DeleteDirectory(TempFolder)
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹:" & TempFolder)
@@ -873,7 +859,7 @@ NextStack:
Sub()
'弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key)
ShellOnly(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
@@ -885,7 +871,7 @@ NextStack:
Dim FileAddress As String = Nothing
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Exit Sub
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
@@ -923,7 +909,7 @@ NextStack:
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Exit Sub
End Try
OpenExplorer("/select,""" & FileAddress & """")
OpenExplorer(FileAddress)
End Select
End Sub
''' <summary>
@@ -167,24 +167,25 @@
End Structure
''' <summary>
''' Minecraft 客户端 版本列表,主加载器。
''' 若要求镜像源必须包含某个版本,则将该版本 ID 作为输入(#5195)。
''' </summary>
Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -193,9 +194,9 @@
''' <summary>
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
@@ -225,14 +226,21 @@
''' <summary>
''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
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 & ")")
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'检查是否有要求的版本(#5195)
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
End If
End If
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
@@ -245,26 +253,31 @@
''' </summary>
Public Function DlClientListGet(Id As String)
Try
'确认 Minecraft 版本列表已完成获取
Select Case DlClientListLoader.State
Case LoadState.Loading
DlClientListLoader.WaitForExit()
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(IsForceRestart:=True)
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始
'获取 Minecraft 版本列表
Select Case DlClientListLoader.State
Case LoadState.Finished
'从当前的结果获取目标版本…
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
'…如果没有,则重新尝试获取(在版本刚更新时可能出现这种情况,#5195)
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
Return Version("url").ToString
End If
If Version("id") = Id Then Return Version("url").ToString
Next
Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
Log($"未发现版本 {Id} 的 json 下载地址,版本列表返回为:{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug)
Return Nothing
Catch ex As Exception
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败")
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -337,17 +350,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -443,17 +456,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -588,17 +601,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -609,7 +622,7 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Result = NetGetCodeByLoader("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
@@ -795,17 +808,17 @@
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)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 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)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30)
}, 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)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -816,8 +829,8 @@
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)
Dim ResultLatest As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByLoader("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
@@ -834,8 +847,8 @@
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)
Dim ResultLatest As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByLoader("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
@@ -920,17 +933,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -1019,17 +1032,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -1082,42 +1095,30 @@
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequest。
''' 调用 NetGetCodeByRequest,会进行重试。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
'TODO: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
'Dim McimUrl As String = DlSourceModGet(Url)
'If McimUrl <> Url Then
' Select Case Setup.Get("ToolDownloadMod")
' Case 0
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Case Else
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' End Select
'End If
Dim Exs As String = ""
For Each Source In Urls
Try
@@ -1131,42 +1132,30 @@
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequest。
''' 调用 NetRequest,会进行重试。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
'TODO: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
'Dim McimUrl As String = DlSourceModGet(Url)
'If McimUrl <> Url Then
' Select Case Setup.Get("ToolDownloadMod")
' Case 0
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Case Else
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' End Select
'End If
Dim Exs As String = ""
For Each Source In Urls
Try
@@ -1194,28 +1183,42 @@
End Function
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
}
If {"minecraftforge", "fabricmc", "neoforged"}.Any(Function(k) Original.Contains(k)) Then '不添加原版源
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")
}
Else
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 If
End Function
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")
Return Original
'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()
@@ -1235,71 +1238,63 @@
Optional IsForceRestart As Boolean = False)
Dim WaitCycle As Integer = 0
Do While True
'检查加载结束
Dim IsAllFailed As Boolean = True
'检查状态
Dim BeforeLoadersAllFailed As Boolean = True
For Each SubLoader In LoaderList
If WaitCycle = 0 Then
'如果要强制刷新,就不使用已经加载好的值
If IsForceRestart Then Exit For
'如果输入不一样,就不使用已经加载好的值
If WaitCycle = 0 Then '判断是否可以不加载,直接使用已经加载好的结果
If IsForceRestart Then Continue For '强制刷新,不行
If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样,也不行
End If
If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False
If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList)
Exit Sub
ElseIf IsAllFailed Then
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
End If
'由于 Forge BMCLAPI 没有可用版本导致强制失败
'在没有可用版本时,官方源会一直卡住,直接使用 BMCLAPI 判定失败即可
If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
For Each SubLoader2 In LoaderList
If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
Next
End If
Next
'启动加载源
'第一轮时:既然不直接使用已经加载好的结果,那就启动第一个加载器
If WaitCycle = 0 Then
'启动第一个源
LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart)
'将其他源标记为未启动,以确保可以切换下载源(#184)
For i = 1 To LoaderList.Count - 1
LoaderList(i).Key.State = LoadState.Waiting
LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart)
For Each Loader In LoaderList.Skip(1)
Loader.Key.State = LoadState.Waiting '将其他源标记为未启动,以确保可以切换下载源(#184)
Next
End If
'检查加载器失败或超时
For i = 0 To LoaderList.Count - 1
If WaitCycle = LoaderList(i).Value * 100 Then
If i < LoaderList.Count - 1 Then
'启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
If WaitCycle <> LoaderList(i).Value * 100 Then Continue For
If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then
'若还有下一个源,则启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'若没有,则失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
Next
'计时
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
Exit Sub
End If
Thread.Sleep(10)
WaitCycle += 1
Loop
End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
@@ -489,16 +489,18 @@ NoUserJava:
Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
If FrmSetupLaunch IsNot Nothing Then
RunInUiWait(Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
If FrmVersionSetup IsNot Nothing Then
RunInUiWait(Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
Try
@@ -520,6 +522,7 @@ NoUserJava:
Next
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 APPDATA 文件夹中的 Java
@@ -650,7 +653,7 @@ Wait:
Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try
Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找:" & OriginalPath)
JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath)
Catch ex As Exception
@@ -738,7 +741,7 @@ Wait:
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(
Dim IndexFileStr As String = NetGetCodeByLoader(
{"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)
@@ -750,7 +753,7 @@ Wait:
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", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
Dim ListFileStr As String = NetGetCodeByLoader({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")
@@ -225,9 +225,9 @@ NextInner:
Select Case Setup.Get("SystemLaunchCount")
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
"如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
"如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
Setup.Get("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
@@ -236,15 +236,18 @@ NextInner:
'正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If IsSystemLanguageChinese() Then
Select Case Setup.Get("SystemLaunchCount")
Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
"如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
"在你登录一次正版账号后,就不会再出现这个提示了!",
"考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End If
End Select
RunInNewThread(
Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 3, 8, 15, 30, 50, 70, 90, 110, 130, 180, 220, 280, 330, 380, 450, 550, 660, 750, 880, 950, 1100, 1300, 1500, 1700, 1900
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
"如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf &
"在登录一次正版账号后,就不会再出现这个提示了!",
"考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End If
End Select
End Sub, "Buy Minecraft")
ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
@@ -571,7 +574,7 @@ SkipLogin:
End Sub
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
Dim Input As McLoginServer = Data.Input
Dim NeedRefresh As Boolean = False
Dim NeedRefresh As Boolean = False, WasRefreshed As Boolean = False
Dim LogUsername As String = Input.UserName
If LogUsername.Contains("@") AndAlso Setup.Get("UiLauncherEmail") Then
LogUsername = AccountFilter(LogUsername)
@@ -592,7 +595,7 @@ SkipLogin:
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
Dim AllMessage = GetExceptionSummary(ex)
Dim AllMessage = GetExceptionDetail(ex)
McLaunchLog("验证登录失败:" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败")
@@ -607,7 +610,8 @@ Refresh:
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
McLaunchLog("刷新登录失败:" & GetExceptionSummary(ex))
McLaunchLog("刷新登录失败:" & GetExceptionDetail(ex))
If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
End Try
Data.Progress = If(NeedRefresh, 0.85, 0.45)
End If
@@ -616,10 +620,12 @@ Refresh:
If Data.IsAborted Then Throw New ThreadInterruptedException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败:" & GetExceptionSummary(ex))
McLaunchLog("登录失败:" & GetExceptionDetail(ex))
Throw
End Try
If NeedRefresh Then
McLaunchLog("重新进行刷新登录")
WasRefreshed = True
Data.Progress = 0.65
GoTo Refresh
End If
@@ -683,7 +689,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/validate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8") '没有返回值的
'将登录结果输出
Data.Output.AccessToken = AccessToken
@@ -699,15 +705,15 @@ LoginFinish:
Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:=Data.Input.BaseUrl & "/refresh",
Method:="POST",
Data:="{" &
If(RequestUser, "
""requestUser"": true,
""selectedProfile"": {
""id"":""" & Setup.Get("Cache" & Data.Input.Token & "Uuid") & """,
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
Data:=New JObject(
New JProperty("selectedProfile", New JObject(
New JProperty("name", Setup.Get($"Cache{Data.Input.Token}Name")),
New JProperty("id", Setup.Get($"Cache{Data.Input.Token}Uuid"))
)),
New JProperty("accessToken", Setup.Get($"Cache{Data.Input.Token}Access")),
New JProperty("requestUser", True)
).ToString(Newtonsoft.Json.Formatting.None),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
@@ -738,7 +744,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8"))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
@@ -763,17 +769,18 @@ LoginFinish:
'缓存无效,要求玩家选择
If SelectedName Is Nothing Then
McLaunchLog("要求玩家选择角色")
RunInUiWait(Sub()
Dim SelectionControl As New List(Of IMyRadio)
Dim SelectionJson As New List(Of JToken)
For Each Profile In LoginJson("availableProfiles")
SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
SelectionJson.Add(Profile)
Next
Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
SelectedName = SelectionJson(SelectedIndex)("name").ToString
SelectedId = SelectionJson(SelectedIndex)("id").ToString
End Sub)
RunInUiWait(
Sub()
Dim SelectionControl As New List(Of IMyRadio)
Dim SelectionJson As New List(Of JToken)
For Each Profile In LoginJson("availableProfiles")
SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
SelectionJson.Add(Profile)
Next
Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
SelectedName = SelectionJson(SelectedIndex)("name").ToString
SelectedId = SelectionJson(SelectedIndex)("id").ToString
End Sub)
McLaunchLog("玩家选择的角色:" & SelectedName)
End If
Else
@@ -805,7 +812,19 @@ LoginFinish:
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败:" & ErrorMessage)
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then
'密码错误,退出登录 (#5090)
McLaunchLog("密码错误,退出登录")
Select Case Data.Input.Type
Case McLoginType.Auth
RunInUi(AddressOf PageLoginAuthSkin.ExitLogin)
Case McLoginType.Nide
RunInUi(AddressOf PageLoginNideSkin.ExitLogin)
End Select
End If
Throw New Exception("$登录失败:" & ErrorMessage)
End If
End If
'通用关键字检测
If AllMessage.Contains("403") Then
@@ -1055,7 +1074,8 @@ Retry:
Case 3
'使用正版用户名
Try
If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
If SkinName <> "" AndAlso
McVersionCurrent IsNot Nothing AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
@@ -1612,16 +1632,16 @@ NextVersion:
'基础参数
GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", GetNativesFolder())
GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder()))
GameArguments.Add("${library_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${launcher_name}", "PCL")
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))
GameArguments.Add("${game_directory}", Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1))
GameArguments.Add("${assets_root}", PathMcFolder & "assets")
GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
GameArguments.Add("${user_properties}", "{}")
GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1643,8 +1663,11 @@ NextVersion:
GameSize = New Size(875 - 2, 540 - 2)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then
'修复 #3463:1.12.2-,JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍
McLaunchLog($"已应用窗口大小过大修复({McLaunchJavaSelected.Version.Revision})")
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
End If
@@ -1652,7 +1675,7 @@ NextVersion:
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数
GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${game_assets}", ShortenPath(PathMcFolder & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
'支持库参数
@@ -1669,7 +1692,7 @@ NextVersion:
End If
Next
If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp)
GameArguments.Add("${classpath}", Join(CpStrings, ";"))
GameArguments.Add("${classpath}", Join(CpStrings.Select(Function(c) ShortenPath(c)), ";"))
Return GameArguments
End Function
@@ -2030,8 +2053,8 @@ IgnoreCustomSkin:
"@echo off" & vbCrLf &
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
"echo 游戏正在启动,请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
"set APPDATA=""" & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
"cd /D """ & ShortenPath(McVersionCurrent.PathIndie) & """" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
@@ -2042,7 +2065,7 @@ IgnoreCustomSkin:
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程")
AbortHint = "导出启动脚本成功!"
OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
OpenExplorer(CurrentLaunchOptions.SaveBatch)
Loader.Parent.Abort()
Exit Sub '导出脚本完成
End If
@@ -2058,7 +2081,7 @@ IgnoreCustomSkin:
Try
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """"
CustomProcess.StartInfo.WorkingDirectory = PathMcFolder
CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
@@ -2082,7 +2105,7 @@ IgnoreCustomSkin:
Try
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """"
CustomProcess.StartInfo.WorkingDirectory = PathMcFolder
CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder)
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
@@ -2110,18 +2133,18 @@ IgnoreCustomSkin:
'设置环境变量
If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then
StartInfo.EnvironmentVariables("appdata") = PathMcFolder
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
Else
StartInfo.EnvironmentVariables.Add("appdata", PathMcFolder)
StartInfo.EnvironmentVariables.Add("appdata", ShortenPath(PathMcFolder))
End If
Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
Paths.Add(McLaunchJavaSelected.PathFolder)
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数
StartInfo.StandardErrorEncoding = Encoding.UTF8
StartInfo.StandardOutputEncoding = Encoding.UTF8
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
StartInfo.RedirectStandardError = True
@@ -73,7 +73,8 @@ Public Module ModMinecraft
End If
Dim Name As String = Folder.Split(">")(0)
Dim Path As String = Folder.Split(">")(1)
If CheckPermission(Path) Then
Try
CheckPermissionWithException(Path)
'若已有该文件夹,则直接重命名;没有则添加
Dim Renamed As Boolean = False
For Each OriginalFolder As McFolder In CacheMcFolderList
@@ -84,9 +85,10 @@ Public Module ModMinecraft
End If
Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
Else
Hint("无效的 Minecraft 文件夹:" & Path, HintType.Critical)
End If
Catch ex As Exception
MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
End Try
Next
'将自定义文件夹情况同步到设置
@@ -482,17 +484,27 @@ VersionSearchFinish:
Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
End Function
If _JsonText Is Nothing Then
If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
_JsonText = ReadFile(Path & Name & ".json")
Dim JsonPath As String = Path & Name & ".json"
If Not File.Exists(JsonPath) Then
'如果文件夹下只有一个 JSON 文件,则将其作为版本 JSON
Dim JsonFiles As String() = Directory.GetFiles(Path, "*.json")
If JsonFiles.Count = 1 Then
JsonPath = JsonFiles(0)
Log("[Minecraft] 未找到同名版本 JSON,自动换用 " & JsonPath, LogLevel.Debug)
Else
Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
End If
End If
_JsonText = ReadFile(JsonPath)
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
GetJson(_JsonText) '触发异常
Else
Log("[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
Log($"[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})", LogLevel.Debug)
Thread.Sleep(2000)
_JsonText = ReadFile(Path & Name & ".json")
_JsonText = ReadFile(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
End If
End If
@@ -779,37 +791,7 @@ ExitDataLoad:
End If
'确定版本描述
Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
If CustomInfo = "" Then
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
Else
Info = "快照 " & Version.McName
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Case McVersionState.Error
'已有错误信息
Case Else
Info = "发生了未知错误,请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If HasJumpLoader Then Info += ", JumpLoader"
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Else
Info = CustomInfo
End If
Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
'确定版本收藏状态
IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
'确定版本显示种类
@@ -842,6 +824,41 @@ ExitDataLoad:
End Try
Return Me
End Function
''' <summary>
''' 获取版本的默认描述。
''' </summary>
Public Function GetDefaultDescription() As String
Dim Info As String = ""
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
Else
Info = "快照 " & Version.McName
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Case McVersionState.Error
Return Me.Info '已有错误信息
Case Else
Info = "发生了未知错误,请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If HasJumpLoader Then Info += ", JumpLoader"
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Return Info
End Function
Public IsLoaded As Boolean = False
Public Overrides Function Equals(obj As Object) As Boolean
@@ -1123,10 +1140,10 @@ Reload:
McVersionList = McVersionListLoadNoCache(Path)
End If
IsFirstMcVersionListLoad = False
If Loader.IsAborted Then Exit Sub
'改变当前选择的版本
OnLoaded:
If Loader.IsAborted Then Exit Sub
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
@@ -1619,7 +1636,7 @@ OnLoaded:
Dim FileAddress As String = PathTemp & "Cache\Skin\" & GetHash(Address) & ".png"
SyncLock McSkinDownloadLock
If Not File.Exists(FileAddress) Then
NetDownload(Address, FileAddress & NetDownloadEnd)
NetDownloadByClient(Address, FileAddress & NetDownloadEnd)
File.Delete(FileAddress)
FileSystem.Rename(FileAddress & NetDownloadEnd, FileAddress)
Log("[Minecraft] 皮肤下载成功:" & FileAddress)
@@ -1962,7 +1979,7 @@ OnLoaded:
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetGetCodeByDownload({
DownloadInfo = GetJson(NetGetCodeByLoader({
"https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
@@ -1985,7 +2002,7 @@ OnLoaded:
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({
DownloadInfo = GetJson(NetGetCodeByLoader({
"https://authlib-injector.yushi.moe/artifact/latest.json",
"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
}, IsJson:=True))
@@ -2037,8 +2054,12 @@ OnLoaded:
If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
'文件不符合,添加下载
Dim Urls As New List(Of String)
If Token.Url Is Nothing AndAlso Token.Name = "net.minecraftforge:forge:universal" Then
'特判修复 Forge 部分 universal 文件缺失 URL(#5455)
Token.Url = "https://maven.minecraftforge.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")
End If
If Token.Url IsNot Nothing Then
'获取 Url 的真实地址
'获取 URL 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Token.Url.Contains(".tsrg") Then
@@ -2080,10 +2101,14 @@ OnLoaded:
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer
If McLibGet.Contains("optifine\OptiFine\1.12") AndAlso '仅在 1.12 OptiFine 可重现
File.Exists(CustomMcFolder & "libraries\" & Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & "-installer.jar") Then
Log("[Launch] 已将 " & Original & " 特判替换为对应的 Installer 文件", LogLevel.Debug)
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1).BeforeFirst("_"))
Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 2, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
End If
End If
End Function
@@ -2308,8 +2333,8 @@ OnLoaded:
End If
Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
While True
'两边均缺失,感觉是一个东西
@@ -2358,15 +2383,11 @@ NextEntry:
''' <summary>
''' 比较两个版本名的排序器。
''' </summary>
Public Class VersionSorter
Public Class VersionComparer
Implements IComparer(Of String)
Public IsDecreased As Boolean = True
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1)
Return VersionSortInteger(x, y)
End Function
Public Sub New(Optional IsDecreased As Boolean = True)
Me.IsDecreased = IsDecreased
End Sub
End Class
''' <summary>
@@ -1137,7 +1137,7 @@ Finished:
'刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBars())
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
@@ -1,5 +1,4 @@
Imports System.IO.Compression
Imports System.Linq.Expressions
Public Module ModModpack
@@ -30,6 +29,9 @@ Public Module ModModpack
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
Try
'字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
@@ -107,29 +109,7 @@ Public Module ModModpack
End Try
End Function
'整合包缓存清理
Private IsInstallCacheCleared As Boolean = False
Private IsInstallCacheClearing As Boolean = False
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
'清理缓存文件夹
If Not IsInstallCacheCleared Then
IsInstallCacheCleared = True
IsInstallCacheClearing = True
Try
Log("[ModPack] 开始清理整合包安装缓存")
DeleteDirectory(PathTemp & "PackInstall\")
Log("[ModPack] 已清理整合包安装缓存")
Catch ex As Exception
Log(ex, "清理整合包安装缓存失败")
Finally
IsInstallCacheClearing = False
End Try
ElseIf IsInstallCacheClearing Then
'等待另一个整合包安装的清理步骤完成
Do While IsInstallCacheClearing
Thread.Sleep(1)
Loop
End If
'解压文件
Dim RetryCount As Integer = 1
Dim Encode = Encoding.GetEncoding("GB18030")
@@ -203,7 +183,7 @@ Retry:
End If
Next
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
Dim OverrideHome As String = If(Json("overrides"), "")
If OverrideHome <> "" Then
@@ -211,13 +191,15 @@ Retry:
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
'复制结果
If Directory.Exists(OverridePath) Then
CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Log($"[ModPack] 整合包 override 复制:{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
Log("[ModPack] 整合包 override 目标:" & OverrideHome)
Dim OverrideRoot = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
If Directory.Exists(OverrideRoot) Then
Dim CopyTarget = $"{PathMcFolder}versions\{VersionName}"
CopyDirectory(OverrideRoot, CopyTarget, Sub(Delta) Task.Progress += Delta * 0.35)
Log($"[ModPack] 整合包 override 复制:{OverrideRoot} -> {CopyTarget}")
Else
Log($"[ModPack] 整合包中未找到 override 文件夹:{OverridePath}")
Log($"[ModPack] 整合包中未找到 override 文件夹:{OverrideRoot}")
End If
Task.Progress = 0.95
'开启版本隔离
@@ -241,9 +223,7 @@ Retry:
'获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
'由于 MCIM 缺少下载信息,只使用官方源获取列表
'TODO: 在 MCIM 源稳定后回调回 DlModRequest
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -315,7 +295,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -329,6 +309,10 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
@@ -393,7 +377,7 @@ Retry:
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
@@ -422,7 +406,7 @@ Retry:
If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString
Case "optional"
If MyMsgBox("是否要下载整合包中的可选文件 " & GetFileNameFromPath(File("path").ToString) & "?",
If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "?",
"下载可选文件", "是", "否") = 2 Then
Continue For
End If
@@ -477,10 +461,14 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Throw New CancelledException
@@ -511,7 +499,7 @@ Retry:
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
@@ -594,7 +582,7 @@ Retry:
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
@@ -615,7 +603,13 @@ Retry:
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MMCSetupFile) Then
'将其中的等号替换为冒号,以符合 ini 文件格式
WriteFile(MMCSetupFile, ReadFile(MMCSetupFile).Replace("=", ":"))
Dim Lines As New List(Of String)
For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
WriteFile(MMCSetupFile, Join(Lines, vbCrLf))
'读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
@@ -644,6 +638,18 @@ Retry:
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
Else
JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
End If
End If
End If
Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)")
@@ -717,7 +723,7 @@ Retry:
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
@@ -788,7 +794,6 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
@@ -798,22 +803,27 @@ Retry:
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.AllDirectories)
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动器", True)) AndAlso
Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
If Launcher Is Nothing Then Launcher = ExeFile
If Launcher Is Nothing Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的疑似第三方启动器:{ExeFile}")
End If
End If
Next
Task.Progress = 0.95
'尝试使用附带的启动器打开
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
If MyMsgBox($"整合包中似乎自带了启动器,是否换用它继续安装?{vbCrLf}通常推荐这样做,以获得最佳体验。{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "继续", "取消") = 1 Then
ShellOnly(Launcher, "--wait")
If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
FrmMain.EndProgram(False)
Return
@@ -821,15 +831,17 @@ Retry:
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
VersionName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
ModpackInstall(ModpackFile, VersionName)
ModpackInstall(ModpackFile)
End Sub)
})
Loader.Start(TargetFolder)
@@ -96,7 +96,7 @@
'记录当前展开的卡片标题(#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
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
@@ -30,12 +30,12 @@
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" x:Name="ColumnTitle" />
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitle" TextTrimming="CharacterEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
@@ -137,13 +137,14 @@ Public Class MyLocalModItem
Exit Sub
End If
'计算滑动范围
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Math.Min(SwipeStart, Index)
SwipeEnd = Math.Max(SwipeEnd, Index)
Dim Elements = CType(Parent, StackPanel).Children
Dim Index As Integer = Elements.IndexOf(Me)
SwipeStart = MathClamp(Math.Min(SwipeStart, Index), 0, Elements.Count - 1)
SwipeEnd = MathClamp(Math.Max(SwipeEnd, Index), 0, Elements.Count - 1)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
Dim Item As MyLocalModItem = Elements(i)
Item.InitLate(Item, e)
Item.Checked = SwipToState
Next
@@ -303,30 +304,33 @@ Public Class MyLocalModItem
#End Region
Private Function GetUpdateCompareDescription() As String
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
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
End Function
Public Sub Refresh() Handles Me.Loaded
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}点击以更新,右键查看更新日志。"
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
@@ -458,8 +462,11 @@ Public Class MyLocalModItem
End Sub
'显示更新日志
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
Private Sub BtnUpdate_PreviewMouseRightButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True
ShowUpdateLog()
End Sub
Private Sub ShowUpdateLog()
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
@@ -476,20 +483,62 @@ Public Class MyLocalModItem
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
FrmVersionMod.UpdateMods({Entry})
Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新
FrmVersionMod.UpdateMods({Entry})
Case 2 '查看更新日志
ShowUpdateLog()
Case 3 '取消
End Select
End Sub
'自适应(#4465)
Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
'压缩 Subtitle
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
ElseIf Not ColumnExtend.Width.IsStar AndAlso Not LabSubtitle.IsTextTrimmed Then
'向右展开 Subtitle
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
End If
Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged
'0:全部舒展:Auto - Auto - (Auto) - 1*
'1:压缩 Subtitle:Auto - 1* - (Auto) - 0
'2:继续压缩 Title:1* - 0 - (Auto) - 0
Dim CurrentCompressLevel As Integer =
If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed
Dim NewCompressLevel As Integer
Select Case CurrentCompressLevel
Case 0
If ColumnExtend.ActualWidth < 0.5 Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1)
Else
Return
End If
Case 1
If ColumnSubtitle.ActualWidth < 0.5 Then
NewCompressLevel = 2
ElseIf Not LabSubtitle.IsTextTrimmed Then
NewCompressLevel = 0
Else
Return
End If
Case 2
If Not LabTitle.IsTextTrimmed Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1)
Else
Return
End If
End Select
Select Case NewCompressLevel
Case 0
'全部舒展:Auto - Auto - (Auto) - 1*
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
Case 1
'压缩 Subtitle:Auto - 1* - (Auto) - 0
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
Case 2
'继续压缩 Title:1* - 0 - (Auto) - 0
ColumnTitle.Width = New GridLength(1, GridUnitType.Star)
ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
End Select
End Sub
End Class
@@ -1,3 +1,8 @@
Public Module ModDevelop
#If DEBUG Then
Public Sub Start()
End Sub
#End If
End Module
+18 -8
View File
@@ -20,7 +20,7 @@
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
Case "打开文件", "打开帮助", "执行命令"
RunInThread(
Sub()
Try
@@ -29,15 +29,25 @@
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
If Type = "打开帮助" Then
PageOtherHelp.EnterHelpPage(Location)
Else
If Not Setup.Get("HintCustomCommand") Then
Select Case MyMsgBox(
"即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
"请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 2
Setup.Set("HintCustomCommand", True)
Case 3
Exit Sub
End Select
End If
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
.WorkingDirectory = ShortenPath(WorkingDir)
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
@@ -140,8 +150,8 @@
Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp1)
Try
NetDownload(RelativeUrl, LocalTemp1)
NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
NetDownloadByClient(RelativeUrl, LocalTemp1)
NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
Catch ex As Exception
Throw New Exception("下载指定的文件失败!" & vbCrLf &
"注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
@@ -174,7 +184,7 @@
Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
ElseIf EventType = "打开文件" Then
ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
'直接使用原有路径启动程序
Location = RelativeUrl
Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
+49
View File
@@ -434,6 +434,7 @@ EndHint:
Public FrmVersionMod As PageVersionMod
Public FrmVersionModDisabled As PageVersionModDisabled
Public FrmVersionSetup As PageVersionSetup
Public FrmVersionExport As PageVersionExport
'资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -810,6 +811,54 @@ NextFile:
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
#Region "任务缓存"
Private IsTaskTempCleared As Boolean = False
Private IsTaskTempClearing As Boolean = False
''' <summary>
''' 尝试清理任务缓存文件夹。
''' 在整次运行中只会实际清理一次。
''' </summary>
Public Sub TryClearTaskTemp()
If Not IsTaskTempCleared Then
IsTaskTempCleared = True
IsTaskTempClearing = True
Try
Log("[System] 开始清理任务缓存文件夹")
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
DeleteDirectory($"{PathTemp}TaskTemp\")
Log("[System] 已清理任务缓存文件夹")
Catch ex As Exception
Log(ex, "清理任务缓存文件夹失败")
Finally
IsTaskTempClearing = False
End Try
ElseIf IsTaskTempClearing Then
'等待另一个清理步骤完成
Do While IsTaskTempClearing
Thread.Sleep(1)
Loop
End If
End Sub
''' <summary>
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。
''' 这些文件夹无需进行后续清理。
''' </summary>
''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
TryClearTaskTemp()
If RequireNonSpace Then
RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\Install\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Else
RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
End If
Directory.CreateDirectory(RequestTaskTempFolder)
End Function
#End Region
Public DragControl = Nothing
+71 -50
View File
@@ -14,8 +14,8 @@
''' 初始化音乐播放列表。
''' </summary>
''' <param name="ForceReload">强制全部重新载入列表。</param>
''' <param name="IgnoreFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "")
''' <param name="PreventFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional PreventFirst As String = Nothing)
If ForceReload Then MusicAllList = Nothing
Try
'初始化全部可用音乐列表
@@ -31,10 +31,10 @@
End If
'打乱顺序播放
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
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
MusicWaitingList.Add(PreventFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -42,13 +42,18 @@
End Sub
''' <summary>
''' 获取下一首播放的音乐路径并将其从列表中移除。
''' 如果没有,可能会返回 Nothing。
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Any() Then
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
Else
DequeueNextMusicAddress = Nothing
End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
@@ -60,44 +65,45 @@
''' 刷新背景音乐按钮 UI 与设置页 UI。
''' </summary>
Private Sub MusicRefreshUI()
RunInUi(Sub()
Try
RunInUi(
Sub()
Try
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
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
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))
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
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))
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
End Sub
''' <summary>
@@ -128,8 +134,12 @@
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
If Address Is Nothing Then
Hint("没有可以播放的音乐!", HintType.Critical)
Else
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
End If
End If
MusicRefreshUI()
End Sub
@@ -179,11 +189,15 @@
End If
Else
Dim Address As String = DequeueNextMusicAddress()
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
If Address Is Nothing Then
If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical)
Else
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
End If
End If
MusicRefreshUI()
@@ -195,6 +209,7 @@
''' 开始播放音乐。
''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return
Log("[Music] 播放开始:" & Address)
MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
@@ -287,15 +302,21 @@
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.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
Thread.Sleep(1000)
'将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent)
MusicWaitingList.Remove(MusicCurrent)
MusicRefreshUI()
'等待 2 秒后继续播放
Thread.Sleep(2000)
If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then
Else
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If
Finally
+15 -8
View File
@@ -108,8 +108,8 @@ Friend Module ModSecret
Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
Client.Headers("x-api-key") = CurseForgeAPIKey
Client.Headers("Referer") = "http://" & VersionCode & ".open.pcl2.server/"
If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey
End Sub
''' <summary>
''' 设置 Headers 的 UA、Referer。
@@ -122,8 +122,8 @@ Friend Module ModSecret
Else
Request.UserAgent = "PCL2/" & VersionStandardCode
End If
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
Request.Headers("x-api-key") = CurseForgeAPIKey
Request.Referer = "http://" & VersionCode & ".open.pcl2.server/"
If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey
End Sub
#End Region
@@ -246,18 +246,18 @@ Friend Module ModSecret
FrmMain.PanForm.Background.Freeze()
End Sub)
End Sub
Public Sub ThemeCheckAll(EffectSetup As Boolean)
Friend Sub ThemeCheckAll(EffectSetup As Boolean)
End Sub
Public Function ThemeCheckOne(Id As Integer) As Boolean
Friend 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
Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Return False
End Function
Public Function DonateCodeInput() As Boolean?
Friend Function DonateCodeInput() As Boolean?
Return Nothing
End Function
@@ -276,6 +276,13 @@ Friend Module ModSecret
End Sub
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
End Sub
''' <summary>
''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
''' 如果不是,则下载一个。
''' </summary>
Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
'注意:如果要自行实现这个功能,请换用另一个文件路径,以免与官方版本冲突
End Sub
#End Region
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.10.0")>
<Assembly: AssemblyFileVersion("2.8.10.0")>
<Assembly: AssemblyVersion("2.9.1.0")>
<Assembly: AssemblyFileVersion("2.9.1.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -87,6 +87,7 @@ Public Module ModDownloadLib
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710)
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
@@ -271,7 +272,7 @@ pause"
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 服务端下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 服务端下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -316,7 +317,7 @@ pause"
Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -394,7 +395,7 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.NameVersion
Dim Target As String = SelectAs("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar")
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
@@ -404,7 +405,7 @@ pause"
Exit Sub
Next
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -454,7 +455,7 @@ pause"
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = BaseMcFolderHome
.WorkingDirectory = ShortenPath(BaseMcFolderHome)
}
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome
@@ -857,7 +858,7 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try
Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectAs("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
@@ -893,7 +894,7 @@ Retry:
End If
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 1024))}) With {.ProgressWeight = 15})
'启动
Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -1037,7 +1038,7 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try
Dim Target As String = SelectAs("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Exit Sub
@@ -1072,7 +1073,7 @@ Retry:
Loaders.Add(New LoaderDownload("下载主文件", Files) With {.ProgressWeight = 6})
'启动
Dim Loader = New LoaderCombo(Of DlForgelikeEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader = New LoaderCombo(Of DlForgelikeEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Info)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -1339,7 +1340,7 @@ Retry:
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件
Task.Progress = 0.4
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
Dim RawJson As JObject = GetJson(NetGetCodeByLoader(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
@@ -1353,7 +1354,7 @@ Retry:
'去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
@@ -1641,7 +1642,7 @@ Retry:
RunInNewThread(Sub()
Try
Log("[Download] 刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/forge/promos")
Dim Result As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/forge/promos")
If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")")
Dim ResultJson As JContainer = GetJson(Result)
'获取所有推荐版本列表
@@ -1789,7 +1790,7 @@ Retry:
Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectAs("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
'重复任务检查
@@ -1807,7 +1808,7 @@ Retry:
Address.Add(Url)
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 64))}) With {.ProgressWeight = 15})
'启动
Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -1974,6 +1975,20 @@ Retry:
End Class
''' <summary>
''' 在加载器状态改变后显示一条提示。
''' 不会进行任何其他操作。
''' </summary>
Public Sub LoaderStateChangedHintOnly(Loader)
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
''' <summary>
''' 安装加载器状态改变后进行提示和重载文件夹列表的方法。
''' </summary>
@@ -1992,21 +2007,6 @@ Retry:
McInstallFailedClearFolder(Loader)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
''' <summary>
''' 安装加载器状态改变后进行提示的方法。它不会在失败时删除文件夹,也不会刷新 MC 文件夹。
''' </summary>
Public Sub DownloadStateSave(Loader)
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
End Sub
Public Sub McInstallFailedClearFolder(Loader)
Try
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装)
@@ -2053,26 +2053,12 @@ Retry:
''' <exception cref="CancelledException" />
Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase)
'获取缓存目录
Dim PathInstallTemp As String
If PathTemp.Contains(" ") AndAlso (Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing) Then
PathInstallTemp = OsDrive & "ProgramData\PCL\Install\"
Else
PathInstallTemp = PathTemp & "Install\"
End If
'清理缓存
Try
If IsInstallTempCleared Then Exit Try
IsInstallTempCleared = True
DeleteDirectory(PathInstallTemp, True)
Log("[Download] 已清理合并安装缓存")
Catch ex As Exception
Log(ex, "清理合并安装缓存失败")
End Try
Dim TempMcFolder As String = RequestTaskTempFolder(
PathTemp.Contains(" ") AndAlso '要求路径不包含空格
(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing))
'获取参数
Dim OutputFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\"
Dim TempMcFolder As String = PathInstallTemp & Request.TargetVersionName.GetHashCode() & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
@@ -2188,7 +2174,6 @@ Retry:
'总加载器
Return LoaderList
End Function
Private IsInstallTempCleared As Boolean = False
''' <summary>
''' 将多个版本 Json 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
@@ -9,7 +9,6 @@
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyCard Margin="0,0,0,25" x:Name="CardIntro">
<StackPanel Margin="22,18,22,19" x:Name="PanIntro">
@@ -20,7 +19,12 @@
</StackPanel>
</StackPanel>
</local:MyCard>
<StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True" />
<StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True">
<local:MyCard Margin="0,0,0,15" x:Name="CardFilter">
<StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" />
</local:MyCard>
<StackPanel Name="PanResults" />
</StackPanel>
<local:MyCard Grid.Row="1" HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="0,0,0,8">
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
@@ -59,30 +59,85 @@
Me.Topmost = If(Topmost, "")
End Sub
End Class
Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
Private Sub Load_OnFinish()
'初始化筛选器
Dim VersionFilters As List(Of String)
'按小版本号筛选?
IsMajorVersionFilter = False
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
'按大版本号筛选?
If VersionFilters.Count >= 9 Then
IsMajorVersionFilter = True
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End If
'UI 化筛选器
PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing
Else
CardFilter.Visibility = Visibility.Visible
VersionFilters.Insert(0, "全部")
'转化为按钮
For Each Version As String In VersionFilters
Dim NewButton As New MyRadioButton With {
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0)
AddHandler NewButton.Check,
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
UpdateFilterResult()
End Sub
PanFilter.Children.Add(NewButton)
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then
Dim TargetFile = CompFileLoader.Output.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
Exit For
Next
End If
End If
If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0)
ToCheck.Checked = True
End If
'更新筛选结果(文件列表 UI 化)
UpdateFilterResult()
End Sub
Private Sub UpdateFilterResult()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
'初始化字典
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("未知版本", New List(Of CompFile))
Dict.Add("其他版本", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In CompFileLoader.Output
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
'决定添加到哪个卡片
Dim Ver As String
If GameVersion Is Nothing Then
Ver = "未知版本"
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
Ver = "快照版本"
ElseIf GameVersion.StartsWithF("1.0") Then
Ver = "远古版本"
Else
Ver = GameVersion
End If
Dim Ver As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.Type = CompType.Mod Then
If Project.ModLoaders.Count > 1 AndAlso '至少有两个加载器
Project.Type = CompType.Mod AndAlso '是 Mod
Ver.StartsWith("1.") Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
Next
End If
@@ -101,16 +156,16 @@
For Each Version As CompFile In CompFileLoader.Output
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
End If
Next
End If
#Region "转化为 UI"
'转化为 UI
Try
'清空当前
PanMain.Children.Clear()
'转化为 UI
PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
@@ -118,7 +173,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}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanMain.Children.Add(NewCard)
PanResults.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
@@ -128,20 +183,29 @@
NewCard.IsSwaped = True
End If
'增加提示
If Pair.Key = "未知版本" Then
NewStack.Children.Add(New MyHint With {.Text = "由于 API 的版本信息更新缓慢,可能无法识别刚更新不久的 MC 版本,只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
If Pair.Key = "其他版本" Then
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本,只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
End If
Next
'如果只有一张卡片,展开第一张卡片
If PanMain.Children.Count = 1 Then
CType(PanMain.Children(0), MyCard).IsSwaped = False
If PanResults.Children.Count = 1 Then
CType(PanResults.Children(0), MyCard).IsSwaped = False
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
End Try
#End Region
End Sub
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
If Name Is Nothing Then
Return "其他版本"
ElseIf Name.Contains("w") Then
Return "快照版本"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
Return "远古版本"
Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
End If
End Function
#End Region
@@ -249,7 +313,7 @@
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
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
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing 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
@@ -314,11 +378,11 @@
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectAs("选择保存位置", FileName,
Desc & "文件|" &
If(Project.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(Project.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
@@ -326,7 +390,7 @@
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -345,7 +409,7 @@
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CompItem.LabTitle.Text)
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
End Sub
End Class
@@ -64,9 +64,11 @@
End If
'如果在选择页面按了刷新键,选择页的东西可能会由于动画被隐藏,但不会由于加载结束而再次显示,因此这里需要手动恢复
For Each Card In GetAllAnimControls(PanSelect)
Card.Opacity = 1
Card.RenderTransform = New TranslateTransform
For Each Control In GetAllAnimControls(PanSelect)
Control.Opacity = 1
If Control.RenderTransform Is Nothing OrElse TypeOf Control.RenderTransform Is TranslateTransform Then
Control.RenderTransform = New TranslateTransform
End If
Next
'启动 Forge 加载
@@ -113,12 +113,14 @@
PageDownloadMod.Storage = New CompProjectStorage
PageDownloadMod.Page = 0
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
PageDownloadPack.Page = 0
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
@@ -33,7 +33,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.3" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -1,12 +1,44 @@
Public Class PageDownloadMod
Public Const PageSize = 40
''' <summary>
''' 在切换到该页面时自动设置的目标版本。
''' </summary>
Public Shared TargetVersion As McVersion = Nothing
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Private IsLoaderInited As Boolean = False
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then
'设置目标
ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName
Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items
If Item.Content = Name Then Return Item
Next
Return ComboSearchLoader.Items(0)
End Function
If TargetVersion.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If
TargetVersion = Nothing
'如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch()
PanScroll.ScrollToHome()
End If
'加载器初始化
If IsLoaderInited Then Return
IsLoaderInited = True
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
@@ -118,7 +150,7 @@
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
Private Sub ResetFilter() Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
@@ -32,7 +32,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.3" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -52,7 +52,7 @@
Exit Sub
End If
Try
Dim FileAddress As String = SelectAs("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
If FileAddress.Contains("\") Then
File.Delete(FileAddress)
If Address.StartsWith(PathImage) Then
@@ -242,7 +242,8 @@ Retry:
{"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 周年披风"}, {"Minecraft Experience", "村民救援披风"}
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"Mojang Office", "Mojang 办公室披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -53,10 +53,10 @@
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Try
Dim InstallLoader = ModpackInstall(PackInstallPath, GetFolderNameFromPath(Path))
Dim InstallLoader = ModpackInstall(PackInstallPath)
Log("[Launch] 自动安装整合包已开始:" & PackInstallPath)
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
If InstallLoader.State = LoadState.Finished AndAlso File.Exists(PackInstallPath) Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
@@ -105,15 +105,15 @@ Download:
GoTo Download
Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/"
Url = "https://pcl-bmcl.milu.ink/"
GoTo Download
Case 7
Log("[Page] 主页预设:主页市场")
Url = "https://homepage-market.pages.dev/Custom.xaml"
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/JingHai-Lingyun/Custom.xaml"
GoTo Download
Case 8
Log("[Page] 主页预设:更新日志")
Url = "https://updatehomepage.pages.dev/UpdateHomepage.xaml"
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml"
GoTo Download
Case 9
Log("[Page] 主页预设:PCL 新功能说明书")
@@ -123,6 +123,10 @@ Download:
Log("[Page] 主页预设:OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL"
GoTo Download
Case 11
Log("[Page] 主页预设:杂志主页")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Ext1nguisher/Custom.xaml"
GoTo Download
End Select
End Select
RunInUi(Sub() LoadContent(Content))
@@ -230,7 +234,7 @@ Download:
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
Log("[Page] 加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.Message}", "加载自定义主页失败", "重试", "取消") = 1 Then
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{GetExceptionSummary(ex)}", "加载自定义主页失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁
End If
End Try
@@ -70,9 +70,11 @@
End Try
End Sub)
End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click
Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "")
Setup.Set("CacheAuthName", "")
McLoginAuthLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -44,6 +44,11 @@ Public Class PageLoginLegacy
Public Shared Function IsVaild(LoginData As McLoginLegacy) As String
If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!"
If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!"
If McVersionCurrent IsNot Nothing AndAlso
((McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 3) OrElse McVersionCurrent.Version.McCodeMain > 20) AndAlso
LoginData.UserName.Trim.Length > 16 Then
Return "自 1.20.3 起,玩家名至多只能包含 16 个字符!"
End If
Return ""
End Function
Public Function IsVaild() As String
@@ -113,6 +113,7 @@ Retry:
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result)
If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
@@ -47,8 +47,9 @@
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
OpenWebsite("https://login.mc-user.com:233/account/changepw")
End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click
Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheNideAccess", "")
McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -111,8 +111,6 @@ Public Class PageLinkIoi
End Sub
'复制联机码
Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click
ClipboardSet(IoiId.Substring(4) & SecretEncrypt(GetPlayerName), False)
Hint("已复制联机码!", HintType.Finish)
End Sub
#End Region
@@ -104,126 +104,195 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,10,20">
<TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 10 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<TextBlock HorizontalAlignment="Left" Text="以下是 2025 年 1 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10">
<TextBlock Width="120" Margin="0,1.5" Text="枫星Maplestar" />
<TextBlock Width="120" Margin="0,1.5" Text="52Mirai" />
<TextBlock Width="120" Margin="0,1.5" Text="青稞菌" />
<TextBlock Width="120" Margin="0,1.5" Text="我小叮当无话可说" />
<TextBlock Width="120" Margin="0,1.5" Text="溯逆" />
<TextBlock Width="120" Margin="0,1.5" Text="羽惜天麟" />
<TextBlock Width="120" Margin="0,1.5" Text="Dune" />
<TextBlock Width="120" Margin="0,1.5" Text="流萤天下第一" />
<TextBlock Width="120" Margin="0,1.5" Text="展望" />
<TextBlock Width="120" Margin="0,1.5" Text="Masker" />
<TextBlock Width="120" Margin="0,1.5" Text="at" />
<TextBlock Width="120" Margin="0,1.5" Text="xxkundddd" />
<TextBlock Width="120" Margin="0,1.5" Text="bigdaddyeges" />
<TextBlock Width="120" Margin="0,1.5" Text="梦淮黎" />
<TextBlock Width="120" Margin="0,1.5" Text="半夏" />
<TextBlock Width="120" Margin="0,1.5" Text="酥小梨" />
<TextBlock Width="120" Margin="0,1.5" Text="juju" />
<TextBlock Width="120" Margin="0,1.5" Text="无月" />
<TextBlock Width="120" Margin="0,1.5" Text="crush" />
<TextBlock Width="120" Margin="0,1.5" Text="板某人" />
<TextBlock Width="120" Margin="0,1.5" Text="狐神白桜" />
<TextBlock Width="120" Margin="0,1.5" Text="N55Nebula" />
<TextBlock Width="120" Margin="0,1.5" Text="YFY" />
<TextBlock Width="120" Margin="0,1.5" Text="睛魄" />
<TextBlock Width="120" Margin="0,1.5" Text="大唐江山" />
<TextBlock Width="120" Margin="0,1.5" Text="子昙" />
<TextBlock Width="120" Margin="0,1.5" Text="忒休斯" />
<TextBlock Width="120" Margin="0,1.5" Text="2273445145" />
<TextBlock Width="120" Margin="0,1.5" Text="晚安" />
<TextBlock Width="120" Margin="0,1.5" Text="韶英儿" />
<TextBlock Width="120" Margin="0,1.5" Text="123456。?" />
<TextBlock Width="120" Margin="0,1.5" Text="诗酒" />
<TextBlock Width="120" Margin="0,1.5" Text="空白格" />
<TextBlock Width="120" Margin="0,1.5" Text="Asphyxia" />
<TextBlock Width="120" Margin="0,1.5" Text="凡人my" />
<TextBlock Width="240" Margin="0,1.5" Text="ChancellerPaperplane" />
<TextBlock Width="120" Margin="0,1.5" Text="孤沵老狐狸" />
<TextBlock Width="120" Margin="0,1.5" Text="5YUZ1" />
<TextBlock Width="120" Margin="0,1.5" Text="咕咕" />
<TextBlock Width="120" Margin="0,1.5" Text="蛇蛇夏惠子" />
<TextBlock Width="120" Margin="0,1.5" Text="山吟川" />
<TextBlock Width="120" Margin="0,1.5" Text="龙说sake" />
<TextBlock Width="120" Margin="0,1.5" Text="浮尘" />
<TextBlock Width="120" Margin="0,1.5" Text="nbs" />
<TextBlock Width="120" Margin="0,1.5" Text="Eclysia" />
<TextBlock Width="120" Margin="0,1.5" Text="JH_R" />
<TextBlock Width="120" Margin="0,1.5" Text="小破球行星发动机" />
<TextBlock Width="120" Margin="0,1.5" Text="Lei Xuanhua" />
<TextBlock Width="120" Margin="0,1.5" Text="2776251567" />
<TextBlock Width="120" Margin="0,1.5" Text="乐正嵩" />
<TextBlock Width="120" Margin="0,1.5" Text="兔蹬鹰" />
<TextBlock Width="120" Margin="0,1.5" Text="太一" />
<TextBlock Width="120" Margin="0,1.5" Text="69543" />
<TextBlock Width="120" Margin="0,1.5" Text="sunke" />
<TextBlock Width="120" Margin="0,1.5" Text="HLX" />
<TextBlock Width="120" Margin="0,1.5" Text="是阿改哦" />
<TextBlock Width="120" Margin="0,1.5" Text="dingyaa1" />
<TextBlock Width="120" Margin="0,1.5" Text="李白" />
<TextBlock Width="120" Margin="0,1.5" Text="Xpinger" />
<TextBlock Width="120" Margin="0,1.5" Text="执念" />
<TextBlock Width="120" Margin="0,1.5" Text="张一凡" />
<TextBlock Width="120" Margin="0,1.5" Text="yu" />
<TextBlock Width="120" Margin="0,1.5" Text="quer" />
<TextBlock Width="240" Margin="0,1.5" Text="SHALLOW_SUMMER" />
<TextBlock Width="120" Margin="0,1.5" Text="AnLingHai" />
<TextBlock Width="120" Margin="0,1.5" Text="The_Ren" />
<TextBlock Width="120" Margin="0,1.5" Text="阿彪" />
<TextBlock Width="120" Margin="0,1.5" Text="汤圆不胖" />
<TextBlock Width="120" Margin="0,1.5" Text="凑热闹的顶针" />
<TextBlock Width="120" Margin="0,1.5" Text="德凯" />
<TextBlock Width="120" Margin="0,1.5" Text="凌肆玖" />
<TextBlock Width="120" Margin="0,1.5" Text="破星辰只寻你" />
<TextBlock Width="120" Margin="0,1.5" Text="飞猫FlyingCat" />
<TextBlock Width="120" Margin="0,1.5" Text="Jethro_Y" />
<TextBlock Width="120" Margin="0,1.5" Text="浩天" />
<TextBlock Width="120" Margin="0,1.5" Text="redston_8788" />
<TextBlock Width="120" Margin="0,1.5" Text="羽毛球awa" />
<TextBlock Width="240" Margin="0,1.5" Text="maximum zombie" />
<TextBlock Width="120" Margin="0,1.5" Text="可塔Kita" />
<TextBlock Width="120" Margin="0,1.5" Text="染桐" />
<TextBlock Width="120" Margin="0,1.5" Text="飞蛙" />
<TextBlock Width="120" Margin="0,1.5" Text="团长" />
<TextBlock Width="120" Margin="0,1.5" Text="妙天纸袋君" />
<TextBlock Width="120" Margin="0,1.5" Text="YJL" />
<TextBlock Width="120" Margin="0,1.5" Text="天水" />
<TextBlock Width="120" Margin="0,1.5" Text="Anonymism" />
<TextBlock Width="120" Margin="0,1.5" Text="佳明" />
<TextBlock Width="120" Margin="0,1.5" Text="小创世peng" />
<TextBlock Width="120" Margin="0,1.5" Text="炽热的钢铁" />
<TextBlock Width="120" Margin="0,1.5" Text="小邓子" />
<TextBlock Width="120" Margin="0,1.5" Text="QianYirui" />
<TextBlock Width="120" Margin="0,1.5" Text="Korica" />
<TextBlock Width="120" Margin="0,1.5" Text="司徒牺痕" />
<TextBlock Width="120" Margin="0,1.5" Text="流萤" />
<TextBlock Width="120" Margin="0,1.5" Text="神愆" />
<TextBlock Width="120" Margin="0,1.5" Text="44379" />
<TextBlock Width="120" Margin="0,1.5" Text="cool" />
<TextBlock Width="120" Margin="0,1.5" Text="白凌" />
<TextBlock Width="120" Margin="0,1.5" Text="弓虽女干亻尔女马" />
<TextBlock Width="120" Margin="0,1.5" Text="是雾霭啊233" />
<TextBlock Width="120" Margin="0,1.5" Text="小豆" />
<TextBlock Width="120" Margin="0,1.5" Text="整天摸鱼的Dx" />
<TextBlock Width="120" Margin="0,1.5" Text="LEVI" />
<TextBlock Width="120" Margin="0,1.5" Text="虚空" />
<TextBlock Width="120" Margin="0,1.5" Text="Mako" />
<TextBlock Width="120" Margin="0,1.5" Text="禾鳥" />
<TextBlock Width="120" Margin="0,1.5" Text="MILA_326" />
<TextBlock Width="120" Margin="0,1.5" Text="韩大仙尊" />
<TextBlock Width="120" Margin="0,1.5" Text="僭苏寒" />
<TextBlock Width="120" Margin="0,1.5" Text="福渡恒" />
<TextBlock Width="120" Margin="0,1.5" Text="Yu氚" />
<TextBlock Width="120" Margin="0,1.5" Text="限制_limited" />
<TextBlock Width="120" Margin="0,1.5" Text="麦克斯韦妖" />
<TextBlock Width="120" Margin="0,1.5" Text="承挨" />
<TextBlock Width="120" Margin="0,1.5" Text="略略略zbc" />
<TextBlock Width="120" Margin="0,1.5" Text="CYOSK" />
<TextBlock Width="120" Margin="0,1.5" Text="Atmoon" />
<TextBlock Width="120" Margin="0,1.5" Text="DBTB" />
<TextBlock Width="120" Margin="0,1.5" Text="Bongocat1337" />
<TextBlock Width="120" Margin="0,1.5" Text="AD_AIR" />
<TextBlock Width="120" Margin="0,1.5" Text="KenshenLove" />
<TextBlock Width="120" Margin="0,1.5" Text="晚柠" />
<TextBlock Width="120" Margin="0,1.5" Text="H.Jane" />
<TextBlock Width="120" Margin="0,1.5" Text="tanolin" />
<TextBlock Width="120" Margin="0,1.5" Text="乐高漫画君" />
<TextBlock Width="120" Margin="0,1.5" Text="白起床了" />
<TextBlock Width="120" Margin="0,1.5" Text="ClassicNT" />
<TextBlock Width="120" Margin="0,1.5" Text="土地的誓言" />
<TextBlock Width="120" Margin="0,1.5" Text="nanamik" />
<TextBlock Width="120" Margin="0,1.5" Text="阿宸大大" />
<TextBlock Width="120" Margin="0,1.5" Text="渡边贤人" />
<TextBlock Width="120" Margin="0,1.5" Text="千羽星语" />
<TextBlock Width="120" Margin="0,1.5" Text="喵~" />
<TextBlock Width="120" Margin="0,1.5" Text="路过的没心人" />
<TextBlock Width="120" Margin="0,1.5" Text="牢轮" />
<TextBlock Width="120" Margin="0,1.5" Text="Littleduan" />
<TextBlock Width="120" Margin="0,1.5" Text="Sta_Rain_Wx" />
<TextBlock Width="120" Margin="0,1.5" Text="大西几" />
<TextBlock Width="120" Margin="0,1.5" Text="阿道" />
<TextBlock Width="120" Margin="0,1.5" Text="Smile_Cindy" />
<TextBlock Width="120" Margin="0,1.5" Text="Yi_Zhi" />
<TextBlock Width="120" Margin="0,1.5" Text="耿一闲" />
<TextBlock Width="120" Margin="0,1.5" Text="我是露娜的√" />
<TextBlock Width="120" Margin="0,1.5" Text="EagleEye" />
<TextBlock Width="120" Margin="0,1.5" Text="Cherry林" />
<TextBlock Width="120" Margin="0,1.5" Text="心海鱼豆腐" />
<TextBlock Width="120" Margin="0,1.5" Text="墨染" />
<TextBlock Width="120" Margin="0,1.5" Text="物流2051 朱叶" />
<TextBlock Width="120" Margin="0,1.5" Text="二月霜" />
<TextBlock Width="120" Margin="0,1.5" Text="祈喵" />
<TextBlock Width="120" Margin="0,1.5" Text="阿斯塔" />
<TextBlock Width="120" Margin="0,1.5" Text="夜长梦梦多" />
<TextBlock Width="120" Margin="0,1.5" Text="汐洺ao" />
<TextBlock Width="120" Margin="0,1.5" Text="塞巴斯蒂安" />
<TextBlock Width="120" Margin="0,1.5" Text="琅山先生" />
<TextBlock Width="120" Margin="0,1.5" Text="123" />
<TextBlock Width="120" Margin="0,1.5" Text="Alans1gn" />
<TextBlock Width="120" Margin="0,1.5" Text="迷茫LTQ" />
<TextBlock Width="120" Margin="0,1.5" Text="Raveniume" />
<TextBlock Width="120" Margin="0,1.5" Text="D六菌" />
<TextBlock Width="120" Margin="0,1.5" Text="WHITE" />
<TextBlock Width="120" Margin="0,1.5" Text="warmaQwQ" />
<TextBlock Width="120" Margin="0,1.5" Text="Haroinfather" />
<TextBlock Width="120" Margin="0,1.5" Text="赫乐瑢音" />
<TextBlock Width="120" Margin="0,1.5" Text="陈坤城" />
<TextBlock Width="120" Margin="0,1.5" Text="史莱姆SAMA" />
<TextBlock Width="120" Margin="0,1.5" Text="ciallp" />
<TextBlock Width="120" Margin="0,1.5" Text="步衷" />
<TextBlock Width="120" Margin="0,1.5" Text="雨沫" />
<TextBlock Width="120" Margin="0,1.5" Text="Tabula" />
<TextBlock Width="120" Margin="0,1.5" Text="黑宇" />
<TextBlock Width="120" Margin="0,1.5" Text="awawa" />
<TextBlock Width="120" Margin="0,1.5" Text="Yi_Joy" />
<TextBlock Width="120" Margin="0,1.5" Text="津竹捏" />
<TextBlock Width="120" Margin="0,1.5" Text="LinusWu" />
<TextBlock Width="120" Margin="0,1.5" Text="LizTtxs" />
<TextBlock Width="120" Margin="0,1.5" Text="徐正阳" />
<TextBlock Width="120" Margin="0,1.5" Text="Nxvblack" />
<TextBlock Width="120" Margin="0,1.5" Text="夏弥·零" />
<TextBlock Width="120" Margin="0,1.5" Text="诗云白" />
<TextBlock Width="120" Margin="0,1.5" Text="danall" />
<TextBlock Width="120" Margin="0,1.5" Text="TySNow_" />
<TextBlock Width="120" Margin="0,1.5" Text="悲戚霜雪" />
<TextBlock Width="120" Margin="0,1.5" Text="GThistle-Frddy" />
<TextBlock Width="120" Margin="0,1.5" Text="INTOMETE." />
<TextBlock Width="120" Margin="0,1.5" Text="千秋" />
<TextBlock Width="120" Margin="0,1.5" Text="原来这里是四宫啊" />
<TextBlock Width="120" Margin="0,1.5" Text="TianDLG" />
<TextBlock Width="120" Margin="0,1.5" Text="隐”" />
<TextBlock Width="120" Margin="0,1.5" Text="竹墨喧嚣" />
<TextBlock Width="120" Margin="0,1.5" Text="小猫妖与小家伙" />
<TextBlock Width="120" Margin="0,1.5" Text="白鸽" />
<TextBlock Width="120" Margin="0,1.5" Text="yanZzai烟崽" />
<TextBlock Width="120" Margin="0,1.5" Text="TNT_Wb4a" />
<TextBlock Width="120" Margin="0,1.5" Text="夏言" />
<TextBlock Width="120" Margin="0,1.5" Text="九一" />
<TextBlock Width="120" Margin="0,1.5" Text="Yesaz0erq" />
<TextBlock Width="120" Margin="0,1.5" Text="shirotree" />
<TextBlock Width="120" Margin="0,1.5" Text="千变Alter" />
<TextBlock Width="120" Margin="0,1.5" Text="绅士瑄" />
<TextBlock Width="120" Margin="0,1.5" Text="桃木剑剑灵" />
<TextBlock Width="120" Margin="0,1.5" Text="仪双鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="电子白痴" />
<TextBlock Width="120" Margin="0,1.5" Text="Mostima" />
<TextBlock Width="120" Margin="0,1.5" Text="钻石Daiyamondo" />
<TextBlock Width="120" Margin="0,1.5" Text="下点雨." />
<TextBlock Width="120" Margin="0,1.5" Text="阿飞" />
<TextBlock Width="120" Margin="0,1.5" Text="尽北老人" />
<TextBlock Width="120" Margin="0,1.5" Text="15971025751" />
<TextBlock Width="120" Margin="0,1.5" Text="mc沙漠之狐隆帅" />
<TextBlock Width="120" Margin="0,1.5" Text="哈哈哈" />
<TextBlock Width="120" Margin="0,1.5" Text="nono" />
<TextBlock Width="120" Margin="0,1.5" Text="CATTEA" />
<TextBlock Width="120" Margin="0,1.5" Text="黑白灰" />
<TextBlock Width="120" Margin="0,1.5" Text="天狐空幻" />
<TextBlock Width="120" Margin="0,1.5" Text="老山羊很年轻" />
<TextBlock Width="120" Margin="0,1.5" Text="John" />
<TextBlock Width="120" Margin="0,1.5" Text="Violet" />
<TextBlock Width="120" Margin="0,1.5" Text="放空" />
<TextBlock Width="120" Margin="0,1.5" Text="Grape" />
<TextBlock Width="120" Margin="0,1.5" Text="Elysium" />
<TextBlock Width="120" Margin="0,1.5" Text="shwolf.P" />
<TextBlock Width="120" Margin="0,1.5" Text="月语" />
<TextBlock Width="120" Margin="0,1.5" Text="龙之啊" />
<TextBlock Width="120" Margin="0,1.5" Text="Parapha" />
<TextBlock Width="120" Margin="0,1.5" Text="辞华久韵" />
<TextBlock Width="120" Margin="0,1.5" Text="Mad_Creeper" />
<TextBlock Width="120" Margin="0,1.5" Text="小羊" />
<TextBlock Width="120" Margin="0,1.5" Text="凉年九离" />
<TextBlock Width="120" Margin="0,1.5" Text="jiandan7005" />
<TextBlock Width="120" Margin="0,1.5" Text="Able" />
<TextBlock Width="120" Margin="0,1.5" Text="啊哈哈我是金主爸爸" />
<TextBlock Width="120" Margin="0,1.5" Text="Scarilent" />
<TextBlock Width="120" Margin="0,1.5" Text="苏珊不是酥山" />
<TextBlock Width="120" Margin="0,1.5" Text="夢曦" />
<TextBlock Width="120" Margin="0,1.5" Text="吃不饱的小云云" />
<TextBlock Width="120" Margin="0,1.5" Text="朱羽凌" />
<TextBlock Width="120" Margin="0,1.5" Text="RandomQAQ" />
<TextBlock Width="120" Margin="0,1.5" Text="修格斯" />
<TextBlock Width="120" Margin="0,1.5" Text="反伤百分百的甜筒" />
<TextBlock Width="120" Margin="0,1.5" Text="泠灵" />
<TextBlock Width="120" Margin="0,1.5" Text="不愿逆流" />
<TextBlock Width="240" Margin="0,1.5" Text="XKSYA-玩我的世界也学习c++" />
<TextBlock Width="120" Margin="0,1.5" Text="Knight" />
<TextBlock Width="120" Margin="0,1.5" Text="上官子羽" />
<TextBlock Width="120" Margin="0,1.5" Text="alanlayeLT" />
<TextBlock Width="120" Margin="0,1.5" Text="艾伦希伯来" />
<TextBlock Width="120" Margin="0,1.5" Text="z1500" />
<TextBlock Width="120" Margin="0,1.5" Text="Furina_de35" />
<TextBlock Width="120" Margin="0,1.5" Text="归一." />
<TextBlock Width="120" Margin="0,1.5" Text="逝夏" />
<TextBlock Width="120" Margin="0,1.5" Text="瑶龍龘" />
<TextBlock Width="120" Margin="0,1.5" Text="小小" />
<TextBlock Width="120" Margin="0,1.5" Text="憨憨游云" />
<TextBlock Width="120" Margin="0,1.5" Text="名字要六个字" />
<TextBlock Width="120" Margin="0,1.5" Text="牢大是我" />
<TextBlock Width="120" Margin="0,1.5" Text="伊卡律泽斯" />
<TextBlock Width="120" Margin="0,1.5" Text="stars.夜冰" />
<TextBlock Width="120" Margin="0,1.5" Text="匿名用户" />
<TextBlock Width="120" Margin="0,1.5" Text="Fancy" />
<TextBlock Width="120" Margin="0,1.5" Text="唯一白色" />
<TextBlock Width="120" Margin="0,1.5" Text="伊利丹的父亲" />
<TextBlock Width="120" Margin="0,1.5" Text="千星yousa" />
<TextBlock Width="120" Margin="0,1.5" Text="Axet." />
<TextBlock Width="120" Margin="0,1.5" Text="Ares" />
<TextBlock Width="120" Margin="0,1.5" Text="ding_i" />
<TextBlock Width="120" Margin="0,1.5" Text="林逝a" />
<TextBlock Width="120" Margin="0,1.5" Text="wihz" />
<TextBlock Width="120" Margin="0,1.5" Text="11034" />
<TextBlock Width="120" Margin="0,1.5" Text="xi0st" />
<TextBlock Width="120" Margin="0,1.5" Text="空无" />
<TextBlock Width="120" Margin="0,1.5" Text="Andywyl" />
<TextBlock Width="120" Margin="0,1.5" Text="g~m" />
<TextBlock Width="120" Margin="0,1.5" Text="雁枫" />
<TextBlock Width="120" Margin="0,1.5" Text="YX修行" />
<TextBlock Width="120" Margin="0,1.5" Text="雇佣兵v" />
<TextBlock Width="120" Margin="0,1.5" Text="背着氧气的鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="......." />
<TextBlock Width="120" Margin="0,1.5" Text="艾因·斯芬克斯" />
<TextBlock Width="120" Margin="0,1.5" Text="威宝" />
<TextBlock Width="120" Margin="0,1.5" Text="真言之归" />
<TextBlock Width="120" Margin="0,1.5" Text="奈斯特" />
<TextBlock Width="240" Margin="0,1.5" Text="青春没有售价,扣一复活牢大" />
<TextBlock Width="120" Margin="0,1.5" Text="GuZhuJing" />
<TextBlock Width="120" Margin="0,1.5" Text="UKasumigaoka" />
<TextBlock Width="120" Margin="0,1.5" Text="梦不依" />
<TextBlock Width="120" Margin="0,1.5" Text="绫波丽" />
<TextBlock Width="120" Margin="0,1.5" Text="桃子" />
<TextBlock Width="120" Margin="0,1.5" Text="方村明" />
<TextBlock Width="120" Margin="0,1.5" Text="苏离" />
<TextBlock Width="120" Margin="0,1.5" Text="EnergyBeta" />
<TextBlock Width="120" Margin="0,1.5" Text="邵寒洛" />
<TextBlock Width="120" Margin="0,1.5" Text="雨下雫" />
<TextBlock Width="120" Margin="0,1.5" Text="HoshinoAlice" />
<TextBlock Width="120" Margin="0,1.5" Text="1121" />
<TextBlock Width="120" Margin="0,1.5" Text="1742" />
<TextBlock Width="120" Margin="0,1.5" Text="奥顿" />
<TextBlock Width="120" Margin="0,1.5" Text="LYSGBZL" />
<TextBlock Width="120" Margin="0,1.5" Text="X_Lu" />
<TextBlock Width="120" Margin="0,1.5" Text="细雪" />
<TextBlock Width="120" Margin="0,1.5" Text="虎牙该隐" />
<TextBlock Width="120" Margin="0,1.5" Text="坎儿井窖藏咸鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="ClarkeTAT" />
<TextBlock Width="120" Margin="0,1.5" Text="matin" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
@@ -15,9 +15,9 @@
LogoScale="0.98" Logo="M149.883623 873.911618c47.094581 47.094581 101.765247 83.95121 162.783444 109.75085 63.065787 26.618676 130.226755 40.337532 199.230553 40.337532 69.003799 0 136.164767-13.514097 199.230554-40.337532 61.018196-25.79964 115.688862-62.656269 162.783444-109.75085s83.95121-101.765247 109.75085-162.783444c26.618676-63.065787 40.337532-130.226755 40.337532-199.230554 0-69.003799-13.514097-136.164767-40.337532-199.230553-25.79964-61.018196-62.656269-115.688862-109.75085-162.783444-46.889822-46.889822-101.765247-83.95121-162.783444-109.75085C648.062388 13.514097 580.90142 0 511.89762 0s-136.164767 13.514097-199.230553 40.337532c-61.018196 25.79964-115.688862 62.656269-162.783444 109.75085s-83.95121 101.765247-109.75085 162.783444C13.514097 375.732853 0 442.893821 0 511.89762s13.514097 136.164767 40.337532 199.230554c25.594881 61.018196 62.656269 115.688862 109.546091 162.783444zM97.670066 511.89762c0-228.511098 185.921216-414.227554 414.227554-414.227554 228.511098 0 414.227554 185.921216 414.227555 414.227554S740.408718 926.125175 511.89762 926.125175c-228.511098 0-414.227554-185.716457-414.227554-414.227555z M539.130574 244.277544c-8.190362-4.709458-17.609278-7.371326-27.232954-7.371325-9.623675 0-19.042591 2.457109-27.232953 7.371325-16.790242 9.623675-27.232953 27.847231-27.232953 47.299341 0 30.09958 24.366327 54.465907 54.465906 54.465906 30.09958 0 54.465907-24.366327 54.465907-54.465906 0-19.45211-10.442711-37.470906-27.232953-47.299341zM566.363527 732.218356v-284.615077c0-30.09958-24.366327-54.465907-54.465907-54.465906-30.09958 0-54.465907 24.366327-54.465906 54.465906v284.615077c0 30.09958 24.366327 54.465907 54.465906 54.465907 30.09958 0 54.465907-24.366327 54.465907-54.465907z" />
<local:MyListItem x:Name="ItemTest" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Type="RadioBox" Height="36" VerticalAlignment="Top" Title="百宝箱"
LogoScale="0.97" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z" />
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="Clickable" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="Clickable" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
LogoScale="0.92" Logo="M979 1024H45c-24.9 0-45-20.1-45-45s20.1-45 45-45h934c24.9 0 45 20.1 45 45s-20.1 45-45 45zM135 887C60.6 887 0 826.4 0 752V334c0-74.4 60.6-135 135-135s135 60.6 135 135v418c0 74.4-60.6 135-135 135z m0-598c-24.8 0-45 20.2-45 45v418c0 24.8 20.2 45 45 45s45-20.2 45-45V334c0-24.8-20.2-45-45-45zM512 887c-74.4 0-135-60.6-135-135V532c0-74.4 60.6-135 135-135s135 60.6 135 135v220c0 74.4-60.6 135-135 135z m0-400c-24.8 0-45 20.2-45 45v220c0 24.8 20.2 45 45 45s45-20.2 45-45V532c0-24.8-20.2-45-45-45zM889 887c-74.4 0-135-60.6-135-135V135C754 60.6 814.6 0 889 0s135 60.6 135 135v617c0 74.4-60.6 135-135 135z m0-797c-24.8 0-45 20.2-45 45v617c0 24.8 20.2 45 45 45s45-20.2 45-45V135c0-24.8-20.2-45-45-45z" />
</StackPanel>
</local:MyPageLeft>
@@ -125,7 +125,12 @@
End Sub
'打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
Private Sub TryFeedback(sender As Object, e As RouteEventArgs) Handles ItemFeedback.Changed
If Not ItemFeedback.Checked Then Exit Sub
TryFeedback()
e.Handled = True
End Sub
Public Shared Sub TryFeedback()
If Not CanFeedback(True) Then Exit Sub
Select Case MyMsgBox("在提交新反馈前,建议先搜索反馈列表,以避免重复提交。" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"反馈", "提交新反馈", "查看反馈列表", "取消")
@@ -135,7 +140,12 @@
OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
End Select
End Sub
Public Shared Sub TryVote() Handles ItemVote.Click
Private Sub TryVote(sender As Object, e As RouteEventArgs) Handles ItemVote.Changed
If Not ItemVote.Checked Then Exit Sub
TryVote()
e.Handled = True
End Sub
Public Shared Sub TryVote()
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"新功能投票", "打开", "取消") = 2 Then Exit Sub
OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created")
@@ -12,7 +12,7 @@
Public Shared Sub MemoryOptimize(ShowHint As Boolean)
If ShowHint Then Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub MemoryOptimizeInternal()
Public Shared Sub MemoryOptimizeInternal(ShowHint As Boolean)
End Sub
Public Shared Function GetRandomCave() As String
Return "为便于维护,开源内容中不包含百宝箱功能……"
@@ -171,6 +171,9 @@
Log(ex, "添加文件夹失败(" & NewFolder & ")", LogLevel.Feedback)
End Try
End Sub
''' <summary>
''' 将指定文件夹添加到 Minecraft 文件夹列表,并选中它。
''' </summary>
Public Shared Sub AddFolder(FolderPath As String, DisplayName As String, ShowHint As Boolean)
RunInThread(
Sub()
@@ -328,23 +331,24 @@
Next
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
End If
RunInNewThread(Sub()
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Info)
DeleteDirectory(Folder.Path)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Finish)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint)
Finally
'刷新列表
McFolderListLoader.Start(IsForceRestart:=True)
End Try
End Sub, "Folder Delete " & GetUuid(), ThreadPriority.BelowNormal)
RunInNewThread(
Sub()
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Info)
DeleteDirectory(Folder.Path)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Finish)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint)
Finally
'刷新列表
McFolderListLoader.Start(IsForceRestart:=True)
End Try
End Sub, "Folder Delete " & GetUuid(), ThreadPriority.BelowNormal)
End Sub
Public Sub Open_Click(sender As Object, e As RoutedEventArgs)
OpenExplorer("""" & CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Info & """")
OpenExplorer(CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Info)
End Sub
Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs)
Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
@@ -20,11 +20,13 @@
{"HintBuy", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintClearRubbish", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintUpdateMod", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintCustomCommand", New SetupEntry(False, Source:=SetupSource.Registry)},
{"TestSetupReader", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
{"SystemEula", New SetupEntry(False, Source:=SetupSource.Registry)},
{"SystemCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLaunchCount", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemLastVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestSavedBetaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestBetaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemHighestAlphaVersionReg", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"SystemSetupVersionReg", New SetupEntry(VersionSetup, Source:=SetupSource.Registry)},
@@ -37,6 +39,7 @@
{"SystemSystemCache", New SetupEntry("", Source:=SetupSource.Registry)},
{"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)},
{"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageVersion", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheMsOAuthRefresh", New SetupEntry("", Source:=SetupSource.Registry, Encoded:=True)},
@@ -203,15 +206,19 @@
'加载状态:0/未读取 1/已读取未处理 2/已处理
Public State As Byte = 0
Public Type
Public Type As Type
Public Sub New(Value, Optional Source = SetupSource.Normal, Optional Encoded = False)
Me.DefaultValue = Value
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value)
Me.Encoded = Encoded
Me.Value = Value
Me.Source = Source
Type = If(Value, New Object).GetType
Try
Me.DefaultValue = Value
Me.Encoded = Encoded
Me.Value = Value
Me.Source = Source
Me.Type = If(Value, New Object).GetType
Me.DefaultValueEncoded = If(Encoded, SecretEncrypt(Value, "PCL" & UniqueAddress), Value)
Catch ex As Exception
Log(ex, "初始化 SetupEntry 失败", LogLevel.Feedback) '#5095 的 fallback
End Try
End Sub
End Class
@@ -313,6 +320,12 @@
Dim E As SetupEntry = SetupDict(Key)
[Set](Key, E.DefaultValue, E, ForceReload, Version)
End Sub
''' <summary>
''' 获取某个设置项的默认值。
''' </summary>
Public Function GetDefault(Key As String) As String
Return SetupDict(Key).DefaultValue
End Function
Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion)
Try
@@ -220,7 +220,7 @@
<local:MyCard Margin="0,0,0,15" Title="高级启动选项" IsSwaped="True" CanSwap="True">
<Grid Margin="25,40,25,15">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
@@ -232,14 +232,19 @@
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000"
<StackPanel Grid.Row="0" VerticalAlignment="Center" Orientation="Horizontal" HorizontalAlignment="Left" Margin="0,0,25,0">
<TextBlock Text="JVM 参数头" VerticalAlignment="Center" />
<local:MyIconButton Height="23" Margin="0,1,0,0" x:Name="BtnAdvanceJvmReset" VerticalAlignment="Center"
ToolTip="还原" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1"
Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</StackPanel>
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,除非有确定把握,否则请不要修改" MaxLength="4000"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}option.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<StackPanel Margin="0,12,0,4" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
@@ -165,7 +165,7 @@
Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click
Try
File.Delete(PathAppdata & "CustomSkin.png")
RadioSkinType0.SetChecked(True, True, True)
RadioSkinType0.SetChecked(True, True)
Hint("离线皮肤已清空!", HintType.Finish)
Catch ex As Exception
Log(ex, "清空离线皮肤失败", LogLevel.Msgbox)
@@ -194,11 +194,11 @@
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Exit Sub
'获取内存情况
Dim RamGame As Double = GetRam(McVersionCurrent, False)
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable)
Dim RamUsed As Double = RamTotal - RamAvailable
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
Dim RamUsed As Double = Math.Round(RamTotal - RamAvailable, 5)
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000), 1)
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
@@ -214,7 +214,7 @@
If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "")
LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB"
LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB"
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit() AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed)
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit() AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed)
If ShowAnim Then
'宽度动画
AniStart({
@@ -573,6 +573,15 @@ PreFin:
CheckAdvanceRunWait.Visibility = If(TextAdvanceRun.Text = "", Visibility.Collapsed, Visibility.Visible)
End Sub
'JVM 参数重设
Private Sub TextAdvanceJvm_TextChanged() Handles TextAdvanceJvm.ValidatedTextChanged
BtnAdvanceJvmReset.Visibility = If(TextAdvanceJvm.Text = Setup.GetDefault("LaunchAdvanceJvm"), Visibility.Hidden, Visibility.Visible)
End Sub
Private Sub BtnAdvanceJvmReset_Click(sender As Object, e As EventArgs) Handles BtnAdvanceJvmReset.Click
Setup.Reset("LaunchAdvanceJvm")
Reload()
End Sub
#End Region
End Class
@@ -45,11 +45,6 @@
End Sub
Private Sub BtnHiperLog_Click(sender As Object, e As EventArgs) Handles BtnHiperLog.Click
If File.Exists(PageLinkHiper.PathHiper & "logs\hiper.log") Then
OpenExplorer("/select,""" & PageLinkHiper.PathHiper & "logs\hiper.log""")
Else
Hint("没有找到 HiPer 联机模块的日志!")
End If
End Sub
End Class
@@ -54,33 +54,30 @@
<RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载源" Margin="0,0,25,0" />
<!--<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载源" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadMod" Grid.Row="0" Grid.ColumnSpan="2" Tag="ToolDownloadMod" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(暂时无效)" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源" IsSelected="True" />
</local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载文件名" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="2" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1"
</local:MyComboBox>-->
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载文件名" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="0" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1"
ToolTip="下载 Mod 时,Mod 的默认文件名中,中文译名应该放在哪个位置">
<local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" />
<local:MyComboBoxItem Content="译名位于文件名开头:遗物-relics-0.1.14" />
<local:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" />
<local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 管理样式" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="4" x:Name="ComboModLocalNameStyle" Grid.ColumnSpan="2" Tag="ToolModLocalNameStyle" Grid.Column="1"
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 管理样式" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="2" x:Name="ComboModLocalNameStyle" Grid.ColumnSpan="2" Tag="ToolModLocalNameStyle" Grid.Column="1"
ToolTip="在 Mod 管理页面中,Mod 项的显示方式">
<local:MyComboBoxItem Content="标题显示译名,详情显示文件名" IsSelected="True" />
<local:MyComboBoxItem Content="标题显示文件名,详情显示译名" />
</local:MyComboBox>
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="6" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="显示 Mod 加载器时忽略 Quilt" Grid.Row="4" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -34,7 +34,7 @@
'Mod 与整合包
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
'ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
ComboModLocalNameStyle.SelectedIndex = Setup.Get("ToolModLocalNameStyle")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
@@ -96,7 +96,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadMod.SelectionChanged
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
@@ -72,10 +72,10 @@
</Grid>
<local:MyCheckBox Text="打开启动器时显示 PCL 图标" Margin="-1,0,0,1" Height="22" x:Name="CheckLauncherLogo" Tag="UiLauncherLogo" />
</StackPanel>
<Border Background="#CCCCCCCC" Margin="-5,22,-5,-5" CornerRadius="4" Name="PanLauncherHide" Visibility="Collapsed">
<Border Background="#DDDDDDDD" Margin="-8,23,-5,28" CornerRadius="4" Name="PanLauncherHide" Visibility="Collapsed">
<StackPanel HorizontalAlignment="Center" VerticalAlignment="Center">
<TextBlock Text="需要小小赞助一下作者,才能修改主题颜色(悲)……" FontSize="15" Margin="0,2,0,0" />
<local:MyButton Height="35" x:Name="BtnLauncherDonate" MinWidth="150" Text="支持作者" Padding="13,0" HorizontalAlignment="Center" Margin="0,9,0,0" ColorType="Highlight" />
<TextBlock Text="如果可以小小赞助一下 PCL,就能解锁主题颜色更换功能啦……&#xa;多亏了大家的支持,PCL 才能在免费、无任何广告的情况下维持数年的更新(磕头)!" FontSize="13" Margin="0,0,0,0" />
<local:MyButton Height="32" x:Name="BtnLauncherDonate" MinWidth="140" Text="支持 PCL 开发!" Padding="13,0" HorizontalAlignment="Center" Margin="0,9,0,0" ColorType="Highlight" />
</StackPanel>
</Border>
</Grid>
@@ -179,7 +179,7 @@
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="标题栏文本" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextLogoText" Tag="UiLogoText" Grid.Column="1" MaxLength="30" />
<local:MyTextBox x:Name="TextLogoText" Tag="UiLogoText" Grid.Column="1" MaxLength="100" />
</Grid>
<Grid x:Name="PanLogoChange" Margin="0,14,0,5" Height="35" Visibility="Collapsed">
<Grid.ColumnDefinitions>
@@ -225,6 +225,7 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="下载地址" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextCustomNet" Tag="UiCustomNet" Grid.Column="1" MaxHeight="28">
<local:MyTextBox.ValidateRules>
<local:ValidateNullable />
<local:ValidateHttp />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
@@ -244,9 +245,10 @@
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
<local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" />
<local:MyComboBoxItem Content="PCL 更新日志(作者:Joker2184)" />
<local:MyComboBoxItem Content="PCL 新闻速报(作者:Joker2184)" />
<local:MyComboBoxItem Content="PCL 新功能说明书(作者:WForst-Breeze)" />
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" />
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" Visibility="Collapsed" />
<local:MyComboBoxItem Content="杂志主页(作者:CreeperIsASpy)" />
</local:MyComboBox>
</Grid>
</StackPanel>
@@ -261,7 +263,7 @@
<ColumnDefinition Width="0.8*" />
<ColumnDefinition Width="0.9*" />
<ColumnDefinition Width="0.8*" />
<ColumnDefinition Width="0.6*" />
<ColumnDefinition Width="0.8*" />
<ColumnDefinition Width="1.0*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
@@ -42,8 +42,8 @@
'设置解锁
If Not RadioLauncherTheme8.IsEnabled Then LabLauncherTheme8Copy.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁。" & vbCrLf & "右键打开赞助页面,如果觉得 PCL 做得还不错就支持一下吧 =w=!"
RadioLauncherTheme8.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁(右键打开反馈页面)" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁(右键打开反馈页面)" & vbCrLf & "· 提交一个 Pull Request 或主页预设,在标记为 [完成] 后回复识别码要求解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁" & vbCrLf & "· 提交一个 Pull Request 或主页预设,在标记为 [完成] 后回复识别码要求解锁"
'极客蓝的处理在 ThemeCheck 中
End Sub
@@ -189,7 +189,7 @@
'背景图片
Private Sub BtnUIBgOpen_Click(sender As Object, e As EventArgs) Handles BtnBackgroundOpen.Click
OpenExplorer("""" & Path & "PCL\Pictures""")
OpenExplorer(Path & "PCL\Pictures\")
End Sub
Private Sub BtnBackgroundRefresh_Click(sender As Object, e As EventArgs) Handles BtnBackgroundRefresh.Click
BackgroundRefresh(True, True)
@@ -335,7 +335,7 @@ Refresh:
Private Sub BtnLogoDelete_Click(sender As Object, e As EventArgs) Handles BtnLogoDelete.Click
Try
File.Delete(Path & "PCL\Logo.png")
RadioLogoType1.SetChecked(True, True, True)
RadioLogoType1.SetChecked(True, True)
Hint("标题栏图片已清空!", HintType.Finish)
Catch ex As Exception
Log(ex, "清空标题栏图片失败", LogLevel.Msgbox)
@@ -344,7 +344,7 @@ Refresh:
'背景音乐
Private Sub BtnMusicOpen_Click(sender As Object, e As EventArgs) Handles BtnMusicOpen.Click
OpenExplorer("""" & Path & "PCL\Musics""")
OpenExplorer(Path & "PCL\Musics\")
End Sub
Private Sub BtnMusicRefresh_Click(sender As Object, e As EventArgs) Handles BtnMusicRefresh.Click
MusicRefreshPlay(True)
@@ -407,7 +407,7 @@ Refresh:
End If
WriteFile(Path & "PCL\Custom.xaml", GetResources("Custom"))
Hint("教学文件已生成!", HintType.Finish)
OpenExplorer("/select,""" & Path & "PCL\Custom.xaml""")
OpenExplorer(Path & "PCL\Custom.xaml")
Catch ex As Exception
Log(ex, "生成教学文件失败", LogLevel.Feedback)
End Try
@@ -452,10 +452,10 @@ Refresh:
End If
End If
End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp, RadioLauncherTheme8.MouseRightButtonUp
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp, RadioLauncherTheme9.MouseRightButtonUp
PageOtherLeft.TryFeedback()
End Sub
@@ -675,24 +675,26 @@ Refresh:
SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherSat.GetHintText = Function(v) v & "%"
SliderLauncherDelta.GetHintText = Function(Value As Integer)
If Value > 90 Then
Return "+" & (Value - 90)
ElseIf Value = 90 Then
Return 0
Else
Return Value - 90
End If
End Function
SliderLauncherLight.GetHintText = Function(Value As Integer)
If Value > 20 Then
Return "+" & (Value - 20)
ElseIf Value = 20 Then
Return 0
Else
Return Value - 20
End If
End Function
SliderLauncherDelta.GetHintText =
Function(Value As Integer)
If Value > 90 Then
Return "+" & (Value - 90)
ElseIf Value = 90 Then
Return 0
Else
Return Value - 90
End If
End Function
SliderLauncherLight.GetHintText =
Function(Value As Integer)
If Value > 20 Then
Return "+" & (Value - 20)
ElseIf Value = 20 Then
Return 0
Else
Return Value - 20
End If
End Function
SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%"
SliderBackgroundBlur.GetHintText = Function(v) v & " 像素"
End Sub
@@ -0,0 +1,271 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionExport"
PanScroll="{Binding ElementName=PanBack}">
<local:MyPageRight.Resources>
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
</local:MyPageRight.Resources>
<Grid x:Name="PanAllBack">
<Grid.Resources>
<Style TargetType="local:MyCheckBox">
<Setter Property="Height" Value="26" />
</Style>
</Grid.Resources>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Margin="25,10,25,65">
<local:MyHint Margin="0,15,0,0" Text="受 Modrinth 整合包规范限制,导出的整合包中暂不包含 OptiFine。" IsWarn="False" x:Name="HintOptiFine" />
<local:MyCard Margin="0,15">
<Grid Margin="22,15,25,15">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="0.3*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" Grid.Column="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="整合包名称" Margin="0,0,20,0" />
<local:MyTextBox Grid.Row="0" Grid.Column="1" x:Name="TextExportName" MaxLength="100" />
<TextBlock Grid.Row="0" Grid.Column="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="整合包版本" Margin="30,0,20,0" />
<local:MyTextBox Grid.Row="0" Grid.Column="3" x:Name="TextExportVersion" Tag="VersionArgumentTitle" MaxLength="100" />
</Grid>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" x:Name="CardOptions" MinHeight="39">
<local:MyIconTextButton x:Name="BtnOverrideCancel" Height="24" HorizontalAlignment="Right" VerticalAlignment="Center" Margin="0,0,5,0"
IsHitTestVisible="False" Opacity="0.5"
Text="重置" Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
<StackPanel Margin="25,38,15,15" Name="PanOptions">
<local:MyCheckBox IsEnabled="False" x:Name="CheckOptionsBasic">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="游戏本体"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox x:Name="CheckOptionsOptions" Margin="30,0,0,0">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="游戏本体设置"
Description="键位、音量、视频设置等"
Rules="options.txt|configureddefaults/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox Margin="30,0,0,0">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="游戏本体个人信息"
Description="命令历史、已保存的快捷栏"
Rules="hotbar.nbt|command_history.txt"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox Margin="30,0,0,0">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="OptiFine 设置"
Rules="optionsof.txt|optionsshaders.txt"
DefaultChecked="True"
RequireOptiFine="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox x:Name="CheckOptionsMod">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="Mod"
Description="模组"
Rules="mods/|!mods/*.disabled|!mods/*.old|!mods/.connector/|coremods/|lib/"
DefaultChecked="True"
RequireModLoader="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<StackPanel Margin="30,0,0,0"
Visibility="{Binding Checked, ElementName=CheckOptionsMod, Converter={StaticResource BooleanToVisibilityConverter}}">
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="已禁用的 Mod"
Rules="mods/*.disabled|mods/*.old" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="整合包重要数据"
Description="脚本文件、内置资源包、数据包等"
Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="Mod 设置"
Rules="config/|!config/jei/world/|!config/worldedit/|config/worldedit/worldedit.properties|!config/spark/|config/spark/config.json|defaultconfigs/|journeymap/config/|journeymap/server/|TrashSlotSaveState.json|customfov.txt|gg.essential.mod/|essential/|!essential/*/|!essential/*.jar*|!essential/screenshot-checksum-caches.json|!essential/microsoft_accounts.json|paragliderSettings.nbt|local/client_config.json|local/ftbl.json|local/client/sidebar_buttons.json|local/client/ftbutilities.cfg|local/client/ftblib.cfg|local/client/xencraft.cfg|liteloader.properties|default_reference.xml|CustomSkinLoader/CustomSkinLoader.json"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="已绘制的地图"
Description="地图类 Mod 为现有的存档、服务器记录的地图、路标点等"
Rules="journeymap/data/|xaero/"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="JEI 个人信息"
Description="物品收藏夹等"
Rules="config/jei/world/"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="EMI 个人信息"
Description="物品收藏夹、默认配方、合成历史记录等"
Rules="emi.json"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="帕秋莉手册个人信息"
Description="教程书的已读记录、书签、阅读历史记录等"
Rules="patchouli_data.json"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
</StackPanel>
<local:MyCheckBox x:Name="CheckOptionsResourcePacks">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="资源包"
Description="纹理包/材质包"
ShowRules="resourcepacks/|texturepacks/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<StackPanel Margin="30,0,0,0" x:Name="PanOptionsResourcePacks"
Visibility="{Binding Checked, ElementName=CheckOptionsResourcePacks, Converter={StaticResource BooleanToVisibilityConverter}}">
</StackPanel>
<local:MyCheckBox x:Name="CheckOptionsShaderPacks">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="光影包"
ShowRules="shaderpacks/"
DefaultChecked="True"
RequireModLoaderOrOptiFine="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<StackPanel Margin="30,0,0,0" x:Name="PanOptionsShaderPacks"
Visibility="{Binding Checked, ElementName=CheckOptionsShaderPacks, Converter={StaticResource BooleanToVisibilityConverter}}">
</StackPanel>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="截图"
Rules="screenshots/"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="导出的结构"
Description="schematics 文件夹"
Rules="schematics/"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="录像回放"
Description="Replay Mod 的录像文件"
Rules="replay_recordings/|replay_videos/"
RequireModLoader="True"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox x:Name="CheckOptionsSaves">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="单人游戏存档"
Description="世界/地图"
ShowRules="saves/"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<StackPanel Margin="30,0,0,0" x:Name="PanOptionsSaves"
Visibility="{Binding Checked, ElementName=CheckOptionsSaves, Converter={StaticResource BooleanToVisibilityConverter}}">
</StackPanel>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="多人游戏服务器列表"
Rules="servers.dat"
DefaultChecked="False" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox x:Name="CheckOptionsPcl">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="PCL 启动器程序"
Description="打包正式版 PCL,以便没有启动器的玩家安装整合包"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<StackPanel Margin="30,0,0,0"
Visibility="{Binding Checked, ElementName=CheckOptionsPcl, Converter={StaticResource BooleanToVisibilityConverter}}">
<local:MyCheckBox x:Name="CheckOptionsPclCustom">
<local:MyCheckBox.Tag>
<local:ExportOption
Title="PCL 个性化内容"
Description="功能隐藏设置、主页、背景音乐和图片等"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
</StackPanel>
</StackPanel>
</local:MyCard>
<local:MyCard Title="高级选项" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,37,23,20">
<local:MyHint Text="建议仅在无法稳定连接 CurseForge 或 Modrinth 时才打包资源文件。&#xa;二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!"
IsWarn="False" Margin="0,0,0,4"
Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" />
<local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude"
ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" />
<local:MyCheckBox Text="Modrinth 上传模式" x:Name="CheckAdvancedModrinth"
ToolTip="如果你想要打包上传到 Modrinth,勾选此项会生成完全符合 Modrinth 要求的整合包文件。&#xa;由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。&#xa;此外,勾选后也不能在整合包中包含 PCL 启动器文件。" />
<Rectangle Height="1" Fill="{StaticResource ColorBrushGray5}" Margin="0,15,0,15" />
<TextBlock Text="通过配置文件,你可以精准地控制导出内容的范围,或是保存当前的配置以便之后使用。" TextWrapping="WrapWithOverflow" />
<Grid Height="35" Margin="0,12,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnAdvancedImport" MinWidth="140" Text="读取配置" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton Grid.Column="1" x:Name="BtnAdvancedExport" MinWidth="140" Text="保存配置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" MinWidth="140" Text="整合包制作指南" Padding="13,0" Margin="0,0,20,0" x:Name="BtnAdvancedHelp"
EventType="打开帮助" />
</Grid>
</StackPanel>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
<local:MyExtraTextButton HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="20"
x:Name="BtnExport" Text="开始导出"
LogoScale="1.1" 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" />
</Grid>
</local:MyPageRight>
@@ -0,0 +1,719 @@
Imports System.IO.Compression
Public Class ExportOption
Public Property Title As String
Public Property Description As String
Public Property Rules As String
''' <summary>
''' 如果 Rules 为空,则根据 ShowRules 的内容判断是否应该显示这个复选框。
''' 如果 ShowRules 也为空,则始终显示。
''' </summary>
Public Property ShowRules As String
Public Property DefaultChecked As Boolean
Public Property RequireModLoader As Boolean = False
Public Property RequireOptiFine As Boolean = False
Public Property RequireModLoaderOrOptiFine As Boolean = False
End Class
Public Class PageVersionExport
Implements IRefreshable
Private CurrentVersion As String = ""
Private Sub PageVersionExport_Loaded() Handles Me.Loaded
AniControlEnabled += 1
If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面
BtnAdvancedHelp.EventData = If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json")
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面")
HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentVersion = PageVersionLeft.Version.Path
TextExportName.Text = ""
TextExportName.HintText = PageVersionLeft.Version.Name
TextExportVersion.Text = ""
TextExportVersion.HintText = "1.0.0"
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetDefaultDescription()
ResetConfigOverrides()
ReloadAllSubOptions()
RefreshAllOptionsUI()
PanBack.ScrollToHome()
End Sub
#Region "子选项"
Private SubOptionBlackList As String() = {"Quark Programmer Art.zip", "+ EuphoriaPatches_"}
''' <summary>
''' 动态生成子文件夹下的选项,例如资源包、存档等。
''' </summary>
Private Sub ReloadAllSubOptions()
ReloadSubOptions(PanOptionsResourcePacks, True, True, "resourcepacks", "texturepacks")
ReloadSubOptions(PanOptionsSaves, False, True, "saves")
ReloadSubOptions(PanOptionsShaderPacks, True, True, "shaderpacks")
End Sub
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear()
For Each Folder In Folders
Dim TargetFolder As New DirectoryInfo(PageVersionLeft.Version.PathIndie & Folder)
If Not TargetFolder.Exists() Then Continue For
'查找文件夹下的对应项
If AcceptCompressedFile Then
For Each File In TargetFolder.EnumerateFiles("*.zip").Concat(TargetFolder.EnumerateFiles("*.rar"))
If SubOptionBlackList.Any(Function(b) File.Name.ContainsF(b)) Then Continue For
Panel.Children.Add(New MyCheckBox With {. _
Tag = New ExportOption With {.Title = File.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{File.Name}")}})
Next
End If
If AcceptFolder Then
For Each SubFolder In TargetFolder.EnumerateDirectories().OrderByDescending(Function(f) f.LastWriteTime)
If SubOptionBlackList.Any(Function(b) SubFolder.Name.ContainsF(b)) Then Continue For
If Not SubFolder.EnumerateFileSystemInfos().Any() Then Continue For
Dim NewCheckBox As New MyCheckBox With {. _
Tag = New ExportOption With {.Title = SubFolder.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{SubFolder.Name}/")}}
If Panel Is PanOptionsSaves Then GetExportOption(NewCheckBox).Description = SubFolder.LastWriteTime.ToString("yyyy'/'MM'/'dd HH':'mm")
Panel.Children.Add(NewCheckBox)
Next
End If
Next
End Sub
#End Region
#Region "选项"
''' <summary>
''' 重新确认是否应该显示每个选项,并将 ExportOption 同步到 UI。
''' </summary>
Private Sub RefreshAllOptionsUI()
'预先归纳所有至多二级的文件/文件夹
Dim AllEntries As New List(Of String)
Dim IsValidDirectory = '检查文件夹不为空
Function(Folder As DirectoryInfo) As Boolean
Try
Return Folder.Exists AndAlso
Folder.EnumerateFileSystemInfos().Any(Function(i) Not SubOptionBlackList.Any(Function(b) i.Name.ContainsF(b)))
Catch '一般是由于无法访问,或是一个指向已不存在的文件夹的链接(例如使用 mklink 创造的 resource 文件夹链接)
Return False
End Try
End Function
Dim PathInfo As New DirectoryInfo(PageVersionLeft.Version.PathIndie)
AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\")
AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}"))
AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\"))
Next
Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
'确认选项是否应该被显示
Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean
'检查需要 OptiFine 或 Mod 加载器
If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False
If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False
If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False
'粗略检查是否可能有符合规则的文件/文件夹
Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
Function(Rule As String)
If Rule.StartsWithF("!") Then Return False '只看正向规则
'检查前两级
Try
If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
Catch ex As Exception
Log(ex, $"错误的规则:{Rule}", LogLevel.Hint)
Return False
End Try
'粗略检查所有级
Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效
Else
Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效
End If
Else
Return False
End If
End Function)
End Function
'逐个检查选项
For Each CheckBox In GetAllOptions(True)
Dim TargetOption = GetExportOption(CheckBox)
'名称与简介
CheckBox.Inlines.Clear()
CheckBox.Inlines.Add(New Run(TargetOption.Title))
If Not String.IsNullOrEmpty(TargetOption.Description) Then
CheckBox.Inlines.Add(New Run(" " & TargetOption.Description) With {.Foreground = ColorGray5})
End If
'可见性、默认勾选
If String.IsNullOrEmpty(TargetOption.Rules) AndAlso String.IsNullOrEmpty(TargetOption.ShowRules) Then
CheckBox.Visibility = Visibility.Visible
CheckBox.Checked = TargetOption.DefaultChecked
Else
Dim Pass As Boolean = IsVisible(TargetOption)
CheckBox.Visibility = If(Pass, Visibility.Visible, Visibility.Collapsed)
CheckBox.Checked = TargetOption.DefaultChecked AndAlso Pass
End If
Next
End Sub
''' <summary>
''' 对文本行进行标准化处理,以便使用 Like 进行匹配。
''' </summary>
Private Iterator Function StandardizeLines(Raw As IEnumerable(Of String), AddSuffixStarToFolderPath As Boolean) As IEnumerable(Of String)
For Each IgnoreLine In Raw
IgnoreLine = IgnoreLine.Trim
If IgnoreLine = "" OrElse IgnoreLine.StartsWithF("#") OrElse IgnoreLine.StartsWithF("=") Then Continue For
IgnoreLine = IgnoreLine.Replace("/", "\")
Yield IgnoreLine & If(IgnoreLine.EndsWithF("\") AndAlso AddSuffixStarToFolderPath, "*", "")
Next
End Function
''' <summary>
''' 获取所有可作为选项的 CheckBox。
''' </summary>
Private Iterator Function GetAllOptions(IncludeHidden As Boolean) As IEnumerable(Of MyCheckBox)
For Each Element In PanOptions.Children
If Not IncludeHidden AndAlso Element.Visibility <> Visibility.Visible Then Continue For
If TypeOf Element Is MyCheckBox Then
Yield Element
ElseIf TypeOf Element Is StackPanel Then
For Each SubElement In DirectCast(Element, StackPanel).Children
If Not IncludeHidden AndAlso SubElement.Visibility <> Visibility.Visible Then Continue For
If TypeOf SubElement Is MyCheckBox Then Yield SubElement
Next
End If
Next
End Function
''' <summary>
''' 获取该 CheckBox 对应的 ExportOption。
''' </summary>
Private Function GetExportOption(CheckBox As MyCheckBox) As ExportOption
Return CType(CheckBox.Tag, ExportOption)
End Function
#End Region
#Region "配置文件"
Private Const Sperator As String = "=============================================================="
' ================ 导出内容段 ================
''' <summary>
''' 从配置文件中读取的规则。
''' 如果不为 Nothing,则会覆写当前勾选的规则并禁用对应 UI。
''' </summary>
Private Property RulesOverrides As List(Of String)
Get
Return _RulesOverrides
End Get
Set(value As List(Of String))
_RulesOverrides = value
If value Is Nothing Then
BtnOverrideCancel.Visibility = Visibility.Collapsed
PanOptions.Visibility = Visibility.Visible
CardOptions.Inlines.Clear()
CardOptions.Inlines.Add(New Run("导出内容列表") With {.FontWeight = FontWeights.Bold})
Else
BtnOverrideCancel.Visibility = Visibility.Visible
PanOptions.Visibility = Visibility.Collapsed
CardOptions.Inlines.Clear()
CardOptions.Inlines.Add(New Run("导出内容列表:    ") With {.FontWeight = FontWeights.Bold})
CardOptions.Inlines.Add(New Run("从配置文件中读取") With {.FontWeight = FontWeights.Normal})
End If
End Set
End Property
Private _RulesOverrides As List(Of String) = Nothing
''' <summary>
''' 获取当前实际生效的所有规则。
''' </summary>
Private Iterator Function GetAllRules() As IEnumerable(Of String)
If RulesOverrides IsNot Nothing Then
'返回覆盖的列表
For Each Rule In RulesOverrides
Yield Rule
Next
Else
'从当前勾选的所有选项中获取所有规则行
Yield ""
Yield "# 修改下方的规则以控制需要导出的内容。"
Yield "# 以 ! 开头以反选。可以使用 *、?、[] 通配符。靠后的行覆盖靠前的。"
Yield ""
For Each CheckBox In GetAllOptions(False)
If Not CheckBox.Checked Then Continue For
Dim TargetOption = GetExportOption(CheckBox)
If TargetOption.Rules Is Nothing Then Continue For
Yield $"# {TargetOption.Title}"
For Each Rule In TargetOption.Rules.Split("|"c)
Yield Rule
Next
Yield ""
Next
Yield "# 排除的文件"
Yield "!*.log"
Yield "!*.dat_old"
Yield "!*.BakaCoreInfo"
Yield ""
End If
End Function
' ================ 追加内容段 ================
Private ExtraFiles As List(Of String) = Nothing
''' <summary>
''' 获取当前实际生效的追加内容。
''' </summary>
Private Iterator Function GetExtraFileLines() As IEnumerable(Of String)
If ExtraFiles IsNot Nothing Then
'返回覆盖的列表
For Each File In ExtraFiles
Yield File
Next
Else
'从当前勾选的所有选项中获取所有规则行
Yield ""
Yield "# 如果想将额外的文件自动放到压缩包根目录中,可以将它们的路径写在下方。"
Yield "# 必须是完整路径。每行中,若以 \ 结尾则代表是文件夹,不以 \ 结尾则代表是文件。"
Yield ""
End If
End Function
' ================ 重置 ================
''' <summary>
''' 重置配置文件所带来的影响。
''' </summary>
Private Sub ResetConfigOverrides()
RulesOverrides = Nothing
ConfigPackPath = Nothing
ExtraFiles = Nothing
PanBack.ScrollToHome()
End Sub
Private Sub CardOptions_MouseLeftButtonDown() Handles CardOptions.MouseLeftButtonDown
If RulesOverrides Is Nothing Then Return
ResetConfigOverrides()
End Sub
' ================ 保存 / 读取 ================
'保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Setup.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String)
'ini 段
ConfigLines.Add("Name:" & TextExportName.Text)
ConfigLines.Add("Version:" & TextExportVersion.Text)
ConfigLines.Add("")
ConfigLines.Add("# 是否打包正式版 PCL,以便没有启动器的玩家安装整合包。")
ConfigLines.Add("IncludeLauncher:" & CheckOptionsPcl.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 是否打包 PCL 个性化内容,例如功能隐藏设置、主页、背景音乐和图片等。")
ConfigLines.Add("IncludeLauncherCustom:" & CheckOptionsPclCustom.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 是否将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。")
ConfigLines.Add("# 建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑启用。")
ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 如果你想要打包上传到 Modrinth,启用此项会生成完全符合 Modrinth 要求的整合包文件。")
ConfigLines.Add("# 由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。")
ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。")
ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 导出的文件的存放位置。")
ConfigLines.Add("# 若设置了此项,在导出时会直接将文件放到此路径,不会弹窗要求选择。")
ConfigLines.Add("# 若 IncludeLauncher 为 True,应以 .zip 结尾;若为 False,应以 .mrpack 结尾。")
ConfigLines.Add("PackPath:" & If(ConfigPackPath, ""))
ConfigLines.Add("")
'导出内容段
ConfigLines.Add(Sperator)
ConfigLines.AddRange(GetAllRules())
'追加内容段
ConfigLines.Add(Sperator)
ConfigLines.AddRange(GetExtraFileLines())
'结束
WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
Hint("已保存配置文件:" & ConfigPath, HintType.Finish)
OpenExplorer(ConfigPath)
Catch ex As Exception
Log(ex, "保存配置失败", LogLevel.Msgbox)
End Try
End Sub
'读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click
Try
Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Setup.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
'ini 段
Dim Ini As New Dictionary(Of String, String)
For Each Line In Segments(0).Split(vbCrLf.ToCharArray())
Line = Line.Trim
If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
Dim Index As Integer = Line.IndexOfF(":")
If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1)
Next
TextExportName.Text = Ini.GetOrDefault("Name", "")
TextExportVersion.Text = Ini.GetOrDefault("Version", "")
CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True)
CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True)
CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False)
CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False)
ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
'导出内容段
RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
'追加内容段
If Segments.Length > 2 Then
ExtraFiles = Segments(2).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
Else
ExtraFiles = Nothing
End If
'结束
Hint("已读取配置文件:" & ConfigPath, HintType.Finish)
Catch ex As Exception
Log(ex, "读取配置失败", LogLevel.Msgbox)
End Try
End Sub
#End Region
#Region "导出"
''' <summary>
''' 配置文件中指定的导出位置。
''' </summary>
Private ConfigPackPath As String = Nothing
''' <summary>
''' 开始导出。
''' </summary>
Private Sub StartExport() Handles BtnExport.Click
Dim PackName As String = If(String.IsNullOrEmpty(TextExportName.Text), TextExportName.HintText, TextExportName.Text)
Dim PackVersion As String = If(String.IsNullOrEmpty(TextExportVersion.Text), "1.0.0", TextExportVersion.Text)
'重复任务检查
Dim LoaderName As String = $"导出整合包:" & PackName
For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> LoaderName Then Continue For
FrmMain.PageChange(FormMain.PageType.DownloadManager)
Return
Next
'确认导出位置
Dim Extension As String = If(CheckOptionsPcl.Checked, ".zip", ".mrpack")
Dim PackPath As String = Nothing
If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
(Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
Try
Directory.CreateDirectory(GetPathFromFullPath(ConfigPackPath))
PackPath = ConfigPackPath
Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{GetExceptionDetail(ex)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try
End If
If PackPath Is Nothing Then
PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text),
$"整合包文件(*{Extension})|*{Extension}")
Log($"[Export] 手动指定的导出路径:{PackPath}")
End If
If String.IsNullOrEmpty(PackPath) Then Return
'缓存所需参数
Dim CacheFolder = RequestTaskTempFolder()
Dim OverridesFolder = CacheFolder & "modpack\overrides\"
Dim McVersion = PageVersionLeft.Version
Dim PathIndie As String = McVersion.PathIndie
Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
Dim IncludePCL As Boolean = CheckOptionsPcl.Checked
Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
Dim AllRules = StandardizeLines(GetAllRules(), True).ToList()
Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList()
Log($"[Export] 准备导出整合包,共有 {AllRules.Count} 条规则,{AllExtraFiles.Count} 条追加内容行")
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
#Region "准备 PCL 文件"
#If Not BETA Then
If IncludePCL Then
Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
Sub(Loader As LoaderTask(Of Integer, Integer))
DownloadLatestPCL(Loader)
CopyFile(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
End Sub) With {.ProgressWeight = 0.5, .Block = False})
End If
#End If
#End Region
#Region "复制文件"
Loaders.Add(New LoaderTask(Of Integer, List(Of McMod))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of McMod)))
Loader.Output = New List(Of McMod)
'复制版本文件
Dim Progress As Integer = 0
Dim SearchFolder As Action(Of DirectoryInfo)
SearchFolder =
Sub(Folder As DirectoryInfo)
'文件夹:进一步搜索
For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly)
'跳过部分又没用文件又多的文件夹,加快搜索
If Folder.FullName = PathIndie AndAlso {"assets", "versions", "libraries"}.Contains(SubFolder.Name) Then Continue For
If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For
SearchFolder(SubFolder)
Next
'文件:检查规则并复制
For Each Entry In Folder.EnumerateFiles("*", SearchOption.TopDirectoryOnly)
Dim RelativePath As String = Entry.FullName.AfterFirst(PathIndie)
'检查规则
Dim ShouldKeep As Boolean = False
For Each Rule In AllRules
Dim Revert = Rule.StartsWith("!")
If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
Next
If Not ShouldKeep Then Continue For
Dim TargetPath As String = OverridesFolder & RelativePath
CopyFile(Entry.FullName, TargetPath)
'若为压缩包,考虑联网获取路径
If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.ToLower) AndAlso
{"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
Dim ModFile As New McMod(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash
Unused = ModFile.CurseForgeHash
Loader.Output.Add(ModFile)
End If
'更新进度(进度并不准确,主要突出一个我还没似)
Progress += 1
If Progress = 25 Then
Loader.Progress += (0.94 - Loader.Progress) * 0.012
Progress = 0
End If
Next
End Sub
SearchFolder(New DirectoryInfo(PathIndie))
Log($"[Export] 复制 overrides 文件完成,有 {Loader.Output.Count} 个文件需要联网检查")
Loader.Progress = 0.95
'复制追加内容到根目录
Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
For Each Line In AllExtraFiles
If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
If Directory.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
Else
Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Critical)
End If
Else
If File.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
Else
Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Critical)
End If
End If
Next
Loader.Progress = 0.97
'复制 PCL 版本设置
CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\")
#If BETA Then
'复制 PCL 本体
If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
#End If
'复制 PCL 个性化内容
If IncludePCLCustom Then
If Directory.Exists(Path & "PCL\Pictures\") Then CopyDirectory(Path & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If Directory.Exists(Path & "PCL\Musics\") Then CopyDirectory(Path & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If Directory.Exists(Path & "PCL\Help\") Then CopyDirectory(Path & "PCL\Help\", CacheFolder & "PCL\Help\")
If File.Exists(Path & "PCL\Custom.xaml") Then CopyFile(Path & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If File.Exists(Path & "PCL\Setup.ini") Then CopyFile(Path & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If File.Exists(Path & "PCL\hints.txt") Then CopyFile(Path & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If File.Exists(Path & "PCL\Logo.png") Then CopyFile(Path & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
End If
End Sub) With {.ProgressWeight = 5})
#End Region
#Region "联网检查"
Loaders.Add(New LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String))))
Loader.Output = New Dictionary(Of McMod, List(Of String))
If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件,跳过联网获取步骤") : Return
'分平台获取下载地址
Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception)
'从 Modrinth 获取信息
RunInNewThread(
Sub()
Try
Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash)
Dim ModrinthRaw = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
For Each ModFile In Loader.Input
'查找对应的文件
If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
If ModrinthRaw(ModFile.ModrinthHash)?("files")?(0)("hashes")?("sha1") <> ModFile.ModrinthHash Then Continue For
'写入下载地址
Loader.Output.AddToList(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
Next
Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
Loader.Progress += 0.45
End Try
End Sub, "Modrinth - " & LoaderName)
'从 CurseForge 获取信息
RunInNewThread(
Sub()
Try
If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不能从 CurseForge 获取信息
Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
For Each ResultJson As JObject In CurseForgeRaw
If Not ResultJson.ContainsKey("file") Then Continue For
Dim File As JObject = ResultJson("file")
If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
'查找对应的文件
Dim ModFile As McMod = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
If ModFile Is Nothing Then Continue For
'写入下载地址
For Each Address In CompFile.HandleCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddToList(ModFile, Address)
Next
Next
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
Loader.Progress += 0.45
End Try
End Sub, "CurseForge - " & LoaderName)
'等待线程结束
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub
Thread.Sleep(10)
Loop
'若失败,确认是否继续
If FailedExceptions.Count = 1 Then
If MyMsgBox("联网获取部分文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
"若继续,无法获取信息的文件将被直接打包。" & vbCrLf &
"由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
"部分文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
ElseIf FailedExceptions.Count > 1 Then
If MyMsgBox("联网获取文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
"若继续,所有文件都将被直接打包。" & vbCrLf &
"由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
"文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
End If
End Sub) With {.Show = CheckHostedAssets, .ProgressWeight = If(CheckHostedAssets, 2, 0.01)})
#End Region
#Region "生成压缩包"
Loaders.Add(New LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer))
'整理文件列表
Dim Files As New JArray
For Each Pair In Loader.Input
Dim ModFile As McMod = Pair.Key
Files.Add(New JObject From {
{"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
{"downloads", New JArray(Pair.Value.OrderByDescending(Function(u) u.Contains("modrinth.com")))},
{"fileSize", New FileInfo(ModFile.Path).Length}
})
File.Delete(ModFile.Path)
Next
Loader.Progress = 0.2
'导出最终 JSON 文件
Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}}
If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion)
If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion)
If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion)
Dim ResultJson As New JObject From {
{"game", "minecraft"},
{"formatVersion", 1},
{"versionId", PackVersion},
{"name", PackName},
{"summary", McVersion.Info},
{"files", Files},
{"dependencies", Dependencies}
}
File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
'打包
Directory.CreateDirectory(GetPathFromFullPath(PackPath))
If File.Exists(PackPath) Then File.Delete(PackPath)
If IncludePCL Then
'首次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
Loader.Progress = 0.5
Directory.Delete(CacheFolder & "modpack\", True)
Loader.Progress = 0.6
'二次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder, PackPath)
Loader.Progress = 0.9
Else
'直接压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
Loader.Progress = 0.8
End If
Directory.Delete(CacheFolder, True)
OpenExplorer(PackPath)
End Sub) With {.ProgressWeight = 6})
#End Region
'启动
Dim MainLoader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
MainLoader.Start()
LoaderTaskbarAdd(MainLoader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
FrmMain.PageChange(FormMain.PageType.DownloadManager)
End Sub
#End Region
'自动填写整合包名称
Private Sub TextExportName_GotFocus() Handles TextExportName.GotFocus
If TextExportName.Text = "" Then
TextExportName.Text = TextExportName.HintText
TextExportName.SelectionStart = TextExportName.Text.Length
End If
End Sub
'勾选 Modrinth 上传模式时,禁止打包 PCL
Private Sub CheckAdvancedModrinth_Change(sender As Object, user As Boolean) Handles CheckAdvancedModrinth.Change
If CheckAdvancedModrinth.Checked Then CheckOptionsPcl.Checked = False
CheckOptionsPcl.IsEnabled = Not CheckAdvancedModrinth.Checked
End Sub
'勾选打包资源文件时,禁止开启 Modrinth 上传模式
Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
CheckAdvancedModrinth.IsEnabled = Not CheckAdvancedInclude.Checked
End Sub
End Class
@@ -23,5 +23,13 @@
</local:MyListItem>
<local:MyListItem x:Name="ItemModDisabled" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod 管理"
Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z" />
<local:MyListItem x:Name="ItemExport" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="导出"
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="4" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" Click="Refresh" LogoScale="0.85" 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>
@@ -1,4 +1,5 @@
Public Class PageVersionLeft
Implements IRefreshable
''' <summary>
''' 当前显示设置的 MC 版本。
@@ -25,7 +26,7 @@
''' <summary>
''' 勾选事件改变页面。
''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -46,6 +47,9 @@
Case FormMain.PageSubType.VersionSetup
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
Return FrmVersionSetup
Case FormMain.PageSubType.VersionExport
If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport
Return FrmVersionExport
Case Else
Throw New Exception("未知的版本设置子页面种类:" & ID)
End Select
@@ -88,7 +92,20 @@
#End Region
Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用
PageVersionMod.Refresh()
Refresh(Val(sender.Tag))
End Sub
Public Sub Refresh() Implements IRefreshable.Refresh
Refresh(FrmMain.PageCurrentSub)
End Sub
Public Sub Refresh(SubType As FormMain.PageSubType)
Select Case SubType
Case FormMain.PageSubType.VersionMod
PageVersionMod.Refresh()
ItemMod.Checked = True
Case FormMain.PageSubType.VersionExport
If FrmVersionExport IsNot Nothing Then FrmVersionExport.RefreshAll()
ItemExport.Checked = True
End Select
End Sub
Public Sub Reset(sender As Object, e As EventArgs)
@@ -16,11 +16,13 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageOpen" Grid.Column="0" MinWidth="140" Text="打开 Mod 文件夹" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnManageSelectAll" Grid.Column="1" MinWidth="140" Text="全选" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageInstall" Grid.Column="2" MinWidth="140" Text="安装 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
<local:MyButton x:Name="BtnManageOpen" Grid.Column="0" MinWidth="110" Text="打开文件夹" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageCheck" Grid.Column="4" MinWidth="110" Text="检查 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid>
</local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
@@ -37,10 +39,19 @@
</local:MyScrollViewer>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40" x:Name="PanEmpty">
<StackPanel Margin="20,17">
<TextBlock Margin="0,0,0,9" HorizontalAlignment="Center" Text="未找到 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock Margin="0,0,0,9" HorizontalAlignment="Center" Text="尚未安装 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Margin="10,15,10,0" Text="要安装 Mod,请直接将 Mod 文件拖入 PCL 窗口。&#xa;如果你确定你已经安装了 Mod,但仍然看到了这条提示,则是版本隔离设置有误,请在启动设置中调整版本隔离选项。" TextWrapping="Wrap" />
<local:MyButton Height="35" HorizontalAlignment="Center" x:Name="BtnHintOpen" MinWidth="140" Text="打开 Mod 文件夹" Margin="0,15,0,0" Padding="13,0" ColorType="Highlight" />
<TextBlock Margin="10,10,10,0" Text="你可以下载新的 Mod,或者从已经下载好的文件安装 Mod。&#xa;如果你已经安装了 Mod,可能是版本隔离设置有误,请在设置中调整版本隔离选项。" TextWrapping="Wrap" />
<Grid Margin="15,20,0,5" Height="35" HorizontalAlignment="Center">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Height="35" HorizontalAlignment="Center" Grid.Column="0" x:Name="BtnHintDownload" MinWidth="140" Text="下载 Mod" Margin="0,0,17,0" Padding="13,0" ColorType="Highlight" />
<local:MyButton Height="35" HorizontalAlignment="Center" Grid.Column="1" x:Name="BtnHintInstall" MinWidth="140" Text="从文件安装 Mod" Margin="0,0,17,0" Padding="13,0" />
<local:MyButton Height="35" HorizontalAlignment="Center" Grid.Column="2" x:Name="BtnHintOpen" MinWidth="140" Text="打开 Mod 文件夹" Margin="0,0,17,0" Padding="13,0" />
</Grid>
</StackPanel>
</local:MyCard>
</Grid>
@@ -46,6 +46,7 @@
'强制刷新
Try
CompProjectCache.Clear()
CompFilesCache.Clear()
File.Delete(PathTemp & "Cache\LocalMod.json")
Log("[Mod] 由于点击刷新按钮,清理本地 Mod 信息缓存")
Catch ex As Exception
@@ -288,7 +289,7 @@
Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click
Try
Directory.CreateDirectory(PageVersionLeft.Version.PathIndie & "mods\")
OpenExplorer("""" & PageVersionLeft.Version.PathIndie & "mods\""")
OpenExplorer(PageVersionLeft.Version.PathIndie & "mods\")
Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox)
End Try
@@ -322,15 +323,72 @@
''' <summary>
''' 安装 Mod。
''' </summary>
Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click
Hint("将 Mod 文件直接拖入 PCL 窗口即可安装!")
Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click, BtnHintInstall.Click
Dim FileList = SelectFiles("Mod 文件(*.jar;*.litemod;*.disabled;*.old)|*.jar;*.litemod;*.disabled;*.old", "选择要安装的 Mod")
If Not FileList.Any Then Return
InstallMods(FileList)
End Sub
''' <summary>
''' 尝试安装 Mod。
''' 返回输入的文件是否为一个 Mod 文件,仅用于判断拖拽行为。
''' </summary>
Public Shared Function InstallMods(FilePathList As IEnumerable(Of String)) As Boolean
Dim Extension As String = FilePathList.First.AfterLast(".").ToLower
'检查文件扩展名
If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'检查回收站:回收站中的文件有错误的文件名
If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
Hint("请先将文件从回收站还原,再尝试安装!", HintType.Critical)
Return True
End If
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If FrmMain.PageCurrent = FormMain.PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
'正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
Try
For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
'刷新列表
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
End Try
End If
Return True
End Function
''' <summary>
''' 下载 Mod。
''' </summary>
Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click
PageDownloadMod.TargetVersion = PageVersionLeft.Version '将当前版本设置为筛选器
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod)
End Sub
#End Region
#Region "选择"
'选择的 Mod 的路径(不含 .disabled)
'选择的 Mod 的路径(不含 .disabled 和 .old)
Public SelectedMods As New List(Of String)
'单项切换选择状态
@@ -522,8 +580,8 @@
Public Shared UpdatingVersions As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
'更新前警告
If Not Setup.Get("HintUpdateMod") Then
If MyMsgBox($"新版本 Mod 可能不兼容老版本的存档或者其他 Mod,这可能导致游戏崩溃,甚至存档损坏!{vbCrLf}除非整合包作者要求你更新,否则不要私自更新整合包里的 Mod!{vbCrLf}在更新 Mod 前,请先备份存档,并检查它的更新日志!{vbCrLf}更新时,老版本的 Mod 会被移动到回收站,以防万一。{vbCrLf}{vbCrLf}请在认真阅读上述警告后再继续!", "Mod 更新警告", "我已了解上述风险,继续更新", "取消", IsWarn:=True) = 1 Then
If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod,这可能导致游戏崩溃,甚至永久损坏存档!{vbCrLf}如果你在游玩整合包,请千万不要自行更新 Mod!{vbCrLf}{vbCrLf}在更新前,请先备份存档,并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题,你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险,继续更新", "取消", IsWarn:=True) = 1 Then
Setup.Set("HintUpdateMod", True)
Else
Exit Sub
@@ -798,10 +856,8 @@
'打开文件所在的位置
Public Sub Open_Click(sender As MyIconButton, e As EventArgs)
Try
Dim ListItem As MyLocalModItem = sender.Tag
OpenExplorer("/select,""" & ListItem.Entry.Path & """")
OpenExplorer(ListItem.Entry.Path)
Catch ex As Exception
Log(ex, "打开 Mod 文件位置失败", LogLevel.Feedback)
End Try
@@ -30,7 +30,7 @@
<local:MyComboBoxItem Content="命令方块" Tag="pack://application:,,,/images/Blocks/CommandBlock.png" />
<local:MyComboBoxItem Content="金块" Tag="pack://application:,,,/images/Blocks/GoldBlock.png" />
<local:MyComboBoxItem Content="草方块" Tag="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyComboBoxItem Content="草径" Tag="pack://application:,,,/images/Blocks/GrassPath.png" />
<local:MyComboBoxItem Content="土径" Tag="pack://application:,,,/images/Blocks/GrassPath.png" />
<local:MyComboBoxItem Content="铁砧" Tag="pack://application:,,,/images/Blocks/Anvil.png" />
<local:MyComboBoxItem Content="红石块" Tag="pack://application:,,,/images/Blocks/RedstoneBlock.png" />
<local:MyComboBoxItem Content="红石灯(开)" Tag="pack://application:,,,/images/Blocks/RedstoneLampOn.png" />
@@ -235,21 +235,21 @@
OpenVersionFolder(PageVersionLeft.Version)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer("""" & Version.Path & """")
OpenExplorer(Version.Path)
End Sub
'存档文件夹
Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "saves\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
OpenExplorer(FolderPath)
End Sub
'Mod 文件夹
Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "mods\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
OpenExplorer(FolderPath)
End Sub
#End Region
@@ -260,7 +260,7 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try
'弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectAs("选择脚本保存位置", "启动 " & PageVersionLeft.Version.Name & ".bat", "批处理文件(*.bat)|*.bat")
Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageVersionLeft.Version.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Exit Sub
'检查中断(等玩家选完弹窗指不定任务就结束了呢……)
If McLaunchLoader.State = LoadState.Loading Then
@@ -213,7 +213,7 @@
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}option.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="VersionAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,5,0,0" />
<StackPanel Margin="0,10,0,0" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
@@ -153,11 +153,11 @@
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.VersionSetup OrElse FrmVersionLeft.PageID <> FormMain.PageSubType.VersionSetup Then Exit Sub
'获取内存情况
Dim RamGame As Double = GetRam(PageVersionLeft.Version)
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable)
Dim RamUsed As Double = RamTotal - RamAvailable
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
Dim RamUsed As Double = Math.Round(RamTotal - RamAvailable, 5)
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000), 1)
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
@@ -173,7 +173,7 @@
If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "")
LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB"
LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB"
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed)
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed)
If ShowAnim Then
'宽度动画
AniStart({
@@ -491,6 +491,7 @@ PreFin:
Private IsReverting As Boolean = False
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If IsReverting Then Exit Sub
If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档,不建议修改这项设置!",
@@ -186,6 +186,9 @@
<Compile Include="Controls\MyComboBox.vb" />
<Compile Include="Controls\MyComboBoxItem.vb" />
<Compile Include="Controls\MyCard.vb" />
<Compile Include="Controls\MyExtraTextButton.xaml.vb">
<DependentUpon>MyExtraTextButton.xaml</DependentUpon>
</Compile>
<Compile Include="Controls\MyImage.vb" />
<Compile Include="Controls\MyPageRight.vb" />
<Compile Include="Controls\MyPageLeft.vb" />
@@ -290,6 +293,9 @@
<Compile Include="Pages\PageLink\PageLinkLeft.xaml.vb">
<DependentUpon>PageLinkLeft.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionExport.xaml.vb">
<DependentUpon>PageVersionExport.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionLeft.xaml.vb">
<DependentUpon>PageVersionLeft.xaml</DependentUpon>
</Compile>
@@ -382,6 +388,10 @@
<Compile Include="Pages\PageSpeedRight.xaml.vb">
<DependentUpon>PageSpeedRight.xaml</DependentUpon>
</Compile>
<Page Include="Controls\MyExtraTextButton.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Controls\MyExtraButton.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
@@ -561,6 +571,10 @@
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageVersion\PageVersionExport.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Resources\Language\en_US.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
+6 -6
View File
@@ -87,22 +87,22 @@
</StackPanel>
</local:MyCard>
<local:MyCard Title="事件 3:打开文件" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<local:MyCard Title="事件 3:执行命令" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="将 EventType 设置为 打开文件,EventData 设置为文件路径,即可点击打开特定文件或启动程序。" />
Text="将 EventType 设置为 执行命令(或 打开文件),EventData 设置为文件路径,即可点击打开特定文件或启动程序。" />
<local:MyButton Margin="0,4,0,8" Width="200" Height="35"
Text="打开记事本" EventType="打开文件" EventData="notepad.exe" />
Text="打开记事本" EventType="执行命令" EventData="notepad.exe" />
<TextBlock TextWrapping="Wrap" Margin="0,4,0,0"
Text="如果能在 PCL 文件夹中找到该文件,则会优先打开 PCL 文件夹中的文件。当然,你可以使用例如 C:\ 开头的绝对路径。" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="此外,PCL 会将文件中的 “花括号 path” 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" />
<local:MyButton Margin="0,4,0,10" Width="200" Height="35"
Text="打开 PCL 日志" EventType="打开文件" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
Text="打开 PCL 日志" EventType="执行命令" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="就像为游戏指定服务器 IP 一样,你也可以在 EventData 的竖线后为程序添加启动参数。" />
<local:MyButton Margin="0,4,0,0" Width="200" Height="35"
Text="定位游戏启动脚本" EventType="打开文件" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xA;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
Text="定位游戏启动脚本" EventType="执行命令" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xA;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
</StackPanel>
</local:MyCard>
@@ -192,7 +192,7 @@
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<!-- 草方块 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<!-- 草径 -->
<!-- 土径 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<!-- 铁砧 -->
<local:MyImage Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
Binary file not shown.
File diff suppressed because it is too large. Load diff
Binary file not shown.
+9 -5
View File
@@ -48,13 +48,17 @@
自动缩放。Windows Presentation Foundation (WPF)应用程序自动感知 DPI,无需
选择加入。选择加入此设置的 Windows 窗体应用程序(目标设定为 .NET Framework 4.6 )还应
在其 app.config 中将 "EnableWindowsFormsHighDpiAutoResizing" 设置设置为 "true"。-->
<!--
<!-- 更改原因见 #5337 -->
<application xmlns="urn:schemas-microsoft-com:asm.v3">
<windowsSettings>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
</windowsSettings>
<windowsSettings>
<longPathAware xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">true</longPathAware> <!-- 长路径支持 -->
<!-- The combination of below two tags have the following effect :
1. Per-Monitor for >= Windows 10 Anniversary Update
2. System < Windows 10 Anniversary Update -->
<dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
</windowsSettings>
</application>
-->
<!-- 启用 Windows 公共控件和对话框的主题(Windows XP 和更高版本) -->
<dependency>
+13 -23
View File
@@ -1,27 +1,17 @@
# Plain Craft Launcher 源代码库
# Plain Craft Launcher
[![Stars](https://img.shields.io/github/stars/Hex-Dragon/PCL2?style=flat&logo=data:image/svg%2bxml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHZlcnNpb249IjEiIHdpZHRoPSIxNiIgaGVpZ2h0PSIxNiI+PHBhdGggZD0iTTggLjI1YS43NS43NSAwIDAgMSAuNjczLjQxOGwxLjg4MiAzLjgxNSA0LjIxLjYxMmEuNzUuNzUgMCAwIDEgLjQxNiAxLjI3OWwtMy4wNDYgMi45Ny43MTkgNC4xOTJhLjc1MS43NTEgMCAwIDEtMS4wODguNzkxTDggMTIuMzQ3bC0zLjc2NiAxLjk4YS43NS43NSAwIDAgMS0xLjA4OC0uNzlsLjcyLTQuMTk0TC44MTggNi4zNzRhLjc1Ljc1IDAgMCAxIC40MTYtMS4yOGw0LjIxLS42MTFMNy4zMjcuNjY4QS43NS43NSAwIDAgMSA4IC4yNVoiIGZpbGw9IiNlYWM1NGYiLz48L3N2Zz4=&logoSize=auto&label=Stars&labelColor=666666&color=eac54f)](https://github.com/Hex-Dragon/PCL2/)
[![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=666666&color=1a7f37)](https://github.com/Hex-Dragon/PCL2/issues)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.com/@LTCat)
[![Stars](https://img.shields.io/github/stars/Hex-Dragon/PCL2?style=flat&logo=data:image/svg%2bxml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHZlcnNpb249IjEiIHdpZHRoPSIxNiIgaGVpZ2h0PSIxNiI+PHBhdGggZD0iTTggLjI1YS43NS43NSAwIDAgMSAuNjczLjQxOGwxLjg4MiAzLjgxNSA0LjIxLjYxMmEuNzUuNzUgMCAwIDEgLjQxNiAxLjI3OWwtMy4wNDYgMi45Ny43MTkgNC4xOTJhLjc1MS43NTEgMCAwIDEtMS4wODguNzkxTDggMTIuMzQ3bC0zLjc2NiAxLjk4YS43NS43NSAwIDAgMS0xLjA4OC0uNzlsLjcyLTQuMTk0TC44MTggNi4zNzRhLjc1Ljc1IDAgMCAxIC40MTYtMS4yOGw0LjIxLS42MTFMNy4zMjcuNjY4QS43NS43NSAwIDAgMSA4IC4yNVoiIGZpbGw9IiNlYWM1NGYiLz48L3N2Zz4=&logoSize=auto&label=Stars&labelColor=444444&color=eac54f)](https://github.com/Hex-Dragon/PCL2/)
[![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=444444&color=1F883D)](https://github.com/Hex-Dragon/PCL2/issues)
[![哔哩哔哩](https://img.shields.io/badge/动态-BiliBili-00A4DB?style=flat&labelColor=444444&logoSize=auto)](https://space.bilibili.com/11343203/dynamic)
[![爱发电](https://img.shields.io/badge/赞助-爱发电-946ce6?style=flat&labelColor=444444&logoSize=auto)](https://afdian.com/@LTCat)
包含 PCL 的大部分源代码,包括 UI 库、动画模块、下载模块、Minecraft 启动模块等!<br/>
代码并不是实时更新的,它会在每次 PCL 发布更新时同步一次。<br/>
非常感谢社区的大力支持!
<br/>
## 介绍
这里提供了 PCL 的大多数源代码,包括 UI 库、动画模块、下载模块、Minecraft 启动模块等!
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了……
<br/>
## 相关内容
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
- [程序下载](https://afdian.com/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
<br/>
## 一些无趣的小细节
- 别想在这里面找到解密游戏的线索,那部分的代码被我抠掉了
- 解锁隐藏主题的相关代码也被抠掉了,所以别想着用翻源代码这种歪门邪道来绕过解密了.jpg
- 源代码库并不是即时更新的,而是在每次 PCL 发布更新时(手动)同步一次
### 相关资源
- [PCL 下载](https://afdian.com/p/0164034c016c11ebafcb52540025c377):下载可免费使用的正式版 PCL!
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的项目!
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 内置帮助文档的存储库
Binary file not shown.