Merge branch 'main' into auth

This commit is contained in:
Pigeon0v0
2024-08-28 19:43:39 +08:00
committed by GitHub
73 changed files with 4361 additions and 2215 deletions
+3
View File
@@ -0,0 +1,3 @@
# These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat']
+2 -1
View File
@@ -9,6 +9,7 @@ on:
paths: paths:
- 'Plain Craft Launcher 2/**' - 'Plain Craft Launcher 2/**'
- '.github/workflows/**' - '.github/workflows/**'
workflow_dispatch:
jobs: jobs:
@@ -29,7 +30,7 @@ jobs:
- name: Set Describe - name: Set Describe
shell: bash shell: bash
run: | run: |
Describe=`git describe --tags` Describe=`git describe --tags --always`
echo "Describe=$Describe" >> $GITHUB_ENV echo "Describe=$Describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe - name: Setup MSBuild.exe
+12 -16
View File
@@ -2,23 +2,23 @@
一、承诺与声明。 一、承诺与声明。
  开发者承诺,在您遵守本指南的情况下,不会追究您的法律责任,但最终裁量权仍由开发者保留。   开发者承诺,在您遵守本指南的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。   法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。 二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:   如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。   1、给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。   2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。 三、大量使用情形。
  如果您基于该存储库进行衍生创作,或合理使用了本存储库中的较大量内容,您必须:   如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。   1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。   2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。
  (三)给出适当的说明,表示这是第三方内容。   3、使用本指南文件作为协议,不得附加额外条款。
  (四)使用本指南文件作为协议,不得附加额外条款。   4、该衍生作品不能被允许用于再次分发,这包括制作整合包。
  (五)不得分发编译后的可执行文件。   5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
———————————— ————————————
@@ -27,9 +27,5 @@
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意…… 因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧! 这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码: 如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。
  署名就行啦。 如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。
如果你整了个魔改版,或者用了一大堆代码:
  你不能把编译后的文件发给其他人,但可以私下使用。
如果你修改了代码,并且打算公开:
  请仔细参考上面的第三条。
+2 -1
View File
@@ -90,7 +90,7 @@ Public Class Application
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0)) ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0)) ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口 '设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If End If
@@ -103,6 +103,7 @@ Public Class Application
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}") Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}") Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测压缩包运行 '检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
+8 -15
View File
@@ -98,21 +98,13 @@
'排序 '排序
Select Case Type Select Case Type
Case 3 Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Case 4, 10 Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(Left As DlLiteLoaderListEntry, Right As DlLiteLoaderListEntry) As Boolean Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Return VersionSortBoolean(Left.Inherit, Right.Inherit)
End Function)
Case 6 Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version)
Return VersionSortBoolean(Left.Version, Right.Version)
End Function)
Case 8, 9 Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(Left As CompFile, Right As CompFile) As Boolean Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate)
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
End Select End Select
'控件转换 '控件转换
Select Case Type Select Case Type
@@ -144,9 +136,8 @@
Case 6 Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True)) Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7 Case 7
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
FrmDownloadInstall.MinecraftSelected(sender, e) Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
End Sub, False))
Case 8 Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then CType(Stack.Tag, List(Of CompFile)).Count Then
@@ -171,6 +162,8 @@
Stack.Children.Add(CType(Data, HelpEntry).ToListItem) Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
Case 12 Case 12
Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected)) Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected))
Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else Case Else
Log("未知的虚拟化种类:" & Type, LogLevel.Feedback) Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
End Select End Select
@@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255) If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0) If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then If IsMouseOver Then
'指向 '指向
Dim AnimList As New List(Of AniData) Dim AnimList As New List(Of AniData)
@@ -74,13 +74,13 @@
'添加结束 Invoke '添加结束 Invoke
If FinishedInvoke IsNot Nothing Then If FinishedInvoke IsNot Nothing Then
AddHandler RealLoader.PreviewFinish, AddHandler RealLoader.PreviewFinish,
Sub() Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置 Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader)) RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件 Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub End Sub
End If End If
AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState)) AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
'隐藏 UI '隐藏 UI
+60 -15
View File
@@ -10,6 +10,22 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 332 Then 'Release 2.8.3
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 330 Then 'Release 2.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 323 Then 'Release 2.7.3 If LastVersion < 323 Then 'Release 2.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(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)(2, "优化 MC 性能"))
@@ -108,6 +124,37 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
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 If LastVersion < 325 Then 'Snapshot 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
@@ -269,17 +316,13 @@ Public Class FormMain
RunInNewThread( RunInNewThread(
Sub() Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed") OpenWebsite("https://afdian.com/a/LTCat?tab=feed")
End If End If
End Sub, "UpdateLog Output") End Sub, "UpdateLog Output")
End Sub End Sub
'窗口加载 '窗口加载
Private IsWindowLoadFinished As Boolean = False Private IsWindowLoadFinished As Boolean = False
''' <summary>
''' 是否为联机提权后自动重启。
''' </summary>
Public Shared IsLinkRestart As Boolean = False
Public Sub New() Public Sub New()
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeTick()
'窗体参数初始化 '窗体参数初始化
@@ -317,7 +360,6 @@ Public Class FormMain
PanMainLeft.Child = FrmLaunchLeft PanMainLeft.Child = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight PanMainRight.Child = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
'模式提醒 '模式提醒
#If DEBUG Then #If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical) Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
@@ -386,7 +428,7 @@ Public Class FormMain
Sub() Sub()
PanBack.RenderTransform = Nothing PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}") Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
End Sub, , True) End Sub, , True)
}, "Form Show") }, "Form Show")
'Timer 启动 'Timer 启动
@@ -532,7 +574,7 @@ Public Class FormMain
RunInNewThread( RunInNewThread(
Sub() Sub()
Log("[System] 正在强行停止任务") Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort() Task.Abort()
Next Next
End Sub, "强行停止下载任务") End Sub, "强行停止下载任务")
@@ -851,10 +893,12 @@ Public Class FormMain
Install: Install:
Try Try
For Each ModFile In FilePathList For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile)) Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next Next
If FilePathList.Count = 1 Then If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish) Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish) Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If End If
@@ -871,7 +915,7 @@ Install:
'安装整合包 '安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装") Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
End If End If
'RAR 处理 'RAR 处理
If Extension = "rar" Then If Extension = "rar" Then
@@ -1019,10 +1063,11 @@ Install:
DownloadClient = 4 DownloadClient = 4
DownloadOptiFine = 5 DownloadOptiFine = 5
DownloadForge = 6 DownloadForge = 6
DownloadFabric = 7 DownloadNeoForge = 7
DownloadLiteLoader = 8 DownloadFabric = 8
DownloadMod = 10 DownloadLiteLoader = 9
DownloadPack = 11 DownloadMod = 11
DownloadPack = 12
SetupLaunch = 0 SetupLaunch = 0
SetupUI = 1 SetupUI = 1
SetupSystem = 2 SetupSystem = 2
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

+100 -83
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.4" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.8.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.4." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.8.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 323 'Release Public Const VersionCode As Integer = 332 'Release
#Else #Else
Public Const VersionCode As Integer = 325 'Snapshot Public Const VersionCode As Integer = 333 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -80,13 +80,9 @@ Public Module ModBase
''' </summary> ''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936 Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary> ''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。 ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary> ''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\" Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary> ''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。 ''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary> ''' </summary>
@@ -1016,7 +1012,7 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Function CheckPermission(Path As String) As Boolean Public Function CheckPermission(Path As String) As Boolean
Try Try
If Path = "" Then Return False If String.IsNullOrEmpty(Path) Then Return False
If Not Path.EndsWithF("\") Then Path += "\" If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False If Not Directory.Exists(Path) Then Return False
@@ -1108,8 +1104,6 @@ Re:
Dim Retry As Boolean = False Dim Retry As Boolean = False
Re: Re:
Try Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1 '获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider() Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1257,12 +1251,19 @@ Re:
Dim DeletedCount As Integer = 0 Dim DeletedCount As Integer = 0
Dim Temp As String() Dim Temp As String()
Temp = Directory.GetFiles(Path) Temp = Directory.GetFiles(Path)
For Each str As String In Temp For Each FilePath As String In Temp
Dim RetriedFile As Boolean = False
RetryFile:
Try Try
File.Delete(str) File.Delete(FilePath)
DeletedCount += 1 DeletedCount += 1
Catch ex As Exception Catch ex As Exception
If IgnoreIssue Then If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败") Log(ex, "删除单个文件可忽略地失败")
Else Else
Throw Throw
@@ -1273,10 +1274,17 @@ Re:
For Each str As String In Temp For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue) DeleteDirectory(str, IgnoreIssue)
Next Next
Dim RetriedDir As Boolean = False
RetryDir:
Try Try
Directory.Delete(Path, True) Directory.Delete(Path, True)
Catch ex As Exception Catch ex As Exception
If IgnoreIssue Then If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败") Log(ex, "删除单个文件夹可忽略地失败")
Else Else
Throw Throw
@@ -1573,14 +1581,14 @@ Re:
''' 获取处于两个子字符串之间的部分。 ''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。 ''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary> ''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String <Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase)) Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then If StartPos >= 0 Then
StartPos += Before.Length StartPos += After.Length
Else Else
StartPos = 0 StartPos = 0
End If End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase)) Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos) Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then ElseIf StartPos > 0 Then
@@ -1652,7 +1660,10 @@ Re:
''' 为字符串进行 XML 转义。 ''' 为字符串进行 XML 转义。
''' </summary> ''' </summary>
Public Function EscapeXML(Str As String) As String Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;") If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function End Function
'正则 '正则
@@ -2065,15 +2076,16 @@ NextElement:
''' 在新的工作线程中执行代码。 ''' 在新的工作线程中执行代码。
''' </summary> ''' </summary>
Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(Sub() Dim th As New Thread(
Try Sub()
Action() Try
Catch ex As ThreadInterruptedException Action()
Log(Name & ":线程已中止") Catch ex As ThreadInterruptedException
Catch ex As Exception Log(Name & ":线程已中止")
Log(ex, Name & ":线程执行失败", LogLevel.Feedback) Catch ex As Exception
End Try Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Sub) With {.Name = Name, .Priority = Priority} End Try
End Sub) With {.Name = Name, .Priority = Priority}
th.Start() th.Start()
Return th Return th
End Function End Function
@@ -2186,7 +2198,9 @@ NextElement:
''' </summary> ''' </summary>
Public Sub OpenWebsite(Url As String) Public Sub OpenWebsite(Url As String)
Try Try
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!") If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
End If
Log("[System] 正在打开网页:" & Url) Log("[System] 正在打开网页:" & Url)
Process.Start(Url) Process.Start(Url)
Catch ex As Exception Catch ex As Exception
@@ -2211,25 +2225,27 @@ NextElement:
''' 设置剪贴板。将在另一线程运行,且不会抛出异常。 ''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
''' </summary> ''' </summary>
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True) Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
RunInThread(Sub() RunInThread(
Dim RetryCount As Integer = 0 Sub()
Dim RetryCount As Integer = 0
Retry: Retry:
Try Try
RunInUi(Sub() RunInUi(
My.Computer.Clipboard.Clear() Sub()
My.Computer.Clipboard.SetText(Text) My.Computer.Clipboard.Clear()
End Sub) My.Computer.Clipboard.SetText(Text)
Catch ex As Exception End Sub)
RetryCount += 1 Catch ex As Exception
If RetryCount <= 5 Then RetryCount += 1
Thread.Sleep(20) If RetryCount <= 5 Then
GoTo Retry Thread.Sleep(20)
Else GoTo Retry
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint) Else
End If Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End Try End If
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish) End Try
End Sub) If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
End Sub End Sub
''' <summary> ''' <summary>
@@ -2448,39 +2464,40 @@ Retry:
Private LogList As New StringBuilder Private LogList As New StringBuilder
Private LogWritter As StreamWriter Private LogWritter As StreamWriter
Public Sub LogStart() Public Sub LogStart()
RunInNewThread(Sub() RunInNewThread(
Dim IsInitSuccess As Boolean = True Sub()
Try Dim IsInitSuccess As Boolean = True
For i = 4 To 1 Step -1 Try
If File.Exists(Path & "PCL\Log" & i & ".txt") Then For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt") If File.Exists(Path & "PCL\Log" & i & ".txt") Then
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt") If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
End If CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
Next End If
File.Create(Path & "PCL\Log1.txt").Dispose() Next
Catch ex As IOException File.Create(Path & "PCL\Log1.txt").Dispose()
IsInitSuccess = False Catch ex As IOException
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical) IsInitSuccess = False
Log(ex, "日志初始化失败(疑似文件占用问题)") Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Catch ex As Exception Log(ex, "日志初始化失败(疑似文件占用问题)")
IsInitSuccess = False Catch ex As Exception
Log(ex, "日志初始化失败", LogLevel.Hint) IsInitSuccess = False
End Try Log(ex, "日志初始化失败", LogLevel.Hint)
Try End Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True} Try
Catch ex As Exception LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
LogWritter = Nothing Catch ex As Exception
Log(ex, "日志写入失败", LogLevel.Hint) LogWritter = Nothing
End Try Log(ex, "日志写入失败", LogLevel.Hint)
While True End Try
If IsInitSuccess Then While True
LogFlush() If IsInitSuccess Then
Else LogFlush()
LogList = New StringBuilder '清空 LogList 避免内存爆炸 Else
End If LogList = New StringBuilder '清空 LogList 避免内存爆炸
Thread.Sleep(50) End If
End While Thread.Sleep(50)
End Sub, "Log Writer", ThreadPriority.Lowest) End While
End Sub, "Log Writer", ThreadPriority.Lowest)
End Sub End Sub
Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志 Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
Public Sub LogFlush() Public Sub LogFlush()
@@ -2659,7 +2676,7 @@ Retry:
Public Sub FeedbackInfo() Public Sub FeedbackInfo()
On Error Resume Next On Error Resume Next
Log("[System] 诊断信息:" & vbCrLf & Log("[System] 诊断信息:" & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf & "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf & "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf & "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf & "MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
@@ -566,38 +566,33 @@ Restart:
End Class End Class
'任务栏进度条 '任务栏进度条
Public LoaderTaskbarLock As New Object Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T)) Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock LoaderTaskbar.Add(Loader)
LoaderTaskbar.Add(Loader) Log($"[Taskbar] {Loader.Name} 已加入任务列表")
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
End Sub End Sub
Public Sub LoaderTaskbarProgressRefresh() Public Sub LoaderTaskbarProgressRefresh()
Try Try
Dim NewState As Shell.TaskbarItemProgressState Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet() Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除 '检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock '外显任务是否已经全部完成
'外显任务是否已经全部完成 Dim IsAllDownloadTaskCompleted As Boolean = True
Dim IsAllDownloadTaskCompleted As Boolean = True For Each Loader In LoaderTaskbar
For Each Loader In LoaderTaskbar If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False Next
Next '若单个任务已中止或全部任务已完成,则刷新并移除
'若单个任务已中止或全部任务已完成,则刷新并移除 For Each Task In LoaderTaskbar.ToList()
For Each Task In LoaderTaskbar.ToList() If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) LoaderTaskbar.TryTake(Task)
LoaderTaskbar.Remove(Task) Log($"[Taskbar] {Task.Name} 已移出任务列表")
Log($"[Taskbar] {Task.Name} 已移出任务列表") End If
End If Next
Next
End SyncLock
'更新平滑后的进度 '更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress LoaderTaskbarProgress = NewProgress
@@ -625,15 +620,8 @@ Restart:
End Sub End Sub
Public Function LoaderTaskbarProgressGet() As Double Public Function LoaderTaskbarProgressGet() As Double
Try Try
Dim Total As Double = 0, Count As Integer = 0 If Not LoaderTaskbar.Any Then Return 1
SyncLock LoaderTaskbarLock Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback) Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5 Return 0.5
+47 -67
View File
@@ -1,5 +1,4 @@
Imports System.Net Imports System.Net
Imports PCL.ModNet
Public Module ModNet Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading" Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -207,10 +206,10 @@ RequestFinished:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时,已接收 " & Result.Count & " B(" & Url & ")") Throw New TimeoutException($"获取结果失败({CType(ex, WebException).Status},{ex.Message},{Url})", ex)
Else Else
Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex) Throw New WebException($"获取结果失败({If(TypeOf ex Is WebException, CType(ex, WebException).Status & ",", "")}{ex.Message},{Url})", ex)
End If End If
Finally Finally
Request.Abort() Request.Abort()
@@ -341,14 +340,15 @@ Retry:
Dim RequestEx As Exception = Nothing Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0 Dim FailCount As Integer = 0
For i = 1 To RequestCount For i = 1 To RequestCount
Dim th As New Thread(Sub() Dim th As New Thread(
Try Sub()
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers) Try
Catch ex As Exception RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
FailCount += 1 Catch ex As Exception
RequestEx = ex FailCount += 1
End Try RequestEx = ex
End Sub) End Try
End Sub)
th.Start() th.Start()
Threads.Add(th) Threads.Add(th)
Thread.Sleep(i * 250) Thread.Sleep(i * 250)
@@ -382,7 +382,7 @@ RequestFinished:
Dim Resp As WebResponse = Nothing Dim Resp As WebResponse = Nothing
Dim Req As HttpWebRequest Dim Req As HttpWebRequest
Try Try
Req = WebRequest.Create(New Uri(Url)) Req = WebRequest.Create(Url)
Req.Method = Method Req.Method = Method
Dim SendData As Byte() Dim SendData As Byte()
If TypeOf Data Is Byte() Then If TypeOf Data Is Byte() Then
@@ -418,7 +418,7 @@ RequestFinished:
Throw Throw
Catch ex As WebException Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then If ex.Status = WebExceptionStatus.Timeout Then
Throw New WebException("连接服务器超时,请检查你的网络环境是否良好(" & Url & ")", ex) ex = New WebException($"连接服务器超时,请检查你的网络环境是否良好({ex.Message},{Url})", ex)
Else Else
'获取请求失败的返回 '获取请求失败的返回
Dim Res As String = "" Dim Res As String = ""
@@ -432,10 +432,14 @@ RequestFinished:
End Using End Using
Catch Catch
End Try End Try
Throw New WebException("网络请求失败(" & Url & "," & ex.Message & ")" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex) ex = New WebException($"网络请求失败({ex.Status},{ex.Message},{Url}){If(String.IsNullOrEmpty(Res), "", vbCrLf & Res)}", ex)
End If End If
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Catch ex As Exception Catch ex As Exception
Throw New WebException("网络请求失败(" & Url & ")", ex) ex = New WebException("网络请求失败(" & Url & ")", ex)
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Finally Finally
If DataStream IsNot Nothing Then DataStream.Dispose() If DataStream IsNot Nothing Then DataStream.Dispose()
If Resp IsNot Nothing Then Resp.Dispose() If Resp IsNot Nothing Then Resp.Dispose()
@@ -687,7 +691,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 所属的文件列表任务。 ''' 所属的文件列表任务。
''' </summary> ''' </summary>
Public Tasks As New List(Of LoaderDownload) Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload)
''' <summary> ''' <summary>
''' 所有下载源。 ''' 所有下载源。
@@ -880,7 +884,6 @@ RequestFinished:
Public ReadOnly LockState As New Object Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Public ReadOnly Uuid As Integer = GetUuid() Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean Public Overrides Function Equals(obj As Object) As Boolean
@@ -963,7 +966,7 @@ Capture:
Next Next
'是否禁用多线程,以及规定碎片大小 '是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片 '寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程 'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads Dim FilePieceMax As NetThread = Threads
@@ -979,10 +982,8 @@ StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程 '构建线程
Dim ThreadUuid As Integer = GetUuid() Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务 Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
'链表处理 '链表处理
If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
@@ -1139,11 +1140,9 @@ NotSupportRange:
End If End If
SyncLock LockCount SyncLock LockCount
Info.Source.FailCount = 0 Info.Source.FailCount = 0
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.FailCount = 0
Task.FailCount = 0 Next
Next
End SyncLock
End SyncLock End SyncLock
NetManager.DownloadDone += RealDataCount NetManager.DownloadDone += RealDataCount
SyncLock LockDone SyncLock LockDone
@@ -1197,11 +1196,9 @@ SourceBreak:
'状态变更 '状态变更
SyncLock LockCount SyncLock LockCount
Info.Source.FailCount += 1 Info.Source.FailCount += 1
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.FailCount += 1
Task.FailCount += 1 Next
Next
End SyncLock
End SyncLock End SyncLock
Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "") Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
@@ -1306,7 +1303,7 @@ Retry:
'合并文件 '合并文件
If IsNoSplit Then If IsNoSplit Then
'仅有一个线程,从缓存中输出 '仅有一个线程,从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件") If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件,长度:" & SmailFileCache.Count)
MergeFile = New FileStream(LocalPath, FileMode.Create) MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile) AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray) AddWriter.Write(SmailFileCache.ToArray)
@@ -1343,7 +1340,7 @@ Retry:
'检查文件 '检查文件
Dim CheckResult As String = Check?.Check(LocalPath) Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 合并文件失败,下载线程细节:") Log($"[Download] {LocalName} 文件校验失败,下载线程细节:")
For Each Th As NetThread In Threads For Each Th As NetThread In Threads
Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}") Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
Next Next
@@ -1396,10 +1393,8 @@ Retry:
''' </summary> ''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload) Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载 '从特定任务中移除,如果它还属于其他任务,则继续下载
SyncLock LockTasks Tasks.TryTake(CausedByTask)
Tasks.Remove(CausedByTask) If Tasks.Any Then Exit Sub
If Tasks.Any Then Exit Sub
End SyncLock
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finish Then Exit Sub If State >= NetState.Finish Then Exit Sub
@@ -1429,11 +1424,9 @@ Retry:
NetManager.FileRemain -= 1 NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain) If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
End SyncLock End SyncLock
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.OnFileFinish(Me)
Task.OnFileFinish(Me) Next
Next
End SyncLock
End Sub End Sub
End Class End Class
@@ -1859,15 +1852,10 @@ Retry:
Try Try
While True While True
Thread.Sleep(20) Thread.Sleep(20)
'若已完成,则清空
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'获取文件列表 '获取文件列表
Dim AllFiles As List(Of NetFile) Dim AllFiles As List(Of NetFile)
SyncLock LockFiles SyncLock LockFiles
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then Files.Clear() '若已完成,则清空
AllFiles = Files.Values.ToList() AllFiles = Files.Values.ToList()
End SyncLock End SyncLock
Dim WaitingFiles As New List(Of NetFile) Dim WaitingFiles As New List(Of NetFile)
@@ -1965,9 +1953,7 @@ Retry:
If Files(File.LocalPath).State >= NetState.Finish Then If Files(File.LocalPath).State >= NetState.Finish Then
'该文件已经下载过一次,且下载完成 '该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载 '将已下载的文件替换成当前文件,重新下载
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
Files(File.LocalPath) = File Files(File.LocalPath) = File
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
@@ -1978,15 +1964,11 @@ Retry:
'该文件正在下载中 '该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件 '将当前文件替换成下载中的文件,即两个任务指向同一个文件
File = Files(File.LocalPath) File = Files(File.LocalPath)
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
End If End If
Else Else
'没有该文件 '没有该文件
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
Files.Add(File.LocalPath, File) Files.Add(File.LocalPath, File)
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
@@ -2008,14 +1990,12 @@ Retry:
''' 是否有正在进行中、需要在下载管理页面显示的下载任务? ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </summary> ''' </summary>
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
SyncLock LoaderTaskbarLock For Each Task In LoaderTaskbar
For Each Task In LoaderTaskbar If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then Return True
Return True End If
End If Next
Next
End SyncLock
Return False Return False
End Function End Function
@@ -278,7 +278,8 @@
End If End If
'Tags 'Tags
Tags = New List(Of String) Tags = New List(Of String)
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段:https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category Select Case Category
'Mod 'Mod
Case 406 : Tags.Add("世界元素") Case 406 : Tags.Add("世界元素")
@@ -355,12 +356,12 @@
ModLoaders = New List(Of CompModLoaderType) ModLoaders = New List(Of CompModLoaderType)
For Each Category In Data("categories").Select(Function(t) t.ToString) For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category Select Case Category
'加载器 '加载器
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge) Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric) Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt) Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge) Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
'Mod 'Mod
Case "worldgen" : Tags.Add("世界元素") Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技") Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪") Case "food" : Tags.Add("食物/烹饪")
@@ -376,7 +377,7 @@
Case "social" : Tags.Add("服务器") Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良") Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库") Case "library" : Tags.Add("支持库")
'整合包 '整合包
Case "multiplayer" : Tags.Add("多人") Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化") Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核") Case "challenging" : Tags.Add("硬核")
@@ -385,7 +386,7 @@
Case "technology" : Tags.Add("科技") Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法") Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险") Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪") Case "kitchen-sink" : Tags.Add("大杂烩")
Case "lightweight" : Tags.Add("轻量") Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res 'FUTURE: Res
End Select End Select
@@ -629,19 +630,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例 If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字 '提取字符串中的字母和数字
Dim GetRaw = Dim GetRaw =
Function(Data As String) As String Function(Data As String) As String
Dim Result As New StringBuilder() Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r) Result.Append(r)
Next Next
Return Result.ToString.ToLower Return Result.ToString.ToLower
End Function End Function
'来自不同的网站 '来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致 'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致 'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -947,7 +948,7 @@ Retry:
Try Try
'获取工程列表 '获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl) Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8) Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data") For Each JsonEntry As JObject In RequestResult("data")
@@ -962,7 +963,7 @@ Retry:
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败") Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = Storage.CurseForgeOffset Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex [Error] = ex
CurseForgeFailed = True CurseForgeFailed = True
End Try End Try
@@ -977,7 +978,7 @@ Retry:
Sub() Sub()
Try Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl) Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8) Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits") For Each JsonEntry As JObject In RequestResult("hits")
@@ -995,7 +996,7 @@ Retry:
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败") Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = Storage.ModrinthOffset Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex [Error] = ex
ModrinthFailed = True ModrinthFailed = True
End Try End Try
@@ -1021,7 +1022,7 @@ Retry:
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型") Throw New Exception("Modrinth 不兼容所选的类型")
Else Else
Throw New Exception("没有符合条件的结果") Throw New Exception("没有搜索结果")
End If End If
End If End If
ElseIf [Error] IsNot Nothing Then ElseIf [Error] IsNot Nothing Then
@@ -1253,7 +1254,9 @@ Retry:
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), 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("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"), Url.Replace("://edge", "://media"),
Url}).Distinct().ToList() Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies 'Dependencies
If Type = CompType.Mod Then If Type = CompType.Mod Then
RawDependencies = Data("dependencies"). RawDependencies = Data("dependencies").
@@ -1287,11 +1290,10 @@ Retry:
ReleaseDate = Data("date_published") ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads") DownloadCount = Data("downloads")
'可能为空 If CType(Data("files"), JArray).Any() Then '可能为空
If CType(Data("files"), JArray).Any() Then
Dim File As JToken = Data("files")(0) Dim File As JToken = Data("files")(0)
FileName = File("filename") FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")} DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Hash = File("hashes")("sha1") Hash = File("hashes")("sha1")
End If End If
'Dependencies 'Dependencies
@@ -1320,6 +1322,7 @@ Retry:
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType) ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region #End Region
@@ -1426,9 +1429,9 @@ Retry:
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存 If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
TargetProject = CompProjectCache(ProjectId) TargetProject = CompProjectCache(ProjectId)
ElseIf FromCurseForge Then 'CurseForge ElseIf FromCurseForge Then 'CurseForge
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data")) TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
Else 'Modrinth Else 'Modrinth
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)) TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If End If
'获取工程对象的文件列表 '获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId) Log("[Comp] 开始获取文件列表:" & ProjectId)
@@ -1436,13 +1439,13 @@ Retry:
If FromCurseForge Then If FromCurseForge Then
'CurseForge 'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件 Else '否则使用全部文件
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data") ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If End If
Else Else
'Modrinth 'Modrinth
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True) ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). 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) Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
@@ -1456,11 +1459,10 @@ Retry:
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}") Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
Dim Projects As JArray Dim Projects As JArray
If TargetProject.FromCurseForge Then If TargetProject.FromCurseForge Then
Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
"POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data") "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
Else Else
Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
Accept:="application/json", IsJson:=True)
End If End If
For Each Project In Projects For Each Project In Projects
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存 Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
@@ -697,8 +697,8 @@ NextStack:
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill" "injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim) PossibleWords.Add(Word.Trim)
Next Next
@@ -881,7 +881,10 @@ NextStack:
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
End Select End Select
If File.Exists(OutputFile) Then If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*"))) Dim FileEncoding As Encoding = GetEncoding(OutputFile)
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
End If End If
Next Next
'导出报告 '导出报告
@@ -8,9 +8,13 @@
''' </summary> ''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本 '获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Try
Version = New McVersion(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Loop Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准 '检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息") Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -220,7 +224,7 @@
End If End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败", ex) Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -237,7 +241,7 @@
'返回 '返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json} Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("Minecraft BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -288,6 +292,7 @@
''' </summary> ''' </summary>
Public Value As List(Of DlOptiFineListEntry) Public Value As List(Of DlOptiFineListEntry)
End Structure End Structure
Public Class DlOptiFineListEntry Public Class DlOptiFineListEntry
''' <summary> ''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。 ''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
@@ -359,29 +364,33 @@
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default) Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息 Try
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*") '获取所有版本信息
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+") Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")") Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应") Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应") If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")") If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
'转化为列表输出 If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
Dim Versions As New List(Of DlOptiFineListEntry) '转化为列表输出
For i = 0 To ReleaseTime.Count - 1 Dim Versions As New List(Of DlOptiFineListEntry)
Name(i) = Name(i).Replace("_", " ") For i = 0 To ReleaseTime.Count - 1
Dim Entry As New DlOptiFineListEntry With { Name(i) = Name(i).Replace("_", " ")
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "), Dim Entry As New DlOptiFineListEntry With {
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"), .NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.IsPreview = Name(i).ContainsF("pre", True), .ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.Inherit = Name(i).ToString.Split(" ")(0), .IsPreview = Name(i).ContainsF("pre", True),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar", .Inherit = Name(i).ToString.Split(" ")(0),
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")} .NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "") If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Versions.Add(Entry) Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Next Versions.Add(Entry)
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions} Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("OptiFine 官方源版本列表解析失败(" & Result & ")", ex)
End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -407,7 +416,7 @@
Next Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("OptiFine BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -485,15 +494,61 @@
#Region "DlForgeVersion | Forge 版本列表" #Region "DlForgeVersion | Forge 版本列表"
Public Class DlForgeVersionEntry Public MustInherit Class DlForgelikeEntry
Public IsNeoForge As Boolean
''' <summary> ''' <summary>
''' 完整的版本名,如 “14.22.1.2478”。 ''' 加载器名称。Forge 或 NeoForge。
''' </summary> ''' </summary>
Public Version As String Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary>
''' Forge:MC 版本是否小于 1.13。
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary>
Public VersionName As String
''' <summary> ''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。 ''' 对应的 Minecraft 版本,如“1.12.2”。
''' </summary> ''' </summary>
Public Inherit As String Public Inherit As String
End Class
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary> ''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。 ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary> ''' </summary>
@@ -511,58 +566,21 @@
''' </summary> ''' </summary>
Public Category As String Public Category As String
''' <summary> ''' <summary>
''' 版本分支。若无分支则为 Nothing。
''' </summary>
Public Branch As String = Nothing
''' <summary>
''' 是否为新版 Forge。(即为 Minecraft 1.13+)
''' </summary>
Public ReadOnly Property IsNewType As Boolean
Get
Return Version.Split(".")(0) >= 20
End Get
End Property
''' <summary>
''' 构建数。
''' </summary>
Public ReadOnly Property Build As Integer
Get
Dim Version = Me.Version.Split(".")
If Version(0) < 15 Then
Return Version(Version.Count - 1)
Else
Return Version(Version.Count - 1) + 10000
End If
End Get
End Property
''' <summary>
''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。 ''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
''' </summary> ''' </summary>
Public ReadOnly Property FileVersion As String Public FileVersion As String
Get
Return Version & If(Branch Is Nothing, "", "-" & Branch) Public Sub New(Version As String, Branch As String, Inherit As String)
End Get '司马版本的特殊处理
End Property If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
''' <summary> If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Version.Split(".")(3) >= 1300 Then Branch = "1.7.10"
''' 即将下载的文件全名。 '为 DlForgelikeEntry 提供所有信息
''' </summary> IsNeoForge = False
Public ReadOnly Property FileName As String VersionName = Version
Get Me.Version = New Version(Version)
Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix Me.Inherit = Inherit
End Get FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Property End Sub
''' <summary>
''' 文件扩展名。
''' </summary>
Public ReadOnly Property FileSuffix As String
Get
If Category = "installer" Then
Return "jar"
Else
Return "zip"
End If
End Get
End Property
End Class End Class
''' <summary> ''' <summary>
@@ -596,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String Dim Result As String
Try Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True) Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本") Throw New Exception("没有可用版本")
@@ -620,8 +640,6 @@
'分支获取 '分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})") Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'发布时间获取 '发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+") Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02" Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02"
@@ -651,13 +669,13 @@
Continue For Continue For
End If End If
'添加进列表 '添加进列表
Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch}) Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本信息提取失败(" & VersionCode & ")", ex) Throw New Exception("Forge 官方源版本信息提取失败(" & VersionCode & ")", ex)
End Try End Try
Next Next
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex) Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本") If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions Loader.Output = Versions
@@ -667,7 +685,9 @@
''' Forge 版本列表,BMCLAPI。 ''' Forge 版本列表,BMCLAPI。
''' </summary> ''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True) Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions As New List(Of DlForgeVersionEntry)
Try Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -700,20 +720,17 @@
End Select End Select
Next Next
'获取 Entry '获取 Entry
Dim Inherit As String = Loader.Input
Dim Branch As String = Token("branch") Dim Branch As String = Token("branch")
Dim Name As String = Token("version") Dim Name As String = Token("version")
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'基础信息获取 '基础信息获取
Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name} Dim Entry = New DlForgeVersionEntry(Name, Branch, Loader.Input) With {.Hash = Hash, .Category = Category, .IsRecommended = Recommended = Name}
Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c) Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm") Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
'添加项 '添加项
Versions.Add(Entry) Versions.Add(Entry)
Next Next
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本") If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions Loader.Output = Versions
@@ -721,6 +738,132 @@
#End Region #End Region
#Region "DlNeoForgeList | NeoForge 版本列表"
Public Structure DlNeoForgeListResult
''' <summary>
''' 数据来源名称,如“Official”,“BMCLAPI”。
''' </summary>
Public SourceName As String
''' <summary>
''' 是否为官方的实时数据。
''' </summary>
Public IsOfficial As Boolean
''' <summary>
''' 所有版本的列表。已经按从新到老排序。
''' </summary>
Public Value As List(Of DlNeoForgeListEntry)
End Structure
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
Public IsBeta As Boolean
''' <summary>
''' API 使用的原始版本字符串,如 “20.4.30-beta”、“1.20.1-47.1.99”(Legacy)。
''' </summary>
Public ApiName As String
''' <summary>
''' 文件在官网的基础地址,不包含后缀。
''' </summary>
Public ReadOnly Property UrlBase As String
Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get
End Property
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
Version = New Version(ApiName.Before("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
End Class
''' <summary>
''' NeoForge 版本列表,主加载器。
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
}, Loader.IsForceRestarting)
End Select
End Sub
''' <summary>
''' NeoForge 版本列表,官方源。
''' </summary>
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "NeoForge 官方源",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge 官方源版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
''' <summary>
''' NeoForge 版本列表,BMCLAPI。
''' </summary>
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "BMCLAPI",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge BMCLAPI 版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions
End Function
#End Region
#Region "DlLiteLoaderList | LiteLoader 版本列表" #Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult Public Structure DlLiteLoaderListResult
@@ -741,6 +884,7 @@
''' </summary> ''' </summary>
Public OfficialError As Exception Public OfficialError As Exception
End Structure End Structure
Public Class DlLiteLoaderListEntry Public Class DlLiteLoaderListEntry
''' <summary> ''' <summary>
''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。 ''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
@@ -820,7 +964,7 @@
Next Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions} Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions}
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex) Throw New Exception("LiteLoader 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -848,7 +992,7 @@
Next Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex) Throw New Exception("LiteLoader BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -906,7 +1050,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output Loader.Output = Output
Catch ex As Exception Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex) Throw New Exception("Fabric 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -921,7 +1065,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output Loader.Output = Output
Catch ex As Exception Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex) Throw New Exception("Fabric BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try End Try
End Sub End Sub
@@ -939,30 +1083,121 @@
#End Region #End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源" #Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String() Public Function DlSourceResourceGet(Original As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net") Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"), Original.
MojangBase Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
} Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
}
End Function End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String() Public Function DlSourceLibraryGet(Original As String) As String()
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), Original.
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"), Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
MojangBase Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
} Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
End Function End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String() Public Function DlSourceModGet(Original As String) As String
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址") Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"), Original.
MojangBase Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
} Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
}
End Function End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType), Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -1,5 +1,5 @@
Public Module ModJava Public Module ModJava
Public JavaListCacheVersion As Integer = 6 Public JavaListCacheVersion As Integer = 7
''' <summary> ''' <summary>
''' 目前所有可用的 Java。 ''' 目前所有可用的 Java。
@@ -220,6 +220,8 @@
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话) JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
End If End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry) Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList For Each Entry In JavaPreList
@@ -240,21 +242,25 @@
Dim UserJava As JavaEntry = Nothing Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then Dim VersionSelect As String = ""
Try If RelatedVersion IsNot Nothing Then
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion))) VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
UserJava.Check() If VersionSelect.StartsWithF("{") Then
Catch ex As ThreadInterruptedException Try
Throw UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
Catch ex As Exception UserJava.Check()
UserJava = Nothing Catch ex As ThreadInterruptedException
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion) Throw
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Catch ex As Exception
End Try UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
End If
End If End If
'获取全局设置中指定的 Java '获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect"))) UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
UserJava.Check() UserJava.Check()
@@ -546,7 +552,7 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址 '若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Else Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -665,34 +671,18 @@ Wait:
'若该目录有 Java,则加入结果 '若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹 '查找其下的所有文件夹
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
If IsFullSearch OrElse If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
FolderInfo.Parent.Name.ToLower = "users" OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse
SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse
SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse
SearchEntry.Contains("soft") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse
SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse
SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse
SearchEntry.Contains("game") OrElse SearchEntry.Contains("file") OrElse SearchEntry.Contains("data") OrElse
SearchEntry.Contains("jvm") OrElse SearchEntry.Contains("服务") OrElse SearchEntry.Contains("server") OrElse
SearchEntry.Contains("客户") OrElse SearchEntry.Contains("client") OrElse SearchEntry.Contains("整合") OrElse
SearchEntry.Contains("应用") OrElse SearchEntry.Contains("运行") OrElse SearchEntry.Contains("前置") OrElse
SearchEntry.Contains("mojang") OrElse SearchEntry.Contains("官启") OrElse SearchEntry.Contains("新建文件夹") OrElse
SearchEntry.Contains("eclipse") OrElse SearchEntry.Contains("microsoft") OrElse SearchEntry.Contains("hotspot") OrElse
SearchEntry.Contains("runtime") OrElse SearchEntry.Contains("x86") OrElse SearchEntry.Contains("x64") OrElse
SearchEntry.Contains("forge") OrElse SearchEntry.Contains("原版") OrElse SearchEntry.Contains("optifine") OrElse
SearchEntry.Contains("官方") OrElse SearchEntry.Contains("启动") OrElse SearchEntry.Contains("hmcl") OrElse
SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse
SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse
SearchEntry.Contains("version") OrElse SearchEntry.Contains("baka") OrElse SearchEntry.Contains("pcl") OrElse
SearchEntry.Contains("zulu") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127d64ec6") OrElse '官启文件夹
SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名
SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then
JavaSearchFolder(FolderInfo, Results, Source) JavaSearchFolder(FolderInfo, Results, Source)
End If End If
Next Next
@@ -113,10 +113,18 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1}, New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1} New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
} }
If Setup.Get("LaunchArgumentRam") Then '内存优化
CType(Loaders(2), LoaderCombo(Of String)).Block = False Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30}) Case 0 '全局
End If If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Case 1 '开启
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
Case 2 '关闭
End Select
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False} Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器 If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI '等待加载器执行并更新 UI
@@ -217,7 +225,7 @@ NextInner:
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf & "如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……", "毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End If End If
End Select End Select
End Sub, "Donate") End Sub, "Donate")
@@ -502,10 +510,8 @@ NextInner:
If Input.OAuthRefreshToken = "" Then If Input.OAuthRefreshToken = "" Then
'无 RefreshToken '无 RefreshToken
Relogin: Relogin:
Dim OAuthCode As String = MsLoginStep1(Data, ClientId) Dim OAuthCode As String = MsLoginStep1(Data)
If OAuthCode = "Cancel" Then If OAuthCode = "Cancel" Then Exit Sub
Exit Sub
End If
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.2 Data.Progress = 0.2
OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId) OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
@@ -802,43 +808,21 @@ LoginFinish:
End Try End Try
End Function End Function
'微软登录步骤 1:获取 DeviceCode 并显示验证提示 '微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult), ClientId As String) As String Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码(会自动复制到剪贴板)并登录微软账户,然后允许 PCL2 访问相关信息。" & vbCrLf & "设备代码有时效性,若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") = 1 Then McLaunchLog("开始微软登录步骤 1")
McLaunchLog("开始微软登录步骤 1") OpenWebsite(FormLoginOAuth.LoginUrl1)
Dim Result As String =
Dim DeviceCode As String MyMsgBoxInput("等待网页登录",
Dim UserCode As String "登录完成后,网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行!" & vbCrLf &
Dim VerifyUri As String "如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
Dim ExpiresIn As String ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
Dim Request As String = "client_id=" & ClientId & "&" & "scope=XboxLive.signin%20offline_access" HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
Dim Result As String = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST", Request, "application/x-www-form-urlencoded", 2) If Result Is Nothing Then
McLaunchLog("微软登录已在步骤 1 被取消")
Dim ResultJson As JObject = GetJson(Result) Throw New ThreadInterruptedException("$$")
DeviceCode = ResultJson("device_code")
UserCode = ResultJson("user_code")
VerifyUri = ResultJson("verification_uri")
ExpiresIn = ResultJson("expires_in")
ClipboardSet(UserCode)
OpenWebsite(VerifyUri)
Dim MsgBoxValue As String = ""
While MsgBoxValue IsNot "1"
MsgBoxValue = MyMsgBox("本次验证的设备代码为:" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证:" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后,你可以直接关闭这个弹窗,PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
If MsgBoxValue = "2" Then
ClipboardSet(VerifyUri)
Continue While
ElseIf MsgBoxValue = "3" Then
ClipboardSet(UserCode)
Continue While
ElseIf MsgBoxValue = "1" Then
Exit While
End If
End While
Return DeviceCode
Else Else
Return "Cancel" Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If End If
End Function End Function
@@ -895,19 +879,112 @@ LoginFinish:
Return {"Cancel", ""} Return {"Cancel", ""}
End Function End Function
''微软登录步骤 1:获取 DeviceCode 并显示验证提示
''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
' McLaunchLog("开始微软登录步骤 1:获取验证信息")
' Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
' $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
' '从这里开始直到步骤 2 结束都没有 Review
' '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
' If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码(会自动复制到剪贴板)。" & vbCrLf &
' "设备代码有时效性,若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then
' Return "Cancel"
' End If
' Dim DeviceCode As String = PrepareJson("device_code")
' Dim UserCode As String = PrepareJson("user_code")
' Dim VerifyUri As String = PrepareJson("verification_uri")
' 'ResultJson("expires_in")
' ClipboardSet(UserCode)
' OpenWebsite(VerifyUri)
' Dim MsgBoxValue As String = ""
' While MsgBoxValue IsNot "1"
' MsgBoxValue = MyMsgBox("本次验证的设备代码为:" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证:" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后,你可以直接关闭这个弹窗,PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
' If MsgBoxValue = "2" Then
' ClipboardSet(VerifyUri)
' Continue While
' ElseIf MsgBoxValue = "3" Then
' ClipboardSet(UserCode)
' Continue While
' ElseIf MsgBoxValue = "1" Then
' Exit While
' End If
' End While
' Return DeviceCode
'End Function
''微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
' McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
' Dim Request As String
' If IsRefresh Then
' Request = "grant_type=refresh_token" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
' "scope=XboxLive.signin%20offline_access"
' Else
' Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "scope=XboxLive.signin%20offline_access"
' End If
' Dim Result As String
' Dim stopwatch As Stopwatch = Stopwatch.StartNew()
' While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
' Try
' Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
' Catch ex As Exception
' If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
' Return {"Relogin", ""}
' ElseIf ex.Message.Contains("authorization_declined") Then
' Hint("你拒绝了 PCL2 的访问权限申请,验证过程被中断!")
' Return {"Cancel", ""}
' ElseIf ex.Message.Contains("expired_token") Then
' Hint("Token 已过期,请尝试重新验证!")
' Exit While
' ElseIf ex.Message.Contains("AADSTS70016") Then
' Continue While
' Else
' Throw
' End If
' End Try
' If Result IsNot Nothing Then
' Dim ResultJson As JObject = GetJson(Result)
' Dim AccessToken As String = ResultJson("access_token").ToString
' Dim RefreshToken As String = ResultJson("refresh_token").ToString
' Return {AccessToken, RefreshToken}
' End If
' Thread.Sleep(1000)
' End While
' Hint("验证超时,请尝试重新验证!")
' Return {"Cancel", ""}
'End Function
'微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken '微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
Private Function MsLoginStep3(AccessToken As String) As String Private Function MsLoginStep3(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 3") McLaunchLog("开始微软登录步骤 3")
Dim Request As String = "{ Dim Request As String = "{
""Properties"": { ""Properties"": {
""AuthMethod"": ""RPS"", ""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"", ""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": ""d=" & AccessToken & """ ""RpsTicket"": """ & AccessToken & """
}, },
""RelyingParty"": ""http://auth.xboxlive.com"", ""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT"" ""TokenType"": ""JWT""
}" }" 'TODO: 新版登录改为 ""RpsTicket"": ""d=" & AccessToken & """
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3) Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = GetJson(Result)
@@ -1064,7 +1141,7 @@ LoginFinish:
Case 3 Case 3
'使用正版用户名 '使用正版用户名
Try Try
If Not SkinName = "" Then If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName) Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False) Uuid = McLoginMojangUuid(SkinName, False)
End If End If
@@ -1075,8 +1152,8 @@ LoginFinish:
Case 4 Case 4
'自定义 '自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve") Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000" If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0") Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop Loop
End Select End Select
Return Uuid Return Uuid
@@ -1194,7 +1271,7 @@ LoginFinish:
'统一通行证检测 '统一通行证检测
If Setup.Get("LoginType") = McLoginType.Nide Then If Setup.Get("LoginType") = McLoginType.Nide Then
'至少 Java 8u101 '至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If End If
SyncLock JavaLock SyncLock JavaLock
@@ -1221,12 +1298,12 @@ LoginFinish:
ElseIf MaxVer < New Version(1, 8, 0, 0) Then ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7 JavaCode = 7
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101" JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) Then ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u101" JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8 JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1271,25 +1348,40 @@ LoginFinish:
''' 释放 Java Wrapper 并返回完整文件路径。 ''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary> ''' </summary>
Public Function ExtractJavaWrapper() As String Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar" Dim BaseDir As String = GetJavaWrapperDir()
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper")) Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper"))
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug)
Try
File.Delete(WrapperPath)
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex As Exception
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成")
WrapperPath = BaseDir & "\JavaWrapper2.jar"
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
End Try
End If
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息")
End SyncLock End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath Return WrapperPath
End Function End Function
Private ExtractJavaWrapperLock As New Object Private ExtractJavaWrapperLock As New Object
''' <summary> ''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。 ''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary> ''' </summary>
Public Function GetJavaWrapperDir() As String Public Function GetJavaWrapperDir() As String
If PathAppdata.IsASCII() Then If (Path & "PCL").IsASCII() Then
Return Path & "PCL"
ElseIf PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\") Return PathAppdata.TrimEnd("\")
ElseIf PathTemp.IsASCII() Then ElseIf PathTemp.IsASCII() Then
Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
Return PathTemp.TrimEnd("\") Return PathTemp.TrimEnd("\")
Else Else
Log("[Java] Wrapper:AppData 路径与 Temp 路径中均包含非 ASCII 字符,换用 ProgramData 目录")
Return OsDrive & "ProgramData\PCL" Return OsDrive & "ProgramData\PCL"
End If End If
End Function End Function
@@ -1765,7 +1857,6 @@ NextVersion:
{ {
""authenticationDatabase"": { ""authenticationDatabase"": {
""00000111112222233333444445555566"": { ""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": { ""profiles"": {
""66666555554444433333222221111100"": { ""66666555554444433333222221111100"": {
@@ -1796,7 +1887,6 @@ NextVersion:
{ {
""authenticationDatabase"": { ""authenticationDatabase"": {
""00000111112222233333444445555566"": { ""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": { ""profiles"": {
""66666555554444433333222221111100"": { ""66666555554444433333222221111100"": {
@@ -1872,16 +1962,12 @@ NextVersion:
End Try End Try
'离线皮肤 Alex 警告 '离线皮肤 Alex 警告
Try If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录 McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤 (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical) Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If End If
Catch ex As Exception
Log(ex, "检查离线皮肤失效失败")
End Try
'离线皮肤资源包 '离线皮肤资源包
Try Try
@@ -2123,6 +2209,8 @@ IgnoreCustomSkin:
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";") StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数 '设置其他参数
StartInfo.StandardErrorEncoding = Encoding.UTF8
StartInfo.StandardOutputEncoding = Encoding.UTF8
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.UseShellExecute = False StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True StartInfo.RedirectStandardOutput = True
@@ -151,7 +151,7 @@ Public Module ModMinecraft
#Region "版本处理" #Region "版本处理"
Public Const McVersionCacheVersion As Integer = 29 Public Const McVersionCacheVersion As Integer = 30
Private _McVersionCurrent As McVersion Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化 Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -290,7 +290,7 @@ Public Module ModMinecraft
Public ReadOnly Property Modable As Boolean Public ReadOnly Property Modable As Boolean
Get Get
If Not IsLoaded Then Load() If Not IsLoaded Then Load()
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse Version.HasNeoForge OrElse
DisplayType = McVersionCardType.API '#223 DisplayType = McVersionCardType.API '#223
End Get End Get
End Property End Property
@@ -345,7 +345,7 @@ Public Module ModMinecraft
End If End If
Next Next
End If End If
'从 Forge Arguments 中获取版本号 '从 Forge / NeoForge Arguments 中获取版本号
If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then
Dim Mark As Boolean = False Dim Mark As Boolean = False
For Each Argument In JsonObject("arguments")("game") For Each Argument In JsonObject("arguments")("game")
@@ -565,6 +565,7 @@ Recheck:
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")") Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
End Try End Try
Catch ex As Exception Catch ex As Exception
Log($"[Minecraft] 传入的版本 json 文件内容(共 {Text.Length} 字符,最多输出前 5000 字符):{vbCrLf}{Text.Substring(0, 5000)}")
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex) Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
End Try End Try
Try Try
@@ -665,7 +666,7 @@ Recheck:
Try Try
Dim JsonObjCheck = JsonObject Dim JsonObjCheck = JsonObject
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 json 可用性检查失败(" & Path & ")") Log(ex, "版本 JSON 可用性检查失败(" & Path & ")")
JsonText = "" JsonText = ""
JsonObject = Nothing JsonObject = Nothing
Info = ex.Message Info = ex.Message
@@ -715,8 +716,8 @@ Recheck:
'OptiFine 'OptiFine
If RealJson.Contains("optifine") Then If RealJson.Contains("optifine") Then
State = McVersionState.OptiFine State = McVersionState.OptiFine
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
Version.HasOptiFine = True Version.HasOptiFine = True
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
End If End If
'LiteLoader 'LiteLoader
If RealJson.Contains("liteloader") Then If RealJson.Contains("liteloader") Then
@@ -727,14 +728,20 @@ Recheck:
'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对 'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对
If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then
State = McVersionState.Fabric State = McVersionState.Fabric
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
Version.HasFabric = True Version.HasFabric = True
ElseIf RealJson.Contains("minecraftforge") Then Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
ElseIf RealJson.Contains("minecraftforge") AndAlso Not RealJson.Contains("net.neoforge") Then
State = McVersionState.Forge State = McVersionState.Forge
Version.HasForge = True
Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+") Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+") If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本") If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本")
Version.HasForge = True ElseIf RealJson.Contains("net.neoforge") Then
'1.20.1 JSON 范例:"--fml.forgeVersion", "47.1.99"
'1.20.2+ JSON 范例:"--fml.neoForgeVersion", "20.6.119-beta"
State = McVersionState.NeoForge
Version.HasNeoForge = True
Version.NeoForgeVersion = If(RegexSeek(RealJson, "(?<=orgeVersion"",[^""]*?"")[^""]+(?="",)"), "未知版本")
End If End If
Version.IsApiLoaded = True Version.IsApiLoaded = True
End Select End Select
@@ -752,6 +759,8 @@ ExitDataLoad:
Logo = PathImage & "Blocks/CobbleStone.png" Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge Case McVersionState.Forge
Logo = PathImage & "Blocks/Anvil.png" Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.NeoForge
Logo = PathImage & "Blocks/NeoForge.png"
Case McVersionState.Fabric Case McVersionState.Fabric
Logo = PathImage & "Blocks/Fabric.png" Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine Case McVersionState.OptiFine
@@ -780,7 +789,7 @@ ExitDataLoad:
End If End If
Case McVersionState.Old Case McVersionState.Old
Info = "远古版本" Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString Info = Version.ToString
Case McVersionState.Fool Case McVersionState.Fool
Info = GetMcFoolName(Version.McName) Info = GetMcFoolName(Version.McName)
@@ -813,6 +822,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion) WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader) WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader)
WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion) WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionNeoForge", Version.NeoForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode) WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName) WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain) WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain)
@@ -852,6 +862,7 @@ ExitDataLoad:
OptiFine OptiFine
Old Old
Forge Forge
NeoForge
LiteLoader LiteLoader
Fabric Fabric
End Enum End Enum
@@ -903,6 +914,17 @@ ExitDataLoad:
''' </summary> ''' </summary>
Public ForgeVersion As String = "" Public ForgeVersion As String = ""
'NeoForge
''' <summary>
''' 该版本是否安装了 NeoForge。
''' </summary>
Public HasNeoForge As Boolean = False
''' <summary>
''' NeoForge 版本号,如 21.0.2-beta、47.1.79。
''' </summary>
Public NeoForgeVersion As String = ""
'Fabric 'Fabric
''' <summary> ''' <summary>
@@ -929,6 +951,7 @@ ExitDataLoad:
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
ToString = "" ToString = ""
If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion) If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion)
If HasNeoForge Then ToString += ", NeoForge" & If(NeoForgeVersion = "未知版本", "", " " & NeoForgeVersion)
If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion) If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion)
If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion) If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion)
If HasLiteLoader Then ToString += ", LiteLoader" If HasLiteLoader Then ToString += ", LiteLoader"
@@ -955,15 +978,15 @@ ExitDataLoad:
Else Else
Throw New Exception("无效的 Fabric 版本:" & ForgeVersion) Throw New Exception("无效的 Fabric 版本:" & ForgeVersion)
End If End If
ElseIf HasForge Then ElseIf HasForge OrElse HasNeoForge Then
If ForgeVersion = "未知版本" Then Return 0 If ForgeVersion = "未知版本" AndAlso NeoForgeVersion = "未知版本" Then Return 0
Dim SubVersions = ForgeVersion.Split(".") Dim SubVersions = If(HasForge, ForgeVersion.Split("."), NeoForgeVersion.Split("."))
If SubVersions.Length = 4 Then If SubVersions.Length = 4 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3)) _SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3))
ElseIf SubVersions.Length = 3 Then ElseIf SubVersions.Length = 3 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2)) _SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2))
Else Else
Throw New Exception("无效的 Forge 版本:" & ForgeVersion) Throw New Exception("无效的 Neo/Forge 版本:" & ForgeVersion)
End If End If
ElseIf HasOptiFine Then ElseIf HasOptiFine Then
If OptiFineVersion = "未知版本" Then Return 0 If OptiFineVersion = "未知版本" Then Return 0
@@ -1175,6 +1198,7 @@ OnLoaded:
Dim VersionInfo As New McVersionInfo With { Dim VersionInfo As New McVersionInfo With {
.FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""), .FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""),
.ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""), .ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""),
.NeoForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionNeoForge", ""),
.OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""), .OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""),
.HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False), .HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False),
.SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1), .SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1),
@@ -1183,9 +1207,10 @@ OnLoaded:
.McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1), .McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1),
.IsApiLoaded = True .IsApiLoaded = True
} }
VersionInfo.HasFabric = VersionInfo.FabricVersion.Count > 1 VersionInfo.HasFabric = VersionInfo.FabricVersion.Any()
VersionInfo.HasForge = VersionInfo.ForgeVersion.Count > 1 VersionInfo.HasForge = VersionInfo.ForgeVersion.Any()
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Count > 1 VersionInfo.HasNeoForge = VersionInfo.NeoForgeVersion.Any()
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Any()
Version.Version = VersionInfo Version.Version = VersionInfo
End If End If
@@ -1273,7 +1298,7 @@ OnLoaded:
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool) McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool)
'筛选 API 版本 '筛选 API 版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API) McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.NeoForge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
'将老版本预先分类入不常用,只剩余原版、快照、OptiFine '将老版本预先分类入不常用,只剩余原版、快照、OptiFine
Dim VersionUseful As New List(Of McVersion) Dim VersionUseful As New List(Of McVersion)
@@ -1407,7 +1432,7 @@ OnLoaded:
End Function) End Function)
End If End If
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】 'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
Function(Left As McVersion, Right As McVersion) Function(Left As McVersion, Right As McVersion)
@@ -1417,6 +1442,8 @@ OnLoaded:
Else Else
If Left.Version.HasFabric Xor Right.Version.HasFabric Then If Left.Version.HasFabric Xor Right.Version.HasFabric Then
Return Left.Version.HasFabric Return Left.Version.HasFabric
ElseIf Left.Version.HasNeoForge Xor Right.Version.HasNeoForge Then
Return Left.Version.HasNeoForge
ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then
Return Left.Version.HasForge Return Left.Version.HasForge
ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then
@@ -1649,7 +1676,7 @@ OnLoaded:
Return _Url Return _Url
End Get End Get
Set(value As String) Set(value As String)
'孤儿 Forge 作者喜欢把没有的 URL 写个空字符串 '孤儿 Forge 作者喜欢把没有 URL 的写个空字符串
_Url = If(String.IsNullOrWhiteSpace(value), Nothing, value) _Url = If(String.IsNullOrWhiteSpace(value), Nothing, value)
End Set End Set
End Property End Property
@@ -1666,15 +1693,6 @@ OnLoaded:
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' 原 Json 中 Name 项最后一部分的版本号。
''' </summary>
Public ReadOnly Property Version As String
Get
Dim Splited = OriginalName.Split(":")
Return Splited(Splited.Count - 1)
End Get
End Property
''' <summary>
''' 原 Json 中的 Name 项。 ''' 原 Json 中的 Name 项。
''' </summary> ''' </summary>
Public OriginalName As String Public OriginalName As String
@@ -1755,7 +1773,7 @@ OnLoaded:
'根据 Inherit 获取最深层版本 '根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit '1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = "" Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\") OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
@@ -1840,13 +1858,14 @@ OnLoaded:
Try Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With { BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader, .IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"), .OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")), .Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")), .LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
.Size = Val(Library("downloads")("artifact")("size").ToString), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.IsNatives = False, .Size = Val(Library("downloads")("artifact")("size").ToString),
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString}) .IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
Else Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing}) BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End If End If
@@ -1880,15 +1899,25 @@ OnLoaded:
'去重 '去重
Dim ResultArray As New Dictionary(Of String, McLibToken) Dim ResultArray As New Dictionary(Of String, McLibToken)
Dim GetVersion =
Function(Token As McLibToken) As String
'测试例:
'D:\Minecraft\test\libraries\net\neoforged\mergetool\2.0.0\mergetool-2.0.0-api.jar
'D:\Minecraft\test\libraries\org\apache\commons\commons-collections4\4.2\commons-collections4-4.2.jar
'D:\Minecraft\test\libraries\com\google\guava\guava\31.1-jre\guava-31.1-jre.jar
Return GetFolderNameFromPath(GetPathFromFullPath(Token.LocalPath))
End Function
For i = 0 To BasicArray.Count - 1 For i = 0 To BasicArray.Count - 1
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString
If ResultArray.ContainsKey(Key) Then If ResultArray.ContainsKey(Key) Then
If BasicArray(i).Version <> ResultArray(Key).Version AndAlso KeepSameNameDifferentVersionResult Then Dim BasicArrayVersion As String = GetVersion(BasicArray(i))
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)}") Dim ResultArrayVersion As String = GetVersion(ResultArray(Key))
If BasicArrayVersion <> ResultArrayVersion AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion})")
ResultArray.Add(Key & GetUuid(), BasicArray(i)) ResultArray.Add(Key & GetUuid(), BasicArray(i))
Else Else
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)},已忽略其中之一") Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion}),已忽略其中之一")
If VersionSortBoolean(BasicArray(i).Version, ResultArray(Key).Version) Then If VersionSortBoolean(BasicArrayVersion, ResultArrayVersion) Then
ResultArray(Key) = BasicArray(i) ResultArray(Key) = BasicArray(i)
End If End If
End If End If
@@ -1948,6 +1977,7 @@ OnLoaded:
End If End If
End If End If
End If End If
'Authlib-Injector 文件 'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接 (PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
@@ -1997,8 +2027,14 @@ OnLoaded:
If Token.Url IsNot Nothing Then If Token.Url IsNot Nothing Then
'获取 Url 的真实地址 '获取 Url 的真实地址
Urls.Add(Token.Url) Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven")) Token.Url.Contains(".tsrg") Then
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings(#4425)
End If
If Token.Url.Contains("maven") Then
Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven"))
End If
End If End If
If Token.LocalPath.Contains("transformer-discovery-service") Then If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放 'Transformer 文件释放
@@ -2015,7 +2051,7 @@ OnLoaded:
'普通文件 '普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/"))) Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
End If End If
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker)) Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next Next
'去重并返回 '去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath) Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
@@ -887,7 +887,7 @@ Finished:
ModList.Add(ModEntry) ModList.Add(ModEntry)
'读取 Comp 缓存 '读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey)) ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取 '如果缓存中的信息在 6 小时以内更新过,则无需重新获取
@@ -923,20 +923,15 @@ Finished:
Throw Throw
End Try End Try
End Sub End Sub
'联网加载 Mod 详情 '联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 4 Private Const LocalModCacheVersion As Integer = 6
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of CompModLoaderType) Dim ModLoaders = GetTargetModLoaders()
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim McVersion = TargetMcVersion.McName Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本 '暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 '例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
@@ -957,7 +952,7 @@ Finished:
Try Try
'步骤 1:获取 Hash 与对应的工程 ID '步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST", Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -978,7 +973,7 @@ Finished:
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry( Dim ModrinthProject = CType(GetJson(DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]", $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray) "GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject For Each ProjectJson In ModrinthProject
@@ -990,7 +985,7 @@ Finished:
Next Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息") Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject) ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods For Each Entry In Mods
@@ -1027,7 +1022,7 @@ Finished:
CurseForgeHashes.Add(Entry.CurseForgeHash) CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -1050,12 +1045,12 @@ Finished:
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息 '设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
@@ -1071,7 +1066,8 @@ Finished:
Dim NewestVersion As String = Nothing Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer) Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配 If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件 '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
@@ -1092,7 +1088,7 @@ Finished:
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息") Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息 '步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile) Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles For Each FileJson In CurseForgeFiles
@@ -1136,10 +1132,21 @@ Finished:
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2 Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash & McVersion) = Entry.ToJson() Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新下边栏(#4377)
RunInUi(Sub() FrmVersionMod?.RefreshBottomBar())
End Sub End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
#If DEBUG Then #If DEBUG Then
''' <summary> ''' <summary>
@@ -1271,4 +1278,4 @@ Finished:
End Function End Function
#End If #End If
End Module End Module
@@ -12,9 +12,10 @@ Public Module ModModpack
RunInThread(Sub() ModpackInstall(File)) RunInThread(Sub() ModpackInstall(File))
End Sub End Sub
''' <summary> ''' <summary>
''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。 ''' 安装一个给定的整合包文件,返回启动的安装加载器,如果未成功启动则返回 Nothing。
''' 必须在工作线程执行。
''' </summary> ''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null")) Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
@@ -25,6 +26,7 @@ Public Module ModModpack
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
'从根目录判断整合包类型 '从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断) If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包 If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8)) Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +37,6 @@ Public Module ModModpack
End If End If
End If End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包 If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
'从一级目录判断整合包类型 '从一级目录判断整合包类型
For Each Entry In Archive.Entries For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/") Dim FullNames As String() = Entry.FullName.Split("/")
@@ -45,6 +46,7 @@ Public Module ModModpack
If FullNames.Count <> 2 Then Continue For If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件 '判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断) If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包 If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
@@ -55,54 +57,52 @@ Public Module ModModpack
End If End If
End If End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next Next
Catch ex As Exception Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
ElseIf File.EndsWithF(".rar", True) Then ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
Else Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
End If End If
End Try End Try
'执行对应的安装方法 '执行对应的安装方法
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类:CurseForge") Log("[ModPack] 整合包种类:CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类:HMCL") Log("[ModPack] 整合包种类:HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder) Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2 Case 2
Log("[ModPack] 整合包种类:MMC") Log("[ModPack] 整合包种类:MMC")
InstallPackMMC(File, Archive, ArchiveBaseFolder) Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3 Case 3
Log("[ModPack] 整合包种类:MCBBS") Log("[ModPack] 整合包种类:MCBBS")
InstallPackMCBBS(File, Archive, ArchiveBaseFolder) Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Case 4 Case 4
Log("[ModPack] 整合包种类:Modrinth") Log("[ModPack] 整合包种类:Modrinth")
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类:压缩包") Log("[ModPack] 整合包种类:压缩包")
Archive.Dispose() Archive.Dispose()
Archive = Nothing Archive = Nothing
InstallPackCompress(File, ArchiveBaseFolder) Return InstallPackCompress(File, ArchiveBaseFolder)
Case Else Case Else
If ShowHint Then If ShowHint Then
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical) Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
Else Else
Log("[ModPack] 未能识别该整合包的种类,无法安装!") Log("[ModPack] 未能识别该整合包的种类,无法安装!")
End If End If
Return False Return Nothing
End Select End Select
Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "准备安装整合包失败", LogLevel.Feedback) Log(ex, "准备安装整合包失败", LogLevel.Feedback)
Return False Return Nothing
Finally Finally
If Archive IsNot Nothing Then Archive.Dispose() If Archive IsNot Nothing Then Archive.Dispose()
End Try End Try
@@ -159,7 +159,8 @@ Retry:
#Region "不同类型整合包的安装方法" #Region "不同类型整合包的安装方法"
'CurseForge 'CurseForge
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -167,22 +168,23 @@ Retry:
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {}) For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower Dim Id As String = If(Entry("id"), "").ToString.ToLower
@@ -190,20 +192,29 @@ Retry:
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint) Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
Exit Sub Return Nothing
End If End If
Try Try
Log("[ModPack] 整合包 Forge 版本:" & Id) Log("[ModPack] 整合包 Forge 版本:" & Id)
ForgeVersion = Id.Split("-")(1) ForgeVersion = Id.Replace("forge-", "")
Exit For Exit For
Catch ex As Exception Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id) Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try End Try
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Try
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
NeoForgeVersion = Id.Replace("neoforge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("fabric-") Then ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定 'Fabric 指定
Try Try
Log("[ModPack] 整合包 Fabric 版本:" & Id) Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Split("-")(1) FabricVersion = Id.Replace("fabric-", "")
Exit For Exit For
Catch ex As Exception Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id) Log(ex, "读取整合包 Fabric 版本失败:" & Id)
@@ -271,19 +282,23 @@ Retry:
'建立 CompFile '建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod) Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断是资源包还是 Mod '根据 modules 和文件名后缀判断资源类型
Dim IsResourcePack As Boolean Dim TargetFolder As String
If ModJson("modules").Any Then 'modules 可能返回 null(#1006) If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
IsResourcePack = If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info File.FileName.EndsWithF(".jar", True) Then
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta TargetFolder = "mods"
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks"
Else
TargetFolder = "shaderpacks"
End If
Else Else
IsResourcePack = False TargetFolder = "mods"
End If End If
'实际的添加 '实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\")) FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count) Task.Progress += 1 / (1 + ModList.Count)
Next Next
Task.Output = FileList.Values.ToList Task.Output = FileList.Values.ToList
@@ -301,10 +316,11 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("minecraft")("version").ToString, .MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -335,14 +351,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " " Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -350,11 +362,11 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub End Function
'Modrinth 'Modrinth
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -363,11 +375,12 @@ Retry:
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {}) For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower Select Case Entry.Name.ToLower
@@ -376,47 +389,50 @@ Retry:
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0 Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion) Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
Case "fabric-loader" 'eg. 0.14.14 Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion) Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0 Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
Case Else Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical) Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
Exit Sub Return Nothing
End Select End Select
Next Next
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If End If
'解压和配置文件 '解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5 Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹 '复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过") Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If End If
Task.Progress = 0.8 Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If End If
Task.Progress = 0.9 Task.Progress = 0.9
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
Dim FileList As New List(Of NetFile) Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {}) For Each File In If(Json("files"), {})
@@ -433,8 +449,10 @@ Retry:
End Select End Select
End If End If
'添加下载文件 '添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390 Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString, Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True)) New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next Next
If FileList.Any Then If FileList.Any Then
@@ -447,10 +465,11 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = MinecraftVersion, .MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -481,14 +500,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " " Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -496,25 +511,26 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub End Function
'HMCL 'HMCL
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(Json("name"), "") Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -535,7 +551,7 @@ Retry:
'构造加载器 '构造加载器
If Json("gameVersion") Is Nothing Then If Json("gameVersion") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
@@ -543,7 +559,7 @@ Retry:
.MinecraftName = Json("gameVersion").ToString .MinecraftName = Json("gameVersion").ToString
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件) '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)", LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -571,14 +587,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " " Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -587,10 +599,11 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'MMC 'MMC
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim PackJson As JObject, PackInstance As String Dim PackJson As JObject, PackInstance As String
Try Try
@@ -598,14 +611,14 @@ Retry:
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8) PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压、配置设置文件 '解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\" Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
@@ -665,7 +678,7 @@ Retry:
'构造版本安装请求 '构造版本安装请求
If PackJson("components") Is Nothing Then If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components") For Each Component In PackJson("components")
@@ -676,16 +689,18 @@ Retry:
Request.MinecraftName = Component("version") Request.MinecraftName = Component("version")
Case "net.minecraftforge" Case "net.minecraftforge"
Request.ForgeVersion = Component("version") Request.ForgeVersion = Component("version")
Case "net.neoforged"
Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader" Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version") Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
End Select End Select
Next Next
'构造加载器 '构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -698,14 +713,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " " Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -713,10 +724,12 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'MCBBS 'MCBBS
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
@@ -724,14 +737,17 @@ Retry:
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(Json("name"), "") Dim ShowRibble As Boolean = VersionName Is Nothing
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") If VersionName Is Nothing Then
If Validate.Validate(PackName) <> "" Then PackName = "" VersionName = If(Json("name"), "")
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If VersionName Is Nothing Then Exit Sub If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -752,7 +768,7 @@ Retry:
'构造加载器 '构造加载器
If Json("addons") Is Nothing Then If Json("addons") Is Nothing Then
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Addons As New Dictionary(Of String, String) Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons") For Each Entry In Json("addons")
@@ -760,11 +776,11 @@ Retry:
Next Next
If Not Addons.ContainsKey("game") Then If Not Addons.ContainsKey("game") Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
If Addons.ContainsKey("quilt") Then If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
@@ -772,10 +788,11 @@ Retry:
.MinecraftName = Addons("game"), .MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing), .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing), .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -788,14 +805,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -803,28 +816,36 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'普通压缩包 '普通压缩包
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True) MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
'获取解压路径 '获取解压路径
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return Nothing
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Return Nothing
'要求显示名称 '要求显示名称
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder), Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})}) New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
'解压 '解压
Hint("正在解压压缩包……") Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
UnpackFiles(TargetFolder, FileAddress, Nothing) New LoaderTask(Of String, Integer)("安装压缩包",
'加入文件夹列表 Sub()
PageSelectLeft.AddFolder(TargetFolder, NewName, False) UnpackFiles(TargetFolder, FileAddress, Nothing)
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish) PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
End Sub End Sub)
})
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
#End Region #End Region
+30 -20
View File
@@ -21,28 +21,38 @@
OpenWebsite(Data(0)) OpenWebsite(Data(0))
Case "打开文件", "打开帮助" Case "打开文件", "打开帮助"
RunInThread(Sub() RunInThread(
Try Sub()
'确认实际路径 Try
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) '确认实际路径
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
'执行 Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
If Type = "打开文件" Then Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
Dim Info As New ProcessStartInfo With { '执行
.Arguments = If(Data.Length >= 2, Data(1), ""), If Type = "打开文件" Then
.FileName = Location, Dim Info As New ProcessStartInfo With {
.WorkingDirectory = WorkingDir .Arguments = If(Data.Length >= 2, Data(1), ""),
} .FileName = Location,
Process.Start(Info) .WorkingDirectory = WorkingDir
Else '打开帮助 }
PageOtherHelp.EnterHelpPage(Location) Process.Start(Info)
End If Else '打开帮助
Catch ex As Exception PageOtherHelp.EnterHelpPage(Location)
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) End If
End Try Catch ex As Exception
End Sub) Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏" Case "启动游戏"
If Data(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Else
Data(0) = McVersionCurrent.Name
End If
End If
If McLaunchStart(New McLaunchOptions With If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……") Hint("正在启动 " & Data(0) & "……")
@@ -394,6 +394,7 @@ EndHint:
Public FrmDownloadOptiFine As PageDownloadOptiFine Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack Public FrmDownloadPack As PageDownloadPack
+16 -6
View File
@@ -69,16 +69,25 @@
Else Else
'有背景音乐 '有背景音乐
FrmMain.BtnExtraMusic.Show = True FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
Dim ToolTipText As String = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicState = MusicStates.Pause Then If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8 FrmMain.BtnExtraMusic.LogoScale = 0.8
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键播放,右键播放下一曲。" ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1 FrmMain.BtnExtraMusic.LogoScale = 1
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。" ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16)) ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
@@ -115,13 +124,14 @@
''' </summary> ''' </summary>
Public Sub MusicControlNext() Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then If MusicAllList.Count = 1 Then
Hint("播放列表中仅有一首歌曲!") MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address) MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish) Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
MusicRefreshUI()
End If End If
MusicRefreshUI()
End Sub End Sub
#End Region #End Region
+8 -8
View File
@@ -10,6 +10,8 @@ Friend Module ModSecret
'在开源内容的注册表键与普通内容的注册表键隔离 '在开源内容的注册表键与普通内容的注册表键隔离
Public Const RegFolder As String = "PCLDebug" Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
Public Const OAuthClientId As String = ""
Friend Sub SecretOnApplicationStart() Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级 '提升 UI 线程优先级
@@ -41,9 +43,9 @@ Friend Module ModSecret
Environment.[Exit](Result.Cancel) Environment.[Exit](Result.Cancel)
End If End If
'开源版本提示 '开源版本提示
MyMsgBox($"该版本中不包含以下特性: MyMsgBox($"该版本中无法使用以下特性:
- 微软账户登录:需要 Client ID(你可以创建并申请一个,然后添加到 McLoginMsStart 方法中) - CurseForge API 调用:需要你自行申请 API Key,然后添加到 SecretHeadersSign 方法中
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中) - 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患 - 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦…… - 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明") - 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
@@ -90,7 +92,6 @@ Friend Module ModSecret
#Region "网络鉴权" #Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String) Friend Function SecretCdnSign(UrlWithMark As String)
'只处理以 {CDN} 结尾的链接
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20") Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function End Function
@@ -98,26 +99,24 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then If UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/" Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 '如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub End Sub
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then If UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Request.UserAgent = "PCL2/" & VersionStandardCode Request.UserAgent = "PCL2/" & VersionStandardCode
End If End If
Request.Referer = "http://" & VersionCode & ".pcl2.server/" Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 '如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub End Sub
@@ -253,6 +252,7 @@ Friend Module ModSecret
Return False Return False
End Function End Function
Public Function DonateCodeInput() As Boolean? Public Function DonateCodeInput() As Boolean?
Return Nothing
End Function End Function
#End Region #End Region
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.7.4.0")> <Assembly: AssemblyVersion("2.8.4.0")>
<Assembly: AssemblyFileVersion("2.7.4.0")> <Assembly: AssemblyFileVersion("2.8.4.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
File diff suppressed because it is too large Load Diff
@@ -43,6 +43,12 @@
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select End Select
Case "special" Case "special"
'已被处理的愚人节版 '已被处理的愚人节版
@@ -56,7 +62,7 @@
'排序 '排序
For i = 0 To Dict.Keys.Count - 1 For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date)) Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next Next
'清空当前 '清空当前
PanMain.Children.Clear() PanMain.Children.Clear()
@@ -87,7 +93,7 @@
PanMain.Children.Add(NewCard) PanMain.Children.Add(NewCard)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback) Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
@@ -170,24 +170,25 @@
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png" Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!") Throw New Exception("整合包安装出现异常!")
End If End If
End Sub) With {.ProgressWeight = 0.1}) End Sub) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader) Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Select Case MyLoader.State Sub(MyLoader)
Case LoadState.Failed Select Case MyLoader.State
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical) Case LoadState.Failed
Case LoadState.Aborted Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Hint(MyLoader.Name & "已取消!", HintType.Info) Case LoadState.Aborted
Case LoadState.Loading Hint(MyLoader.Name & "已取消!", HintType.Info)
Exit Sub '不重新加载版本列表 Case LoadState.Loading
End Select Exit Sub '不重新加载版本列表
McInstallFailedClearFolder(MyLoader) End Select
End Sub} McInstallFailedClearFolder(MyLoader)
End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\") Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -197,7 +198,7 @@
Log(ex, "下载资源整合包失败", LogLevel.Feedback) Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try End Try
End Sub End Sub
'Mod 下载;整合包另存为 'Mod、资源包下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹 Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs) Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
@@ -211,10 +212,10 @@
'获取 Mod 所需的加载器种类 '获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Any Then '从文件中获取 If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric) AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Any Then '从工程中获取 ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric) AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
@@ -230,7 +231,7 @@
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso 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.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False Return False
End Function End Function
@@ -260,10 +261,11 @@
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置") Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If End If
Else '选择 Mod 数量最多的版本 Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v) Dim SelectedVersion = SuitableVersions.OrderBy(
Dim Info As New DirectoryInfo(v.PathIndie & "mods\") Function(v)
Return If(Info.Exists, Info.GetFiles().Length, -1) Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
End Function).LastOrDefault() Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\" DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder) Directory.CreateDirectory(DefaultFolder)
Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")") Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
@@ -33,7 +33,7 @@
' PanMain.Children.Insert(0, CardWarn) ' PanMain.Children.Insert(0, CardWarn)
'End If 'End If
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback) Log(ex, "可视化 Forge 版本列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
@@ -55,10 +55,6 @@
Card.StackInstall() Card.StackInstall()
End Sub End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadForge(sender.Tag)
End Sub
'介绍栏 '介绍栏
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://files.minecraftforge.net") OpenWebsite("https://files.minecraftforge.net")
@@ -20,6 +20,7 @@
<StackPanel Margin="25,37,25,15"> <StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" /> <local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" /> <local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" /> <local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" />
<Grid Margin="0,0,0,11"> <Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -79,6 +80,24 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="NeoForge" Height="40" Margin="0,15,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
<Grid x:Name="PanNeoForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgNeoForge" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/NeoForge.png" />
<TextBlock x:Name="LabNeoForge" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="Fabric" Height="40" Margin="0,15,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="Fabric" Height="40" Margin="0,15,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
<Grid x:Name="PanFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -178,6 +197,7 @@
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" /> <local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadForge" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadNeoForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadLiteLoader" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadLiteLoader" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" />
@@ -10,6 +10,7 @@
DlOptiFineListLoader.Start() DlOptiFineListLoader.Start()
DlLiteLoaderListLoader.Start() DlLiteLoaderListLoader.Start()
DlFabricListLoader.Start() DlFabricListLoader.Start()
DlNeoForgeListLoader.Start()
'重载预览 '重载预览
TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")} TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")}
@@ -26,6 +27,7 @@
LoadLiteLoader.State = DlLiteLoaderListLoader LoadLiteLoader.State = DlLiteLoaderListLoader
LoadFabric.State = DlFabricListLoader LoadFabric.State = DlFabricListLoader
LoadFabricApi.State = DlFabricApiLoader LoadFabricApi.State = DlFabricApiLoader
LoadNeoForge.State = DlNeoForgeListLoader
LoadOptiFabric.State = DlOptiFabricLoader LoadOptiFabric.State = DlOptiFabricLoader
End Sub End Sub
@@ -51,6 +53,7 @@
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True CardForge.IsSwaped = True
CardNeoForge.IsSwaped = True
CardFabric.IsSwaped = True CardFabric.IsSwaped = True
CardFabricApi.IsSwaped = True CardFabricApi.IsSwaped = True
CardOptiFabric.IsSwaped = True CardOptiFabric.IsSwaped = True
@@ -80,32 +83,36 @@
AniStart({ AniStart({
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10), AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10), AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10),
AaCode(Sub() AaCode(
PanBack.ScrollToHome() Sub()
TextSelectName.Validate() PanBack.ScrollToHome()
OptiFine_Loaded() TextSelectName.Validate()
LiteLoader_Loaded() OptiFine_Loaded()
Forge_Loaded() LiteLoader_Loaded()
Fabric_Loaded() Forge_Loaded()
FabricApi_Loaded() NeoForge_Loaded()
OptiFabric_Loaded() Fabric_Loaded()
SelectReload() FabricApi_Loaded()
End Sub, After:=True), OptiFabric_Loaded()
SelectReload()
End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150), AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)), AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub() AaCode(
PanMinecraft.Visibility = Visibility.Collapsed Sub()
PanBack.IsHitTestVisible = True PanMinecraft.Visibility = Visibility.Collapsed
'初始化 Binding PanBack.IsHitTestVisible = True
If IsFirstLoaded Then Exit Sub '初始化 Binding
IsFirstLoaded = True If IsFirstLoaded Then Exit Sub
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay}) IsFirstLoaded = True
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay}) BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay}) BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay}) BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay}) BtnNeoForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardNeoForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay}) BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True) BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True)
}, "FrmDownloadInstall SelectPageSwitch", True) }, "FrmDownloadInstall SelectPageSwitch", True)
End Sub End Sub
Public Sub ExitSelectPage() Public Sub ExitSelectPage()
@@ -213,6 +220,26 @@
End If End If
End Sub End Sub
'NeoForge
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private Sub SetNeoForgeInfoShow(IsShow As String)
If PanNeoForgeInfo.Tag = IsShow Then Exit Sub
PanNeoForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 100, 90)
}, "SetNeoForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 100)
}, "SetNeoForgeInfoShow")
End If
End Sub
'Fabric 'Fabric
Private SelectedFabric As String = Nothing Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String) Private Sub SetFabricInfoShow(IsShow As String)
@@ -277,7 +304,7 @@
''' <summary> ''' <summary>
''' 重载已选择的项目的显示。 ''' 重载已选择的项目的显示。
''' </summary> ''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True IsReloading = True
'主预览 '主预览
@@ -338,9 +365,30 @@
Else Else
BtnForgeClear.Visibility = Visibility.Visible BtnForgeClear.Visibility = Visibility.Visible
ImgForge.Visibility = Visibility.Visible ImgForge.Visibility = Visibility.Visible
LabForge.Text = SelectedForge.Version LabForge.Text = SelectedForge.VersionName
LabForge.Foreground = ColorGray1 LabForge.Foreground = ColorGray1
End If End If
'NeoForge
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) <= 19 Then
CardNeoForge.Visibility = Visibility.Collapsed
Else
CardNeoForge.Visibility = Visibility.Visible
Dim NeoForgeError As String = LoadNeoForgeGetError()
CardNeoForge.MainSwap.Visibility = If(NeoForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If NeoForgeError IsNot Nothing Then CardNeoForge.IsSwaped = True
SetNeoForgeInfoShow(CardNeoForge.IsSwaped)
If SelectedNeoForge Is Nothing Then
BtnNeoForgeClear.Visibility = Visibility.Collapsed
ImgNeoForge.Visibility = Visibility.Collapsed
LabNeoForge.Text = If(NeoForgeError, "点击选择")
LabNeoForge.Foreground = ColorGray4
Else
BtnNeoForgeClear.Visibility = Visibility.Visible
ImgNeoForge.Visibility = Visibility.Visible
LabNeoForge.Text = SelectedNeoForge.VersionName
LabNeoForge.Foreground = ColorGray1
End If
End If
'Fabric 'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed CardFabric.Visibility = Visibility.Collapsed
@@ -411,9 +459,16 @@
HintFabricAPI.Visibility = Visibility.Collapsed HintFabricAPI.Visibility = Visibility.Collapsed
End If End If
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
HintOptiFabric.Visibility = Visibility.Visible If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Visible
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
Else Else
HintOptiFabric.Visibility = Visibility.Collapsed HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If End If
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso
(SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then
@@ -434,6 +489,7 @@
SelectedOptiFine = Nothing SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing SelectedLiteLoader = Nothing
SelectedForge = Nothing SelectedForge = Nothing
SelectedNeoForge = Nothing
SelectedFabric = Nothing SelectedFabric = Nothing
SelectedFabricApi = Nothing SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
@@ -449,7 +505,10 @@
Name += "-Fabric " & SelectedFabric.Replace("+build", "") Name += "-Fabric " & SelectedFabric.Replace("+build", "")
End If End If
If SelectedForge IsNot Nothing Then If SelectedForge IsNot Nothing Then
Name += "-Forge_" & SelectedForge.Version Name += "-Forge_" & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Name += "-NeoForge_" & SelectedNeoForge.VersionName
End If End If
If SelectedLiteLoader IsNot Nothing Then If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader" Name += "-LiteLoader"
@@ -468,7 +527,10 @@
Info += ", Fabric " & SelectedFabric.Replace("+build", "") Info += ", Fabric " & SelectedFabric.Replace("+build", "")
End If End If
If SelectedForge IsNot Nothing Then If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.Version Info += ", Forge " & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Info += ", NeoForge " & SelectedNeoForge.VersionName
End If End If
If SelectedLiteLoader IsNot Nothing Then If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader" Info += ", LiteLoader"
@@ -487,6 +549,8 @@
Return "pack://application:,,,/images/Blocks/Fabric.png" Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png" Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/NeoForge.png"
ElseIf SelectedLiteLoader IsNot Nothing Then ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png" Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then ElseIf SelectedOptiFine IsNot Nothing Then
@@ -554,6 +618,12 @@
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select End Select
Case "special" Case "special"
'已被处理的愚人节版 '已被处理的愚人节版
@@ -624,6 +694,7 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。 ''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadOptiFineGetError() As String Private Function LoadOptiFineGetError() As String
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容 '检查 Forge 1.13 - 1.14.3:全部不兼容
@@ -659,10 +730,12 @@
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry) Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本 If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0
Forge.Version.After(".") >= OptiFine.RequiredForgeVersion) Else 'XXXX
Return Forge.Version.Revision >= OptiFine.RequiredForgeVersion
End If
End Function End Function
'限制展开 '限制展开
@@ -685,11 +758,12 @@
Next Next
If Not Versions.Any() Then Exit Sub If Not Versions.Any() Then Exit Sub
'排序 '排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean Versions = Sort(Versions,
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay) If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
End Function) Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
'可视化 '可视化
PanOptiFine.Children.Clear() PanOptiFine.Children.Clear()
For Each Version In Versions For Each Version In Versions
@@ -706,6 +780,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded() OptiFabric_Loaded()
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded()
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
SelectReload() SelectReload()
End Sub End Sub
@@ -715,6 +790,7 @@
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
e.Handled = True e.Handled = True
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded()
SelectReload() SelectReload()
End Sub End Sub
@@ -800,6 +876,7 @@
Dim NotSuitForOptiFine As Boolean = False Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本 If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
@@ -829,16 +906,15 @@
If SelectedMinecraftId <> Loader.Input Then Exit Sub If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub If Loader.State <> LoadState.Finished Then Exit Sub
'获取要显示的版本 '获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
If Not Loader.Output.Any() Then Exit Sub If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear() PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)). Versions = Sort(Versions, Function(a, b) a.Version > b.Version).Where(
Where(Function(v) Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本 If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True Return True
End Function).ToList End Function).ToList()
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False) ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions For Each Version In Versions
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
@@ -866,6 +942,67 @@
#End Region #End Region
#Region "NeoForge 列表"
''' <summary>
''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadNeoForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本"
If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message
If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then
Return Nothing
Else
Return "没有可用版本"
End If
End Function
'限制展开
Private Sub CardNeoForge_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardNeoForge.PreviewSwap
If LoadNeoForgeGetError() IsNot Nothing Then e.Handled = True
End Sub
''' <summary>
''' 尝试重新可视化 NeoForge 版本列表。
''' </summary>
Private Sub NeoForge_Loaded() Handles LoadNeoForge.StateChanged
Try
'获取版本列表
If DlNeoForgeListLoader.State <> LoadState.Finished Then Exit Sub
Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = SelectedMinecraftId).ToList
If Not Versions.Any() Then Exit Sub
'可视化
PanNeoForge.Children.Clear()
NeoForgeDownloadListItemPreload(PanNeoForge, Versions, AddressOf NeoForge_Selected, False)
For Each Version In Versions
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", LogLevel.Feedback)
End Try
End Sub
'选择与清除
Private Sub NeoForge_Selected(sender As MyListItem, e As EventArgs)
SelectedNeoForge = sender.Tag
CardNeoForge.IsSwaped = True
OptiFine_Loaded()
SelectReload()
End Sub
Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp
SelectedNeoForge = Nothing
CardNeoForge.IsSwaped = True
e.Handled = True
OptiFine_Loaded()
SelectReload()
End Sub
#End Region
#Region "Fabric 列表" #Region "Fabric 列表"
''' <summary> ''' <summary>
@@ -877,7 +1014,7 @@
For Each Version As JObject In DlFabricListLoader.Output.Value("game") For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容" If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
Return Nothing Return Nothing
End If End If
Next Next
@@ -1064,6 +1201,7 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。 ''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadOptiFabricGetError() As String Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then If DlOptiFabricLoader.Output Is Nothing Then
@@ -1109,7 +1247,8 @@
PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected)) PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected))
Next Next
'自动选择 OptiFabric '自动选择 OptiFabric
If Not AutoSelectedOptiFabric Then If Not AutoSelectedOptiFabric AndAlso
Not (SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15")) Then '1.14~15 不自动选择
AutoSelectedOptiFabric = True AutoSelectedOptiFabric = True
Log($"[Download] 已自动选择 OptiFabric:{CType(PanOptiFabric.Children(0), MyListItem).Title}") Log($"[Download] 已自动选择 OptiFabric:{CType(PanOptiFabric.Children(0), MyListItem).Title}")
OptiFabric_Selected(PanOptiFabric.Children(0), Nothing) OptiFabric_Selected(PanOptiFabric.Children(0), Nothing)
@@ -1141,7 +1280,7 @@
End Sub End Sub
Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click
'确认版本隔离 '确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then (Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf & If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf &
"因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & "因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
@@ -1157,6 +1296,7 @@
.MinecraftName = SelectedMinecraftId, .MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine, .OptiFineEntry = SelectedOptiFine,
.ForgeEntry = SelectedForge, .ForgeEntry = SelectedForge,
.NeoForgeEntry = SelectedNeoForge,
.FabricVersion = SelectedFabric, .FabricVersion = SelectedFabric,
.FabricApi = SelectedFabricApi, .FabricApi = SelectedFabricApi,
.OptiFabric = SelectedOptiFabric, .OptiFabric = SelectedOptiFabric,
@@ -43,39 +43,47 @@
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric" <local:MyListItem x:Name="ItemNeoForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="NeoForge"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z"> LogoScale="0.95" Logo="M544.6 921.2l-23.7 32.6c14.1 10.2 33.3 10.2 47.5 0l-23.7-32.6zM114.6 608.5l-23.9 32.5 0.2 0.1 23.6-32.6z m-12.0-38.0l38.3 12.7v-0.2l-38.3-12.4z m49.2-152.6l-38.4-12.4 38.4 12.4zM250.2 114.4l-37.6-14.6a40.2 40.2 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.0 29.9 0.2-0.2-27.2-29.7z m11.7-4.5V63.0v40.4z m11.7 4.5l28.0-29.0a40.5 40.5 0 0 0-0.8-0.8l-27.2 29.8z m4.4 7.3l-38.6 11.7a40.5 40.5 0 0 0 0.2 0.7l38.3-12.4zM381.0 417.7l-38.4 12.5a40.3 40.3 0 0 0 38.4 27.8v-40.3z m327.0 0v40.3c17.5 0 32.9-11.2 38.4-27.8L708.1 417.7z m98.5-303.3l-37.6-14.6a38.4 38.4 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.1 29.9 0.1-0.2-27.2-29.7z m11.7-4.5v0z m11.7 4.5l28.0-29.0a38.4 38.4 0 0 0-0.8-0.8l-27.2 29.8z m4.3 7.3l-38.6 11.7a47.5 47.5 0 0 0 0.2 0.7l38.4-12.4z m98.5 303.3l-38.4 12.4 0.1 0.5 38.2-12.9z m51.2 151.9l38.7-11.3a34.5 34.5 0 0 0-0.5-1.6l-38.1 12.9z m-37.8 5.2l-430.0 312.6 47.5 65.3 429.9-312.6-47.5-65.3z m-382.5 312.6L138.3 575.8l-47.5 65.3L520.9 953.9l47.3-65.3zM138.5 576a6.4 6.4 0 0 1 2.3 3.2l-76.9 24.5c4.7 14.9 14.1 28.0 26.7 37.3l47.8-65.0z m2.3 3.2a6.4 6.4 0 0 1 0 4.0L64.1 557.9a74.3 74.3 0 0 0-0.2 45.8l76.9-24.5z m0 3.7l49.2-152.6-76.8-24.8L64.0 558.2l76.8 24.8z m49.2-152.5l98.5-303.3-76.8-25.0L113.3 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9L227.6 78.0a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6A57.7 57.7 0 0 0 266.4 63.0v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.3 57.3 0 0 0-15.0-24.5l-56.1 58.0z m-5.8-9.2l98.4 302.5 76.8-25.0-98.5-302.5-76.8 25.0z m136.8 330.4H708.1V377.5H381.2v80.7z m365.4-27.8l98.5-303.3-76.8-25.0L669.6 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9l-54.1-59.9a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6a57.7 57.7 0 0 0-38.9-15.1v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.4 57.4 0 0 0-14.9-24.5l-56.1 58.0z m-5.8-9.2l98.5 303.3 76.8-25.0-98.5-303.3-76.8 25.0z m98.6 303.8l51.2 151.9 76.5-25.8-51.2-151.9-76.5 25.8z m50.7 150.2a6.5 6.5 0 0 1 0.1-4.0l75.6 28.1c5.5-14.9 6.2-31.3 1.6-46.7l-77.5 22.6z m0.1-4.0a6.4 6.4 0 0 1 2.4-3.2l43.8 67.8c13.4-8.7 23.6-21.5 29.2-36.4l-75.6-28.1z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="7" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" /> <local:MyIconButton Tag="7" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader" <local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z"> LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="8" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" /> <local:MyIconButton Tag="8" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" /> <local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="9" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod" LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="10" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" /> <local:MyIconButton Tag="9" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包" <TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z"> <local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="11" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" /> <local:MyIconButton Tag="11" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="12" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="12" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel> </StackPanel>
</local:MyPageLeft> </local:MyPageLeft>
@@ -10,7 +10,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -31,6 +31,9 @@
Case FormMain.PageSubType.DownloadForge Case FormMain.PageSubType.DownloadForge
If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge
Return FrmDownloadForge Return FrmDownloadForge
Case FormMain.PageSubType.DownloadNeoForge
If FrmDownloadNeoForge Is Nothing Then FrmDownloadNeoForge = New PageDownloadNeoForge
Return FrmDownloadNeoForge
Case FormMain.PageSubType.DownloadLiteLoader Case FormMain.PageSubType.DownloadLiteLoader
If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader
Return FrmDownloadLiteLoader Return FrmDownloadLiteLoader
@@ -69,17 +72,19 @@
FrmMain.PageRight = Target FrmMain.PageRight = Target
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit() CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit()
AniStart({ AniStart({
AaCode(Sub() AaCode(
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit() Sub()
FrmMain.PanMainRight.Child = FrmMain.PageRight CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PageRight.Opacity = 0 FrmMain.PanMainRight.Child = FrmMain.PageRight
End Sub, 130), FrmMain.PageRight.Opacity = 0
AaCode(Sub() End Sub, 130),
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理 AaCode(
FrmMain.PageRight.Opacity = 1 Sub()
FrmMain.PageRight.PageOnEnter() '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
End Sub, 30, True) FrmMain.PageRight.Opacity = 1
}, "PageLeft PageChange") FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
End Sub End Sub
#End Region #End Region
@@ -91,6 +96,7 @@
DlClientListLoader.Start(IsForceRestart:=True) DlClientListLoader.Start(IsForceRestart:=True)
DlOptiFineListLoader.Start(IsForceRestart:=True) DlOptiFineListLoader.Start(IsForceRestart:=True)
DlForgeListLoader.Start(IsForceRestart:=True) DlForgeListLoader.Start(IsForceRestart:=True)
DlNeoForgeListLoader.Start(IsForceRestart:=True)
DlLiteLoaderListLoader.Start(IsForceRestart:=True) DlLiteLoaderListLoader.Start(IsForceRestart:=True)
DlFabricListLoader.Start(IsForceRestart:=True) DlFabricListLoader.Start(IsForceRestart:=True)
DlFabricApiLoader.Start(IsForceRestart:=True) DlFabricApiLoader.Start(IsForceRestart:=True)
@@ -117,6 +123,9 @@
Case FormMain.PageSubType.DownloadForge Case FormMain.PageSubType.DownloadForge
DlForgeListLoader.Start(IsForceRestart:=True) DlForgeListLoader.Start(IsForceRestart:=True)
ItemForge.Checked = True ItemForge.Checked = True
Case FormMain.PageSubType.DownloadNeoForge
DlNeoForgeListLoader.Start(IsForceRestart:=True)
ItemNeoForge.Checked = True
Case FormMain.PageSubType.DownloadLiteLoader Case FormMain.PageSubType.DownloadLiteLoader
DlLiteLoaderListLoader.Start(IsForceRestart:=True) DlLiteLoaderListLoader.Start(IsForceRestart:=True)
ItemLiteLoader.Checked = True ItemLiteLoader.Checked = True
@@ -154,12 +163,14 @@
ItemOptiFine.Visibility = Visibility.Visible ItemOptiFine.Visibility = Visibility.Visible
ItemFabric.Visibility = Visibility.Visible ItemFabric.Visibility = Visibility.Visible
ItemForge.Visibility = Visibility.Visible ItemForge.Visibility = Visibility.Visible
ItemNeoForge.Visibility = Visibility.Visible
ItemLiteLoader.Visibility = Visibility.Visible ItemLiteLoader.Visibility = Visibility.Visible
RunInThread(Sub() RunInThread(
Thread.Sleep(20) Sub()
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True)) Thread.Sleep(20)
AniControlEnabled -= 1 RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
End Sub) AniControlEnabled -= 1
End Sub)
End Sub End Sub
'折叠手动安装 '折叠手动安装
Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp
@@ -170,14 +181,16 @@
LabHand.Visibility = Visibility.Collapsed LabHand.Visibility = Visibility.Collapsed
ItemClient.Visibility = Visibility.Collapsed ItemClient.Visibility = Visibility.Collapsed
ItemOptiFine.Visibility = Visibility.Collapsed ItemOptiFine.Visibility = Visibility.Collapsed
ItemNeoForge.Visibility = Visibility.Collapsed
ItemFabric.Visibility = Visibility.Collapsed ItemFabric.Visibility = Visibility.Collapsed
ItemForge.Visibility = Visibility.Collapsed ItemForge.Visibility = Visibility.Collapsed
ItemLiteLoader.Visibility = Visibility.Collapsed ItemLiteLoader.Visibility = Visibility.Collapsed
RunInThread(Sub() RunInThread(
Thread.Sleep(20) Sub()
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True)) Thread.Sleep(20)
AniControlEnabled -= 1 RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
End Sub) AniControlEnabled -= 1
End Sub)
End Sub End Sub
End Class End Class
@@ -38,7 +38,7 @@
PanMain.Children.Add(NewCard) PanMain.Children.Add(NewCard)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback) Log(ex, "可视化 LiteLoader 版本列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
@@ -33,6 +33,8 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <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: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="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" /> <local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
@@ -40,12 +40,14 @@
Visibility.Visible, Visibility.Collapsed) Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1 LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1 BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2) BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0 BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2) BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal Storage.Results.Count > PageSize * (Page + 1) OrElse
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2) Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息 '错误信息
If Storage.ErrorMessage Is Nothing Then If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed HintError.Visibility = Visibility.Collapsed
@@ -89,11 +91,12 @@
Page = NewPage Page = NewPage
FrmMain.BackToTop() FrmMain.BackToTop()
Log($"[Download] Mod 切换到第 {Page + 1} 页") Log($"[Download] Mod 切换到第 {Page + 1} 页")
RunInThread(Sub() RunInThread(
Thread.Sleep(100) '等待向上滚的动画结束 Sub()
RunInUi(Sub() CardPages.IsEnabled = True) Thread.Sleep(100) '等待向上滚的动画结束
Loader.Start() RunInUi(Sub() CardPages.IsEnabled = True)
End Sub) Loader.Start()
End Sub)
End Sub End Sub
#Region "搜索" #Region "搜索"
@@ -0,0 +1,27 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadNeoForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.19+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
EventType="打开网页" EventData="https://neoforged.net/" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 NeoForge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,34 @@
Public Class PageDownloadNeoForge
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlNeoForgeListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict = DlNeoForgeListLoader.Output.Value.GroupBy(Function(d) d.Inherit).OrderByDescending(Function(g) g.Key).
ToDictionary(Function(g) g.Key, Function(g) g.ToList())
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlNeoForgeListEntry)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 13}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
End Class
@@ -13,7 +13,7 @@
'归类 '归类
Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry)) Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry))
Dict.Add("快照版本", New List(Of DlOptiFineListEntry)) Dict.Add("快照版本", New List(Of DlOptiFineListEntry))
For VersionCode As Integer = 30 To 0 Step -1 For VersionCode As Integer = 50 To 0 Step -1
Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry)) Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry))
Next Next
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
@@ -42,14 +42,10 @@
PanMain.Children.Add(NewCard) PanMain.Children.Add(NewCard)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback) Log(ex, "可视化 OptiFine 版本列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadOptiFine(sender.Tag)
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/") OpenWebsite("https://www.optifine.net/")
End Sub End Sub
@@ -32,6 +32,8 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <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:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" /> <local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
@@ -59,7 +61,7 @@
<local:MyComboBoxItem Tag="4472/technology" Content="科技" /> <local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" /> <local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" /> <local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" /> <local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" /> <local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" /> <local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" /> <local:MyComboBoxItem Tag="4471/" Content="科幻" />
@@ -39,12 +39,14 @@
Visibility.Visible, Visibility.Collapsed) Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1 LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1 BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2) BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0 BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2) BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal Storage.Results.Count > PageSize * (Page + 1) OrElse
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2) Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息 '错误信息
If Storage.ErrorMessage Is Nothing Then If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed HintError.Visibility = Visibility.Collapsed
@@ -241,7 +241,8 @@ Retry:
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"}, {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"}, {"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}, {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"} {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}
} }
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes") For Each Cape In SkinData("capes")
@@ -21,6 +21,27 @@
'加载版本 '加载版本
RunInNewThread( RunInNewThread(
Sub() Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
'确认自动安装
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Setup.Set("LaunchFolderSelect", "$.minecraft\")
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If
End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +56,27 @@
End If End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder) Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Dim InstallLoader = ModpackInstall(PackInstallPath)
If InstallLoader Is Nothing Then
Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
Else
Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
End If
End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Selection = "" Then If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本 '无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing Version = Nothing
@@ -619,7 +650,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本") Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载" FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候" FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1 Case 1
@@ -27,15 +27,16 @@
''' 刷新自定义主页。 ''' 刷新自定义主页。
''' </summary> ''' </summary>
Private Sub Refresh() Handles Me.Loaded Private Sub Refresh() Handles Me.Loaded
RunInNewThread(Sub() RunInNewThread(
Try Sub()
SyncLock RefreshLock Try
RefreshReal() SyncLock RefreshLock
End SyncLock RefreshReal()
Catch ex As Exception End SyncLock
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox) Catch ex As Exception
End Try Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Sub, $"刷新自定义主页 #{GetUuid()}") End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub End Sub
Private Sub RefreshReal() Private Sub RefreshReal()
Dim Content As String = "" Dim Content As String = ""
@@ -155,7 +156,6 @@ Download:
Else Else
Log(ex, $"联网下载自定义主页失败({Address})") Log(ex, $"联网下载自定义主页失败({Address})")
End If End If
Address = ""
End Try End Try
End Sub End Sub
@@ -204,7 +204,7 @@ Download:
End If End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>" Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content) Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI,最终内容长度:{Content.Count}") Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Try Try
PanCustom.Children.Add(GetObjectFromXML(Content)) PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception Catch ex As Exception
@@ -71,9 +71,9 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))) OpenWebsite(If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")))
Else Else
Dim Website As String = If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) Dim Website As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot")) OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If End If
End Sub End Sub
@@ -58,19 +58,21 @@
Hint("正在尝试更换,请稍候!") Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存 Setup.Set("CacheAuthUuid", "") '清空选择缓存
Setup.Set("CacheAuthName", "") Setup.Set("CacheAuthName", "")
RunInThread(Sub() RunInThread(
Try Sub()
Dim Data As McLoginServer = GetLoginData() Try
Data.ForceReselectProfile = True Dim Data As McLoginServer = GetLoginData()
McLoginLoader.WaitForExit(Data, IsForceRestart:=True) Data.ForceReselectProfile = True
RunInUi(Sub() Reload(True)) McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
Catch ex As Exception RunInUi(Sub() Reload(True))
Log(ex, "更换角色失败", LogLevel.Hint) Catch ex As Exception
End Try Log(ex, "更换角色失败", LogLevel.Hint)
End Sub) End Try
End Sub)
End Sub End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "") Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "")
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -39,14 +39,15 @@
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")}
Dim Result As McLoginMs = Nothing Dim Result As McLoginMs = Nothing
RunInUiWait(Sub() RunInUiWait(
If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then Sub()
Result = New McLoginMs If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then
Else Result = New McLoginMs
Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem Else
Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title} Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem
End If Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title}
End Sub) End If
End Sub)
Return Result Return Result
End Function End Function
''' <summary> ''' <summary>
@@ -29,7 +29,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
</Image> </Image>
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.net/a/LTCat" /> <local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" /> <local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
@@ -55,7 +55,7 @@
<local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" /> <local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" />
<local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" /> <local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" />
<local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" /> <local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" />
<local:MyListItem Title="DoodleHuang" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了部分很难找到的 Minecraft 版本与一些技术支持!" Grid.Row="3" Grid.Column="1" /> <local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 中国 Mod 下载镜像源和帮助库图床!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" /> <local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" />
<local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" /> <local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" />
<local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" /> <local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" />
@@ -75,7 +75,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
</Image> </Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/DoodleHuang.png" Grid.Row="3" Margin="3"> <Image Source="/Plain Craft Launcher 2;component/Images/Heads/z0z0r4.png" Grid.Row="3" Margin="3">
<Image.Clip> <Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
@@ -104,138 +104,91 @@
</local:MyCard> </local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者"> <local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,10,20"> <StackPanel Margin="25,40,10,20">
<TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 4 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" /> <TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 7 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <WrapPanel Margin="0,0,0,10">
<TextBlock Width="120" Margin="0,1.5" Text="道士师傅" /> <TextBlock Width="120" Margin="0,1.5" Text="nemonemo" />
<TextBlock Width="120" Margin="0,1.5" Text="狗群主群狗" /> <TextBlock Width="120" Margin="0,1.5" Text="矢坕" />
<TextBlock Width="120" Margin="0,1.5" Text="Alioth陳" /> <TextBlock Width="120" Margin="0,1.5" Text="梁景瑜" />
<TextBlock Width="120" Margin="0,1.5" Text="shyzysa" /> <TextBlock Width="120" Margin="0,1.5" Text="GhostZiLie" />
<TextBlock Width="120" Margin="0,1.5" Text="死んだライオン" /> <TextBlock Width="120" Margin="0,1.5" Text="靈曦蠡醯" />
<TextBlock Width="120" Margin="0,1.5" Text="mc沙漠之狐隆帅" /> <TextBlock Width="120" Margin="0,1.5" Text="zzdr" />
<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="zkQkWyQkz" />
<TextBlock Width="120" Margin="0,1.5" Text="毛哥" /> <TextBlock Width="120" Margin="0,1.5" Text="fill" />
<TextBlock Width="120" Margin="0,1.5" Text="leon" /> <TextBlock Width="120" Margin="0,1.5" Text="法老" />
<TextBlock Width="120" Margin="0,1.5" Text="clnb" /> <TextBlock Width="120" Margin="0,1.5" Text="aleafsautumn" />
<TextBlock Width="120" Margin="0,1.5" Text="123" /> <TextBlock Width="120" Margin="0,1.5" Text="聪明的凉生" />
<TextBlock Width="120" Margin="0,1.5" Text="lihaoran0313" /> <TextBlock Width="120" Margin="0,1.5" Text="干嘛1337" />
<TextBlock Width="120" Margin="0,1.5" Text="贵友" /> <TextBlock Width="120" Margin="0,1.5" Text="dlxw4" />
<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="皓垣Faraway" /> <TextBlock Width="120" Margin="0,1.5" Text="Raper_Sulin" />
<TextBlock Width="120" Margin="0,1.5" Text="冷月溪影" /> <TextBlock Width="120" Margin="0,1.5" Text="vv" />
<TextBlock Width="120" Margin="0,1.5" Text="狮青椒" /> <TextBlock Width="120" Margin="0,1.5" Text="QuinnL" />
<TextBlock Width="120" Margin="0,1.5" Text="多金的爸爸" /> <TextBlock Width="120" Margin="0,1.5" Text="pigeno" />
<TextBlock Width="120" Margin="0,1.5" Text="陈师傅" /> <TextBlock Width="120" Margin="0,1.5" Text="whx61" />
<TextBlock Width="120" Margin="0,1.5" Text="王舒心" /> <TextBlock Width="120" Margin="0,1.5" Text="peoprem" />
<TextBlock Width="120" Margin="0,1.5" Text="Akn123" /> <TextBlock Width="120" Margin="0,1.5" Text="慕言" />
<TextBlock Width="120" Margin="0,1.5" Text="Dfkeit" /> <TextBlock Width="120" Margin="0,1.5" Text="白雾云-白少" />
<TextBlock Width="120" Margin="0,1.5" Text="CloudLonngLee" /> <TextBlock Width="120" Margin="0,1.5" Text="S0CK" />
<TextBlock Width="120" Margin="0,1.5" Text="别再错过月亮了" /> <TextBlock Width="120" Margin="0,1.5" Text="1111" />
<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="GT" /> <TextBlock Width="120" Margin="0,1.5" Text="DsxiaKsxia" />
<TextBlock Width="120" Margin="0,1.5" Text="夜也" /> <TextBlock Width="120" Margin="0,1.5" Text="lucca" />
<TextBlock Width="120" Margin="0,1.5" Text="is步行街" /> <TextBlock Width="120" Margin="0,1.5" Text="时酱" />
<TextBlock Width="120" Margin="0,1.5" Text="狮心人面人" /> <TextBlock Width="120" Margin="0,1.5" Text="666a" />
<TextBlock Width="120" Margin="0,1.5" Text="小刀李" /> <TextBlock Width="120" Margin="0,1.5" Text="Rigilkent" />
<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="SYF" /> <TextBlock Width="120" Margin="0,1.5" Text="king" />
<TextBlock Width="120" Margin="0,1.5" Text="帝王尬笑" /> <TextBlock Width="120" Margin="0,1.5" Text="zzhm" />
<TextBlock Width="120" Margin="0,1.5" Text="DarkKCat" /> <TextBlock Width="120" Margin="0,1.5" Text="半自动M9716" />
<TextBlock Width="120" Margin="0,1.5" Text="我将如闪电般归来" /> <TextBlock Width="120" Margin="0,1.5" Text="MMIAO780" />
<TextBlock Width="120" Margin="0,1.5" Text="TSLOLY" /> <TextBlock Width="120" Margin="0,1.5" Text="7930" />
<TextBlock Width="120" Margin="0,1.5" Text="JackX" /> <TextBlock Width="120" Margin="0,1.5" Text="Jedro" />
<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="a酱" />
<TextBlock Width="120" Margin="0,1.5" Text="ムーの小雨" /> <TextBlock Width="240" Margin="0,1.5" Text="Pedlar Mayweather" />
<TextBlock Width="120" Margin="0,1.5" Text="潘某" /> <TextBlock Width="120" Margin="0,1.5" Text="Daddy江" />
<TextBlock Width="120" Margin="0,1.5" Text="颐葭" /> <TextBlock Width="120" Margin="0,1.5" Text="汣魰" />
<TextBlock Width="120" Margin="0,1.5" Text="Vaincre_VV" /> <TextBlock Width="120" Margin="0,1.5" Text="lawaass" />
<TextBlock Width="120" Margin="0,1.5" Text="小明爱睡觉" /> <TextBlock Width="120" Margin="0,1.5" Text="scz" />
<TextBlock Width="120" Margin="0,1.5" Text="YHLin" /> <TextBlock Width="120" Margin="0,1.5" Text="tiredl" />
<TextBlock Width="120" Margin="0,1.5" Text="翁yy" /> <TextBlock Width="120" Margin="0,1.5" Text="Jeffy0314" />
<TextBlock Width="120" Margin="0,1.5" Text="午睡不爱睡觉" /> <TextBlock Width="120" Margin="0,1.5" Text="青云一梦" />
<TextBlock Width="120" Margin="0,1.5" Text="tanglin" /> <TextBlock Width="120" Margin="0,1.5" Text="摸鱼大湿" />
<TextBlock Width="120" Margin="0,1.5" Text="Quittskii" /> <TextBlock Width="120" Margin="0,1.5" Text="PIGEON" />
<TextBlock Width="120" Margin="0,1.5" Text="W2erty" /> <TextBlock Width="120" Margin="0,1.5" Text="Redio" />
<TextBlock Width="120" Margin="0,1.5" Text="Chris_Dream" /> <TextBlock Width="120" Margin="0,1.5" Text="无垠星海" />
<TextBlock Width="120" Margin="0,1.5" Text="sanrenxin" /> <TextBlock Width="120" Margin="0,1.5" Text="Z10" />
<TextBlock Width="120" Margin="0,1.5" Text="BBK" /> <TextBlock Width="120" Margin="0,1.5" Text="嗯哼" />
<TextBlock Width="120" Margin="0,1.5" Text="京北的洋" /> <TextBlock Width="120" Margin="0,1.5" Text="_Ejvy" />
<TextBlock Width="120" Margin="0,1.5" Text="喵木仔" /> <TextBlock Width="120" Margin="0,1.5" Text="LG.神梦" />
<TextBlock Width="120" Margin="0,1.5" Text="abstudio" /> <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="tianguaren" /> <TextBlock Width="120" Margin="0,1.5" Text="qianlan" />
<TextBlock Width="120" Margin="0,1.5" Text="bitlogi" /> <TextBlock Width="120" Margin="0,1.5" Text="dndjkdkdms" />
<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="Kkigoo" /> <TextBlock Width="120" Margin="0,1.5" Text="小比登T^T" />
<TextBlock Width="120" Margin="0,1.5" Text="于书墨" /> <TextBlock Width="120" Margin="0,1.5" Text="北川兔兔" />
<TextBlock Width="120" Margin="0,1.5" Text="御坂1354号" /> <TextBlock Width="120" Margin="0,1.5" Text="q_q!!!" />
<TextBlock Width="120" Margin="0,1.5" Text="t7fihb8" /> <TextBlock Width="120" Margin="0,1.5" Text="eric" />
<TextBlock Width="120" Margin="0,1.5" Text="44.5GB" /> <TextBlock Width="120" Margin="0,1.5" Text="Min" />
<TextBlock Width="120" Margin="0,1.5" Text="寰宇第一激推希儿" /> <TextBlock Width="120" Margin="0,1.5" Text="JTOPfujo》" />
<TextBlock Width="120" Margin="0,1.5" Text="拳打羽酱脚踢军师" /> <TextBlock Width="120" Margin="0,1.5" Text="CZALIZI" />
<TextBlock Width="120" Margin="0,1.5" Text="戌亥ピカ" /> <TextBlock Width="120" Margin="0,1.5" Text="outsider" />
<TextBlock Width="120" Margin="0,1.5" Text="乔巴诺" /> <TextBlock Width="120" Margin="0,1.5" Text="Kimmo" />
<TextBlock Width="120" Margin="0,1.5" Text="LING-DIAN" /> <TextBlock Width="120" Margin="0,1.5" Text="超爱居居巧" />
<TextBlock Width="120" Margin="0,1.5" Text="你太迷人" /> <TextBlock Width="120" Margin="0,1.5" Text="quin22" />
<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="chsero" />
<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="Thankscrazy" />
<TextBlock Width="120" Margin="0,1.5" Text="我的神a啊" />
<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="zzyd" />
<TextBlock Width="120" Margin="0,1.5" Text="御影" />
<TextBlock Width="120" Margin="0,1.5" Text="Xephyrs" />
<TextBlock Width="120" Margin="0,1.5" Text="Sovtheia" />
<TextBlock Width="120" Margin="0,1.5" Text="CRANK" />
<TextBlock Width="120" Margin="0,1.5" Text="本太子的作业满天飞" />
<TextBlock Width="120" Margin="0,1.5" Text="超级无敌旋风小猪猪" />
<TextBlock Width="120" Margin="0,1.5" Text="泽希尔·S+" />
<TextBlock Width="120" Margin="0,1.5" Text="erliang_ya" />
<TextBlock Width="120" Margin="0,1.5" Text="明酱酱" />
<TextBlock Width="120" Margin="0,1.5" Text="玐煲粥" />
<TextBlock Width="120" Margin="0,1.5" Text="The_follow" />
<TextBlock Width="120" Margin="0,1.5" Text="王八" />
<TextBlock Width="120" Margin="0,1.5" Text="joker" />
<TextBlock Width="120" Margin="0,1.5" Text="north-cool" />
<TextBlock Width="120" Margin="0,1.5" Text="JJ" />
<TextBlock Width="120" Margin="0,1.5" Text="小石" />
<TextBlock Width="120" Margin="0,1.5" Text="XiaomQ928" />
<TextBlock Width="120" Margin="0,1.5" Text="Fly with You!!" />
<TextBlock Width="120" Margin="0,1.5" Text="海上乘鲸客" />
<TextBlock Width="120" Margin="0,1.5" Text="miku" />
<TextBlock Width="120" Margin="0,1.5" Text="小雯" />
<TextBlock Width="120" Margin="0,1.5" Text="woainad" />
<TextBlock Width="120" Margin="0,1.5" Text="wqaycm" />
<TextBlock Width="120" Margin="0,1.5" Text="白豆" />
<TextBlock Width="120" Margin="0,1.5" Text="Alex" />
<TextBlock Width="120" Margin="0,1.5" Text="大地风暴" />
<TextBlock Width="120" Margin="0,1.5" Text="曾and田某人" />
<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="ElliottZChan" />
<TextBlock Width="120" Margin="0,1.5" Text="沐子冷落" />
<TextBlock Width="120" Margin="0,1.5" Text="_Blessing" />
<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="n3v3r" />
<TextBlock Width="120" Margin="0,1.5" Text="七星灯" />
<TextBlock Width="120" Margin="0,1.5" Text="Theia" />
</WrapPanel> </WrapPanel>
<Grid Height="35"> <Grid Height="35">
@@ -245,7 +198,7 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" /> <local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.net/a/LTCat" /> <local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid> </Grid>
@@ -254,12 +207,12 @@
<local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True"> <local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True">
<StackPanel Margin="25,39,23,20"> <StackPanel Margin="25,39,23,20">
<TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" /> <TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件会汇报自己的版本名与版本号,以统计用户数量与各版本的用户数量占比。除此之外,本软件不会上传您的任何信息。&#13;若您能提供未经外部修改的本软件本体上传隐私信息的确凿证据,开发者会向您支付 PCL 开发所获全部净收入。" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件的 User Agent 中包含启动器的版本号,以统计各版本的用户数量。&#13;除此之外,本软件不会向开发者上传任何其他信息。" TextWrapping="Wrap" />
<TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" /> <TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:hexdragon@vip.qq.com" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:hexdragon@vip.qq.com&#13;非 MINECRAFT 官方产品。未经 MOJANG 或 MICROSOFT 批准,也不与 MOJANG 或 MICROSOFT 关联。" TextWrapping="Wrap" />
<StackPanel Orientation="Horizontal" Height="35" HorizontalAlignment="Left" Margin="0,12,0,0"> <StackPanel Orientation="Horizontal" Height="35" HorizontalAlignment="Left" Margin="0,12,0,0">
<local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" /> <local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" />
<local:MyButton Text="查看源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" /> <local:MyButton Text="开源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</StackPanel> </StackPanel>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -19,7 +19,7 @@
End Sub End Sub
Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click
OpenWebsite("https://afdian.net/a/bangbang93") OpenWebsite("https://afdian.com/a/bangbang93")
End Sub End Sub
Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click
OpenWebsite("https://www.mcmod.cn") OpenWebsite("https://www.mcmod.cn")
@@ -27,7 +27,7 @@
Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click
ClipboardSet(UniqueAddress) ClipboardSet(UniqueAddress)
End Sub End Sub
Private Sub DonateCodeInput() Handles BtnDonateInput.Click Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput() DonateCodeInput()
End Sub End Sub
@@ -38,17 +38,21 @@
CardName = "常规版本" CardName = "常规版本"
Case McVersionCardType.API Case McVersionCardType.API
Dim IsForgeExists As Boolean = False Dim IsForgeExists As Boolean = False
Dim IsNeoForgeExists As Boolean = False
Dim IsFabricExists As Boolean = False Dim IsFabricExists As Boolean = False
Dim IsLiteExists As Boolean = False Dim IsLiteExists As Boolean = False
For Each Version As McVersion In Card.Value For Each Version As McVersion In Card.Value
If Version.Version.HasFabric Then IsFabricExists = True If Version.Version.HasFabric Then IsFabricExists = True
If Version.Version.HasLiteLoader Then IsLiteExists = True If Version.Version.HasLiteLoader Then IsLiteExists = True
If Version.Version.HasForge Then IsForgeExists = True If Version.Version.HasForge Then IsForgeExists = True
If Version.Version.HasNeoForge Then IsNeoForgeExists = True
Next Next
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) > 1 Then If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then
CardName = "可安装 Mod" CardName = "可安装 Mod"
ElseIf IsForgeExists Then ElseIf IsForgeExists Then
CardName = "Forge 版本" CardName = "Forge 版本"
ElseIf IsNeoForgeExists Then
CardName = "NeoForge 版本"
ElseIf IsLiteExists Then ElseIf IsLiteExists Then
CardName = "LiteLoader 版本" CardName = "LiteLoader 版本"
Else Else
@@ -210,8 +214,8 @@
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub End Sub
'修改此代码时,同时修改 PageVersionOverall 中的代码
Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion) Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion)
'修改此代码时,同时修改 PageVersionOverall 中的代码
Try Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder
@@ -108,6 +108,7 @@
{"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -163,6 +164,7 @@
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)}, {"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)}, {"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)}, {"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)}, {"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)},
@@ -7,9 +7,9 @@
PanScroll="{Binding ElementName=PanBack}"> PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10"> <StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤"> <local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,25,15"> <StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,皮肤预览与 Steve/Alex/自定义 选项暂时仅保证对 1.19.2 以前的版本有效!" IsWarn="False" Margin="0,0,0,10" /> <local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" IsWarn="True" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0"> <Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition /> <ColumnDefinition />
@@ -206,10 +206,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12 SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25 SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49) SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If End If
'设置文本 '设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" & LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -259,7 +257,6 @@
End If End If
If RamTextLeft <> Left Then If RamTextLeft <> Left Then
RamTextLeft = Left RamTextLeft = Left
'If AniControlEnabled = 0 Then
Select Case Left Select Case Left
Case 0 Case 0
AniStart({ AniStart({
@@ -280,22 +277,6 @@
AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100) AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100)
}, "SetupLaunch Ram TextLeft") }, "SetupLaunch Ram TextLeft")
End Select End Select
'Else
' Select Case Left
' Case 0
' LabRamUsed.Opacity = 0
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0
' Case 1
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0.7
' Case 2
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 1
' LabRamUsedTitle.Opacity = 0.7
' End Select
'End If
End If End If
'右侧 '右侧
Dim Right As Integer Dim Right As Integer
@@ -404,15 +385,14 @@ PreFin:
RamGive = (Value - 12) * 0.5 + 1.5 RamGive = (Value - 12) * 0.5 + 1.5
ElseIf Value <= 33 Then ElseIf Value <= 33 Then
RamGive = (Value - 25) * 1 + 8 RamGive = (Value - 25) * 1 + 8
ElseIf Value <= 41 Then
RamGive = (Value - 33) * 2 + 16
Else Else
RamGive = (Value - 41) * 4 + 32 RamGive = (Value - 33) * 2 + 16
End If End If
End If End If
'若使用 32 位 Java,则限制为 1G '若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive) If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive)
Return RamGive '封顶 32G
Return Math.Min(32, RamGive)
End Function End Function
#End Region #End Region
@@ -557,8 +537,8 @@ PreFin:
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub If AniControlEnabled <> 0 Then Exit Sub
If Not CheckArgumentRam.Checked Then Return If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化耗时较长,这会拖慢游戏的启动过程,建议仅在电脑内存不充裕时开启此选项。" & vbCrLf & If MyMsgBox("内存优化会显著延长启动耗时,建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘,这还可能会导致一小段时间的严重卡顿。" & "如果你在使用机械硬盘,这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"), If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then "提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False CheckArgumentRam.Checked = False
@@ -20,6 +20,8 @@
<RowDefinition Height="7" /> <RowDefinition Height="7" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="7" /> <RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="27" /> <RowDefinition Height="27" />
<RowDefinition Height="27" /> <RowDefinition Height="27" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
@@ -31,32 +33,38 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1"> <local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" /> <local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" />
<local:MyComboBoxItem Content="在官方源加载缓慢时改用镜像源(平衡)" /> <local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本为最新,但加载非常缓慢)" /> <local:MyComboBoxItem Content="尽量使用官方源(保证版本最新,但加载缓慢)" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 命名风格" Margin="0,0,25,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 信息获取" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="2" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1" <local:MyComboBox x:Name="ComboDownloadMod" Grid.Row="2" Grid.ColumnSpan="2" Tag="ToolDownloadMod" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源" IsSelected="True" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 命名风格" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="4" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1"
ToolTip="决定下载的 Mod 的默认文件名中,中文译名应该放在哪个位置"> ToolTip="决定下载的 Mod 的默认文件名中,中文译名应该放在哪个位置">
<local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" /> <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:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" />
<local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" /> <local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" /> <TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="4" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1" <local:MySlider x:Name="SliderDownloadThread" Grid.Row="6" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" /> ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" />
<TextBlock VerticalAlignment="Center" Grid.Row="5" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="7" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1" <local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="7" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" /> ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" /> <TextBlock VerticalAlignment="Top" Grid.Row="9" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" /> <TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="9" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" />
<local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="10" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack" x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" /> ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" />
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="11" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt" x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" /> ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="12" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert" x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" /> ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" />
</Grid> </Grid>
@@ -93,7 +101,8 @@
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="9" /> <RowDefinition Height="9" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="9" /> <RowDefinition Height="5" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" />
@@ -116,15 +125,23 @@
<local:ValidateFolderPath UseMinecraftCharCheck="False" /> <local:ValidateFolderPath UseMinecraftCharCheck="False" />
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,5,0,0"> <Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,12,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="1" x:Name="BtnSystemSettingExp" MinWidth="140" Text="导出设置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="2" x:Name="BtnSystemSettingImp" MinWidth="140" Text="导入设置" Padding="13,0" Margin="0,0,20,0" />
</Grid>
<Grid Height="35" Grid.Row="7" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
</Grid> </Grid>
</Grid> </Grid>
</local:MyCard> </local:MyCard>
@@ -35,7 +35,10 @@
'重复加载部分 '重复加载部分
PanBack.ScrollToHome() PanBack.ScrollToHome()
#If Not BETA Then #If BETA Then
PanDonate.Visibility = Visibility.Collapsed
#Else
PanDonate.Visibility = Visibility.Visible
ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)" ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)"
#End If #End If
@@ -56,6 +59,7 @@
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed") SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion") ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion")
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate") ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack") CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert") CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert")
@@ -90,6 +94,7 @@
Setup.Reset("ToolDownloadKeepModpack") Setup.Reset("ToolDownloadKeepModpack")
Setup.Reset("ToolDownloadIgnoreQuilt") Setup.Reset("ToolDownloadIgnoreQuilt")
Setup.Reset("ToolDownloadCert") Setup.Reset("ToolDownloadCert")
Setup.Reset("ToolDownloadMod")
Setup.Reset("ToolUpdateRelease") Setup.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot") Setup.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese") Setup.Reset("ToolHelpChinese")
@@ -117,7 +122,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change 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) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadMod.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
@@ -212,4 +217,15 @@
End Try End Try
End Function End Function
#Region "导出 / 导入设置"
Private Sub BtnSystemSettingExp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingExp.Click
Hint("该功能尚在开发中!")
End Sub
Private Sub BtnSystemSettingImp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingImp.Click
Hint("该功能尚在开发中!")
End Sub
#End Region
End Class End Class
@@ -41,8 +41,8 @@
'设置解锁 '设置解锁
If Not RadioLauncherTheme8.IsEnabled Then LabLauncherTheme8Copy.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁。" & vbCrLf & "右键打开赞助页面,如果觉得 PCL 做得还不错就支持一下吧 =w=!" If Not RadioLauncherTheme8.IsEnabled Then LabLauncherTheme8Copy.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁。" & vbCrLf & "右键打开赞助页面,如果觉得 PCL 做得还不错就支持一下吧 =w=!"
RadioLauncherTheme8.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁" RadioLauncherTheme8.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在 Issue 标记为 [已完成] 后回复 Issue 要求解锁(右键打开反馈页面)" & vbCrLf & "· 向帮助库提交 Pull Request,在龙猫合并后解锁" If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁(右键打开反馈页面)" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在反馈标记为 [完成] 后回复 Issue 要求解锁" & vbCrLf & "· 向帮助库提交 Pull Request,在龙猫合并后解锁" RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
'极客蓝的处理在 ThemeCheck 中 '极客蓝的处理在 ThemeCheck 中
End Sub End Sub
@@ -83,7 +83,11 @@
MusicRefreshUI() MusicRefreshUI()
'主页 '主页
ComboCustomPreset.SelectedIndex = Setup.Get("UiCustomPreset") Try
ComboCustomPreset.SelectedIndex = Setup.Get("UiCustomPreset")
Catch
Setup.Reset("UiCustomPreset")
End Try
CType(FindName("RadioCustomType" & Setup.Load("UiCustomType")), MyRadioBox).Checked = True CType(FindName("RadioCustomType" & Setup.Load("UiCustomType")), MyRadioBox).Checked = True
TextCustomNet.Text = Setup.Get("UiCustomNet") TextCustomNet.Text = Setup.Get("UiCustomNet")
@@ -360,27 +364,28 @@ Refresh:
End Sub End Sub
Private Sub BtnMusicClear_Click(sender As Object, e As EventArgs) Handles BtnMusicClear.Click Private Sub BtnMusicClear_Click(sender As Object, e As EventArgs) Handles BtnMusicClear.Click
If MyMsgBox("即将删除背景音乐文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then If MyMsgBox("即将删除背景音乐文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
RunInThread(Sub() RunInThread(
Hint("正在删除背景音乐……") Sub()
'停止播放音乐 Hint("正在删除背景音乐……")
MusicNAudio = Nothing '停止播放音乐
MusicWaitingList = New List(Of String) MusicNAudio = Nothing
MusicAllList = New List(Of String) MusicWaitingList = New List(Of String)
Thread.Sleep(200) MusicAllList = New List(Of String)
'删除文件 Thread.Sleep(200)
Try '删除文件
DeleteDirectory(Path & "PCL\Musics") Try
Hint("背景音乐已删除!", HintType.Finish) DeleteDirectory(Path & "PCL\Musics")
Catch ex As Exception Hint("背景音乐已删除!", HintType.Finish)
Log(ex, "删除背景音乐失败", LogLevel.Msgbox) Catch ex As Exception
End Try Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
Try End Try
Directory.CreateDirectory(Path & "PCL\Musics") Try
RunInUi(Sub() MusicRefreshPlay(False)) Directory.CreateDirectory(Path & "PCL\Musics")
Catch ex As Exception RunInUi(Sub() MusicRefreshPlay(False))
Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox) Catch ex As Exception
End Try Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox)
End Sub) End Try
End Sub)
End If End If
End Sub End Sub
Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change
@@ -423,9 +428,9 @@ Refresh:
RadioLauncherTheme5Gray.Opacity -= 0.23 RadioLauncherTheme5Gray.Opacity -= 0.23
RadioLauncherTheme5.Opacity += 0.23 RadioLauncherTheme5.Opacity += 0.23
AniStart({ AniStart({
AaOpacity(RadioLauncherTheme5Gray, 1, 1000), AaOpacity(RadioLauncherTheme5Gray, 1, 1000),
AaOpacity(RadioLauncherTheme5, -1, 1000) AaOpacity(RadioLauncherTheme5, -1, 1000)
}, "ThemeUnlock") }, "ThemeUnlock")
If RadioLauncherTheme5Gray.Opacity < 0.08 Then If RadioLauncherTheme5Gray.Opacity < 0.08 Then
ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!") ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!")
AniStop("ThemeUnlock") AniStop("ThemeUnlock")
@@ -433,7 +438,7 @@ Refresh:
End If End If
End Sub End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse LabLauncherTheme11Click.ToolTip.ToString.Contains("点击") Then If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then
If MyMsgBox( If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf & "1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf & "2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
@@ -446,7 +451,7 @@ Refresh:
End If End If
End Sub End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End Sub End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
PageOtherLeft.TryFeedback() PageOtherLeft.TryFeedback()
@@ -659,23 +664,15 @@ Refresh:
'公开预览版 '公开预览版
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End Sub End Sub
'滑动条 '滑动条
Private Sub SliderLoad() Private Sub SliderLoad()
SliderMusicVolume.GetHintText = Function(Value As Integer) SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%"
Return Math.Ceiling(Value * 0.1) & "%" SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
End Function SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherOpacity.GetHintText = Function(Value As Integer) SliderLauncherSat.GetHintText = Function(v) v & "%"
Return Math.Round(40 + Value * 0.1) & "%"
End Function
SliderLauncherHue.GetHintText = Function(Value As Integer)
Return Value & "°"
End Function
SliderLauncherSat.GetHintText = Function(Value As Integer)
Return Value & "%"
End Function
SliderLauncherDelta.GetHintText = Function(Value As Integer) SliderLauncherDelta.GetHintText = Function(Value As Integer)
If Value > 90 Then If Value > 90 Then
Return "+" & (Value - 90) Return "+" & (Value - 90)
@@ -694,12 +691,8 @@ Refresh:
Return Value - 20 Return Value - 20
End If End If
End Function End Function
SliderBackgroundOpacity.GetHintText = Function(Value As Integer) SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%"
Return Math.Round(Value * 0.1) & "%" SliderBackgroundBlur.GetHintText = Function(v) v & " 像素"
End Function
SliderBackgroundBlur.GetHintText = Function(Value As Integer)
Return Value & " 像素"
End Function
End Sub End Sub
End Class End Class
@@ -60,11 +60,9 @@ Public Class PageSpeedLeft
End Try End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try Try
SyncLock LoaderTaskbarLock For Each Loader In LoaderTaskbar.ToList
For Each Loader In LoaderTaskbar.ToList TaskRefresh(Loader)
TaskRefresh(Loader) Next
Next
End SyncLock
Catch ex As Exception Catch ex As Exception
Log(ex, "下载管理右栏监视出错", LogLevel.Feedback) Log(ex, "下载管理右栏监视出错", LogLevel.Feedback)
End Try End Try
@@ -197,13 +195,11 @@ Public Class PageSpeedLeft
Sub(sender As MyIconButton, e As EventArgs) Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False) AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name) Dim LoaderName = If(Loader Is Nothing, "null", Loader.Name)
SyncLock LoaderTaskbarLock RightCards.Remove(LoaderName)
LoaderTaskbar.Remove(Loader) LoaderTaskbar.TryTake(Loader)
Log($"[Taskbar] 由于下载管理卡片关闭,{Loader.Name} 已移出任务列表") Log($"[Taskbar] 关闭下载管理卡片:{LoaderName},且移出任务列表")
End SyncLock RunInThread(Sub() Loader?.Abort())
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort())
End Sub End Sub
'如果已经失败,再刷新一次,修改成失败的控件 '如果已经失败,再刷新一次,修改成失败的控件
If Loader.State = LoadState.Failed Then If Loader.State = LoadState.Failed Then
@@ -7,7 +7,8 @@
<Grid> <Grid>
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10,25,10" Grid.IsSharedSizeScope="True"> <!-- 若显示多选模块则为 92 --> <StackPanel x:Name="PanMain" Margin="25,10,25,10" Grid.IsSharedSizeScope="True">
<!-- 若显示多选模块则为 92 -->
<local:MySearchBox Margin="0,15" HintText="搜索 Mod 名称 / 描述 / 标签" x:Name="SearchBox" /> <local:MySearchBox Margin="0,15" HintText="搜索 Mod 名称 / 描述 / 标签" x:Name="SearchBox" />
<local:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage"> <local:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage">
<Grid Margin="15,15,0,15" Height="35"> <Grid Margin="15,15,0,15" Height="35">
@@ -24,6 +25,17 @@
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,15" Title=" " MinHeight="40"> <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,15" Title=" " MinHeight="40">
<StackPanel Margin="0,8,9,0" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Right" Height="24">
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="全部" x:Name="BtnTypeAll" ColorType="Highlight" Checked="True"/>
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="已启用" x:Name="BtnTypeEnabled" ColorType="Highlight"/>
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="已禁用" x:Name="BtnTypeDisabled" ColorType="Highlight"/>
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="可更新" x:Name="BtnTypeCanUpdate" ColorType="Highlight"/>
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="错误" x:Name="BtnTypeError" ColorType="Highlight"/>
</StackPanel>
<StackPanel Margin="20,38,18,18" Name="PanList" VerticalAlignment="Top" /> <StackPanel Margin="20,38,18,18" Name="PanList" VerticalAlignment="Top" />
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
@@ -4,6 +4,11 @@
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
Public Sub PageOther_Loaded() Handles Me.Loaded Public Sub PageOther_Loaded() Handles Me.Loaded
BtnTypeAll.Tag = ViewType.All
BtnTypeEnabled.Tag = ViewType.Enabled
BtnTypeDisabled.Tag = ViewType.Disabled
BtnTypeCanUpdate.Tag = ViewType.CanUpdate
BtnTypeError.Tag = ViewType.InError
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome() If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1 AniControlEnabled += 1
@@ -27,6 +32,8 @@
Public Sub RefreshList(Optional ForceReload As Boolean = False) Public Sub RefreshList(Optional ForceReload As Boolean = False)
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表") Log("[System] 已刷新 Mod 列表")
ViewModType = ViewType.All
BtnTypeAll.Checked = True
PanBack.ScrollToHome() PanBack.ScrollToHome()
SearchBox.Text = "" SearchBox.Text = ""
End If End If
@@ -125,33 +132,81 @@
''' 刷新结果显示。 ''' 刷新结果显示。
''' </summary> ''' </summary>
Private Sub RefreshResult(Mods As List(Of McMod)) Private Sub RefreshResult(Mods As List(Of McMod))
If PanList Is Nothing Then Exit Sub
Dim ShowMods As List(Of McMod) = New List(Of McMod)
Select Case ViewModType
Case ViewType.All
ShowMods = Mods
Case ViewType.Enabled
For Each Item In Mods
If Item.State.Equals(McMod.McModState.Fine) Then ShowMods.Add(Item)
Next
Case ViewType.Disabled
For Each Item In Mods
If Item.State.Equals(McMod.McModState.Disabled) Then ShowMods.Add(Item)
Next
Case ViewType.CanUpdate
For Each Item In Mods
If Item.CanUpdate Then ShowMods.Add(Item)
Next
Case ViewType.InError
For Each Item In Mods
If Item.State.Equals(McMod.McModState.Unavaliable) Then ShowMods.Add(Item)
Next
End Select
PanList.Children.Clear() PanList.Children.Clear()
For Each TargetMod In Mods For Each TargetMod In ShowMods
PanList.Children.Add(ModItems(TargetMod.RawFileName)) PanList.Children.Add(ModItems(TargetMod.RawFileName))
Next Next
Dim ModEnabled As Integer = 0
Dim ModDisabled As Integer = 0
Dim ModCanUpdate As Integer = 0
Dim ModError As Integer = 0
For Each ModItem In ModItems
If ModItem.Value.Entry.CanUpdate Then
ModCanUpdate += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Fine) Then
ModEnabled += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Disabled) Then
ModDisabled += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Unavaliable) Then
ModError += 1
End If
Next
BtnTypeAll.Text = $"全部 ({ModEnabled + ModDisabled + ModError}) "
BtnTypeCanUpdate.Text = $"可更新 ({ModCanUpdate}) "
BtnTypeEnabled.Text = $"已启用 ({ModEnabled}) "
BtnTypeDisabled.Text = $"已禁用 ({ModDisabled}) "
BtnTypeError.Text = $"错误 ({ModError}) "
RefreshTitle() RefreshTitle()
End Sub End Sub
''' <summary> ''' <summary>
''' 刷新卡片标题。 ''' 刷新卡片标题。
''' </summary> ''' </summary>
Private Sub RefreshTitle() Private Sub RefreshTitle()
Dim Mods = PanList.Children.Cast(Of MyLocalModItem).Select(Function(i) i.Entry).ToList
Dim Counter = {0, 0, 0}
For Each ModEntity As McMod In Mods
Counter(ModEntity.State) += 1
Next
Dim TypeList As New List(Of String)
If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled))
If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable))
If Counter(McMod.McModState.Fine) > 0 Then TypeList.Insert(0, If(TypeList.Any, "启用 ", "") & Counter(McMod.McModState.Fine))
If Not IsSearching Then If Not IsSearching Then
PanListBack.Title = "Mod 列表 (" & Join(TypeList, ",") & ")" PanListBack.Title = "Mod 列表 - "
ElseIf TypeList.Any() Then ElseIf PanList.Children.Count > 0 Then
PanListBack.Title = "搜索结果 (" & Join(TypeList, ",") & ")" PanListBack.Title = "搜索结果 - "
Else Else
PanListBack.Title = "无搜索结果" PanListBack.Title = "无搜索结果 - "
End If End If
PanList.Visibility = If(Mods.Any(), Visibility.Visible, Visibility.Collapsed) Select Case ViewModType
Case ViewType.All
PanListBack.Title += BtnTypeAll.Text
Case ViewType.Enabled
PanListBack.Title += BtnTypeEnabled.Text
Case ViewType.Disabled
PanListBack.Title += BtnTypeDisabled.Text
Case ViewType.CanUpdate
PanListBack.Title += BtnTypeCanUpdate.Text
Case ViewType.InError
PanListBack.Title += BtnTypeError.Text
End Select
PanList.Visibility = If(PanList.Children.Count > 0, Visibility.Visible, Visibility.Collapsed)
End Sub End Sub
#End Region #End Region
@@ -192,10 +247,14 @@
''' 全选。 ''' 全选。
''' </summary> ''' </summary>
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
If SelectedMods.Count < PanList.Children.Count Then Dim CurrentSelected As Integer = 0
ChangeAllSelected(True) For Each Item In PanList.Children.OfType(Of MyLocalModItem).ToList
If Item.Checked Then CurrentSelected += 1
Next
If CurrentSelected < PanList.Children.Count Then
ChangeCurrentSelected(True)
Else Else
ChangeAllSelected(False) ChangeCurrentSelected(False)
End If End If
End Sub End Sub
@@ -229,7 +288,7 @@
'改变下边栏状态 '改变下边栏状态
Private ShownCount As Integer = 0 Private ShownCount As Integer = 0
Private Sub RefreshBottomBar() Public Sub RefreshBottomBar()
'计数 '计数
Dim NewCount As Integer = SelectedMods.Count Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0 Dim Selected = NewCount > 0
@@ -256,6 +315,7 @@
'更新显示状态 '更新显示状态
If AniControlEnabled = 0 Then If AniControlEnabled = 0 Then
If Selected Then If Selected Then
PanListBack.Margin = New Thickness(0, 0, 0, 95)
'仅在数量增加时播放出现/跳跃动画 '仅在数量增加时播放出现/跳跃动画
If ShownCount >= NewCount Then If ShownCount >= NewCount Then
ShownCount = NewCount ShownCount = NewCount
@@ -272,6 +332,7 @@
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)) AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar") }, "Mod Sidebar")
Else Else
PanListBack.Margin = New Thickness(0, 0, 0, 15)
'不重复播放隐藏动画 '不重复播放隐藏动画
If ShownCount = 0 Then Return If ShownCount = 0 Then Return
ShownCount = 0 ShownCount = 0
@@ -301,7 +362,7 @@
Private Sub ChangeAllSelected(Value As Boolean) Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1 AniControlEnabled += 1
SelectedMods.Clear() SelectedMods.Clear()
For Each Item As MyLocalModItem In PanList.Children For Each Item As MyLocalModItem In ModItems.Values.ToList
Item.Checked = Value Item.Checked = Value
If Value Then SelectedMods.Add(Item.Entry.RawFileName) If Value Then SelectedMods.Add(Item.Entry.RawFileName)
Next Next
@@ -309,6 +370,22 @@
'更新下边栏 UI '更新下边栏 UI
RefreshBottomBar() RefreshBottomBar()
End Sub End Sub
Private Sub ChangeCurrentSelected(Value As Boolean)
AniControlEnabled += 1
For Each Item As MyLocalModItem In PanList.Children
Item.Checked = Value
If Value Then
If Not SelectedMods.Contains(Item.Entry.RawFileName) Then SelectedMods.Add(Item.Entry.RawFileName)
Else
If SelectedMods.Contains(Item.Entry.RawFileName) Then SelectedMods.Remove(Item.Entry.RawFileName)
End If
Next
AniControlEnabled -= 1
'更新下边栏 UI
RefreshBottomBar()
End Sub
Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit
Dim CacheAniControlEnabled = AniControlEnabled Dim CacheAniControlEnabled = AniControlEnabled
AniControlEnabled = 0 AniControlEnabled = 0
@@ -316,7 +393,26 @@
AniControlEnabled += CacheAniControlEnabled AniControlEnabled += CacheAniControlEnabled
End Sub End Sub
Private Sub PageVersionMod_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Private Sub PageVersionMod_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If My.Computer.Keyboard.CtrlKeyDown AndAlso e.Key = Key.A Then ChangeAllSelected(True) If My.Computer.Keyboard.CtrlKeyDown AndAlso e.Key = Key.A Then ChangeCurrentSelected(True)
End Sub
Private ViewModType As ViewType = ViewType.All
Private Enum ViewType As Integer
All
Enabled
Disabled
CanUpdate
InError
End Enum
Private Sub ChangeViewType(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTypeAll.Check, BtnTypeCanUpdate.Check, BtnTypeDisabled.Check, BtnTypeEnabled.Check, BtnTypeError.Check
ViewModType = sender.Tag
If IsSearching Then
SearchRun()
Else
RefreshResult(McModLoader.Output)
End If
End Sub End Sub
#End Region #End Region
@@ -328,6 +424,7 @@
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)), EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)),
Not sender.Equals(BtnSelectDisable)) Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False) ChangeAllSelected(False)
RefreshResult(McModLoader.Output)
End Sub End Sub
Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean) Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True Dim IsSuccessful As Boolean = True
@@ -607,8 +704,10 @@
If ModEntry.Comp IsNot Nothing Then If ModEntry.Comp IsNot Nothing Then
'跳转到 Mod 下载页面 '跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName, .Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge, If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))}}) If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge,
If(PageVersionLeft.Version.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any)))}})
Else Else
'获取信息 '获取信息
Dim ContentLines As New List(Of String) Dim ContentLines As New List(Of String)
@@ -22,7 +22,7 @@
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock Grid.Row="0" Grid.ColumnSpan="4" Margin="0,0,0,9" HorizontalAlignment="Center" Text="该版本不可使用 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" /> <TextBlock Grid.Row="0" Grid.ColumnSpan="4" Margin="0,0,0,9" HorizontalAlignment="Center" Text="该版本不可使用 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle Grid.Row="1" Grid.ColumnSpan="4" HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" /> <Rectangle Grid.Row="1" Grid.ColumnSpan="4" HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge 或 Fabric 等 Mod 加载器才能使用 Mod,请在下载页面重新安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本,并注意 Forge 在版本选择列表中的图标为铁砧,Fabric 的图标为丝绸。" TextWrapping="Wrap" /> <TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge、Fabric 等 Mod 加载器才能使用 Mod,请在下载页面安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本。" TextWrapping="Wrap" />
<local:MyButton Grid.Row="3" Grid.Column="1" Height="35" HorizontalAlignment="Center" x:Name="BtnDownload" MinWidth="140" Text="转到下载页面" Margin="10,10,10,0" Padding="13,0" ColorType="Highlight" /> <local:MyButton Grid.Row="3" Grid.Column="1" Height="35" HorizontalAlignment="Center" x:Name="BtnDownload" MinWidth="140" Text="转到下载页面" Margin="10,10,10,0" Padding="13,0" ColorType="Highlight" />
<local:MyButton Grid.Row="3" Grid.Column="2" Height="35" HorizontalAlignment="Center" x:Name="BtnVersion" MinWidth="140" Text="版本选择" Margin="10,10,10,0" Padding="13,0" /> <local:MyButton Grid.Row="3" Grid.Column="2" Height="35" HorizontalAlignment="Center" x:Name="BtnVersion" MinWidth="140" Text="版本选择" Margin="10,10,10,0" Padding="13,0" />
</Grid> </Grid>
@@ -37,6 +37,7 @@
<local:MyComboBoxItem Content="红石灯(关)" Tag="pack://application:,,,/images/Blocks/RedstoneLampOff.png" /> <local:MyComboBoxItem Content="红石灯(关)" Tag="pack://application:,,,/images/Blocks/RedstoneLampOff.png" />
<local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" /> <local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" />
<local:MyComboBoxItem Content="布料(Fabric)" Tag="pack://application:,,,/images/Blocks/Fabric.png" /> <local:MyComboBoxItem Content="布料(Fabric)" Tag="pack://application:,,,/images/Blocks/Fabric.png" />
<local:MyComboBoxItem Content="狐狸(NeoForge)" Tag="pack://application:,,,/images/Blocks/NeoForge.png" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType"> <local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType">
@@ -127,6 +127,8 @@
'重命名主文件夹 '重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName) My.Computer.FileSystem.RenameDirectory(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName) My.Computer.FileSystem.RenameDirectory(TempPath, NewName)
'清理 ini 缓存
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
'遍历重命名所有文件与文件夹 '遍历重命名所有文件与文件夹
For Each Entry As DirectoryInfo In New DirectoryInfo(NewPath).EnumerateDirectories For Each Entry As DirectoryInfo In New DirectoryInfo(NewPath).EnumerateDirectories
If Not Entry.Name.Contains(OldName) Then Continue For If Not Entry.Name.Contains(OldName) Then Continue For
@@ -282,26 +284,24 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try Try
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then Hint("正在处理中,请稍候!", HintType.Critical)
Hint("正在处理中,请稍候!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False)) Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub() Loader.OnStateChanged =
Select Case Loader.State Sub()
Case LoadState.Finished Select Case Loader.State
Hint(Loader.Name & "成功!", HintType.Finish) Case LoadState.Finished
Case LoadState.Failed Hint(Loader.Name & "成功!", HintType.Finish)
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical) Case LoadState.Failed
Case LoadState.Aborted Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Hint(Loader.Name & "已取消!", HintType.Info) Case LoadState.Aborted
End Select Hint(Loader.Name & "已取消!", HintType.Info)
End Sub End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name) Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -312,8 +312,8 @@
End Sub End Sub
'删除版本 '删除版本
'修改此代码时,同时修改 PageSelectRight 中的代码
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
'修改此代码时,同时修改 PageSelectRight 中的代码
Try Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
@@ -321,6 +321,7 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""), If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed) "版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1 Case 1
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path) DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish) Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
@@ -77,6 +77,22 @@
<local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="VersionRamCustom" MaxValue="49" Value="13" /> <local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="VersionRamCustom" MaxValue="49" Value="13" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />--> <!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid> </Grid>
<Grid Margin="0,5,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Margin="0,6,30,0" Text="启动游戏前进行内存优化" Grid.Row="1" Grid.Column="1" HorizontalAlignment="Left" />
<local:MyComboBox x:Name="ComboRamOptimize" Margin="10,0,0,0" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="2" Tag="VersionRamOptimize">
<local:MyComboBoxItem Content="使用全局设置" IsSelected="True" />
<local:MyComboBoxItem Content="开启" />
<local:MyComboBoxItem Content="关闭" />
</local:MyComboBox>
</Grid>
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1"> <Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition x:Name="ColumnRamUsed" Width="4.7*"/> <ColumnDefinition x:Name="ColumnRamUsed" Width="4.7*"/>
@@ -51,6 +51,7 @@
'游戏内存 '游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version) SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Version:=PageVersionLeft.Version)
'服务器 '服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version) TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version)
@@ -95,6 +96,7 @@
Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version) Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version) Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version) Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamOptimize", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version)
@@ -130,7 +132,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version)
End Sub End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change
@@ -163,10 +165,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12 SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25 SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49) SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If End If
'设置文本 '设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" & LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -351,15 +351,14 @@ PreFin:
RamGive = (Value - 12) * 0.5 + 1.5 RamGive = (Value - 12) * 0.5 + 1.5
ElseIf Value <= 33 Then ElseIf Value <= 33 Then
RamGive = (Value - 25) * 1 + 8 RamGive = (Value - 25) * 1 + 8
ElseIf Value <= 41 Then
RamGive = (Value - 33) * 2 + 16
Else Else
RamGive = (Value - 41) * 4 + 32 RamGive = (Value - 33) * 2 + 16
End If End If
End If End If
'若使用 32 位 Java,则限制为 1G '若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(PageVersionLeft.Version)) Then RamGive = Math.Min(1, RamGive) If If(Is32BitJava, Not JavaIs64Bit(PageVersionLeft.Version)) Then RamGive = Math.Min(1, RamGive)
Return RamGive '封顶 32G
Return Math.Min(32, RamGive)
End Function End Function
#End Region #End Region
@@ -38,7 +38,7 @@
<DefineDebug>false</DefineDebug> <DefineDebug>false</DefineDebug>
<DefineTrace>false</DefineTrace> <DefineTrace>false</DefineTrace>
<IncrementalBuild>true</IncrementalBuild> <IncrementalBuild>true</IncrementalBuild>
<OutputPath>D:\Minecraft\程序\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn> <NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
@@ -55,7 +55,7 @@
<DefineTrace>false</DefineTrace> <DefineTrace>false</DefineTrace>
<IncrementalBuild>false</IncrementalBuild> <IncrementalBuild>false</IncrementalBuild>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<OutputPath>D:\Minecraft\程序\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn> <NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
@@ -100,7 +100,7 @@
<SignManifests>false</SignManifests> <SignManifests>false</SignManifests>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<WarningLevel>1</WarningLevel> <WarningLevel>1</WarningLevel>
@@ -111,7 +111,7 @@
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<WarningLevel>1</WarningLevel> <WarningLevel>1</WarningLevel>
@@ -129,7 +129,7 @@
</AssemblyOriginatorKeyFile> </AssemblyOriginatorKeyFile>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DefineConstants>RELEASE,BY_UPDATE</DefineConstants> <DefineConstants>RELEASE,BY_UPDATE</DefineConstants>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <Optimize>true</Optimize>
@@ -244,6 +244,9 @@
<Compile Include="Pages\PageDownload\PageDownloadCompDetail.xaml.vb"> <Compile Include="Pages\PageDownload\PageDownloadCompDetail.xaml.vb">
<DependentUpon>PageDownloadCompDetail.xaml</DependentUpon> <DependentUpon>PageDownloadCompDetail.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageDownload\PageDownloadNeoForge.xaml.vb">
<DependentUpon>PageDownloadNeoForge.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb"> <Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb">
<DependentUpon>PageDownloadPack.xaml</DependentUpon> <DependentUpon>PageDownloadPack.xaml</DependentUpon>
</Compile> </Compile>
@@ -494,6 +497,10 @@
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageDownload\PageDownloadNeoForge.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageDownload\PageDownloadPack.xaml"> <Page Include="Pages\PageDownload\PageDownloadPack.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
@@ -869,7 +876,6 @@
<Resource Include="Images\Heads\bangbang93.png" /> <Resource Include="Images\Heads\bangbang93.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\DoodleHuang.png" />
<Resource Include="Images\Heads\wiki.png" /> <Resource Include="Images\Heads\wiki.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -923,6 +929,11 @@
<ItemGroup> <ItemGroup>
</ItemGroup> </ItemGroup>
<ItemGroup /> <ItemGroup>
<Resource Include="Images\Blocks\NeoForge.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\z0z0r4.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
+20 -14
View File
@@ -79,7 +79,11 @@
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" /> Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" />
<local:MyButton Margin="0,4,0,0" Width="250" Height="35" <local:MyButton Margin="0,4,0,0" Width="250" Height="35"
Text="启动 1.12.2 并进入 Hypixel" EventType="启动游戏" EventData="1.12.2|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" /> Text="启动 1.20.1 并进入 Hypixel" EventType="启动游戏" EventData="1.20.1|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 中填写 \current,表示启动当前被选中的游戏版本,同样可以在后面填写服务器 IP。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动当前选中版本并进入 Hypixel" EventType="启动游戏" EventData="\current|mc.hypixel.net" ToolTip="启动当前版本" />
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -144,7 +148,7 @@
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" <local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" /> Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0" <local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" /> Text="打开记事本" EventType="打开文件" EventData="notepad" />
</StackPanel> </StackPanel>
<!-- 这是第二行 --> <!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0"> <StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
@@ -180,28 +184,30 @@
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="PCL 内置了一些 Minecraft 方块与物品图片,可以直接使用。"/> Text="PCL 内置了一些 Minecraft 方块与物品图片,可以直接使用。"/>
<StackPanel Orientation="Horizontal" Margin="10,8,0,15" Height="30"> <StackPanel Orientation="Horizontal" Margin="10,8,0,15" Height="30">
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 命令方块 --> <!-- 命令方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 圆石 --> <!-- 圆石 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/>
<!-- 金块 --> <!-- 金块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<!-- 草方块 --> <!-- 草方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<!-- 草径 --> <!-- 草径 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<!-- 铁砧 --> <!-- 铁砧 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
<!-- 红石块 --> <!-- 红石块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/>
<!-- 红石灯(亮) --> <!-- 红石灯(亮) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/>
<!-- 红石灯(灭) --> <!-- 红石灯(灭) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/>
<!-- 鸡蛋 --> <!-- 鸡蛋 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/> <Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/>
<!-- 布料(Fabric 图标) --> <!-- 布料(Fabric 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/>
<!-- 狐狸(NeoForge 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/NeoForge.png"/>
</StackPanel> </StackPanel>
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="使用时,将上方对应行的 Source 复制到 MyListItem 的 Logo 属性处即可。"/> Text="使用时,将上方对应行的 Source 复制到 MyListItem 的 Logo 属性处即可。"/>
@@ -264,7 +270,7 @@
<local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35" <local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" /> Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35" <local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" /> Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
Binary file not shown.
File diff suppressed because it is too large Load Diff
Binary file not shown.
+2 -2
View File
@@ -2,7 +2,7 @@
[![Stars](https://img.shields.io/github/stars/Hex-Dragon/PCL2?style=flat&logo=data:image/svg%2bxml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHZlcnNpb249IjEiIHdpZHRoPSIxNiIgaGVpZ2h0PSIxNiI+PHBhdGggZD0iTTggLjI1YS43NS43NSAwIDAgMSAuNjczLjQxOGwxLjg4MiAzLjgxNSA0LjIxLjYxMmEuNzUuNzUgMCAwIDEgLjQxNiAxLjI3OWwtMy4wNDYgMi45Ny43MTkgNC4xOTJhLjc1MS43NTEgMCAwIDEtMS4wODguNzkxTDggMTIuMzQ3bC0zLjc2NiAxLjk4YS43NS43NSAwIDAgMS0xLjA4OC0uNzlsLjcyLTQuMTk0TC44MTggNi4zNzRhLjc1Ljc1IDAgMCAxIC40MTYtMS4yOGw0LjIxLS42MTFMNy4zMjcuNjY4QS43NS43NSAwIDAgMSA4IC4yNVoiIGZpbGw9IiNlYWM1NGYiLz48L3N2Zz4=&logoSize=auto&label=Stars&labelColor=666666&color=eac54f)](https://github.com/Hex-Dragon/PCL2/) [![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) [![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=666666&color=1a7f37)](https://github.com/Hex-Dragon/PCL2/issues)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.net/@LTCat) [![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.com/@LTCat)
<br/> <br/>
@@ -16,7 +16,7 @@ PCL 的代码绝大多数其实都是几年前学生时代的产物了……那
## 相关内容 ## 相关内容
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子! - [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
- [程序下载](https://afdian.net/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。 - [程序下载](https://afdian.com/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……) - [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
<br/> <br/>
Binary file not shown.