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:
- 'Plain Craft Launcher 2/**'
- '.github/workflows/**'
workflow_dispatch:
jobs:
@@ -29,7 +30,7 @@ jobs:
- name: Set Describe
shell: bash
run: |
Describe=`git describe --tags`
Describe=`git describe --tags --always`
echo "Describe=$Describe" >> $GITHUB_ENV
- 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.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
@@ -103,6 +103,7 @@ Public Class Application
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
+8 -15
View File
@@ -98,21 +98,13 @@
'排序
Select Case Type
Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(Left As DlLiteLoaderListEntry, Right As DlLiteLoaderListEntry) As Boolean
Return VersionSortBoolean(Left.Inherit, Right.Inherit)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean
Return VersionSortBoolean(Left.Version, Right.Version)
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version)
Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate)
End Select
'控件转换
Select Case Type
@@ -144,9 +136,8 @@
Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
'不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
@@ -171,6 +162,8 @@
Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
Case 12
Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected))
Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else
Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
End Select
@@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
@@ -74,13 +74,13 @@
'添加结束 Invoke
If FinishedInvoke IsNot Nothing Then
AddHandler RealLoader.PreviewFinish,
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub
End If
AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
'隐藏 UI
+60 -15
View File
@@ -10,6 +10,22 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 332 Then 'Release 2.8.3
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 330 Then 'Release 2.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 323 Then 'Release 2.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
@@ -108,6 +124,37 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'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
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
@@ -269,17 +316,13 @@ Public Class FormMain
RunInNewThread(
Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
OpenWebsite("https://afdian.com/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
End Sub
'窗口加载
Private IsWindowLoadFinished As Boolean = False
''' <summary>
''' 是否为联机提权后自动重启。
''' </summary>
Public Shared IsLinkRestart As Boolean = False
Public Sub New()
ApplicationStartTick = GetTimeTick()
'窗体参数初始化
@@ -317,7 +360,6 @@ Public Class FormMain
PanMainLeft.Child = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
'模式提醒
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
@@ -386,7 +428,7 @@ Public Class FormMain
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
End Sub, , True)
}, "Form Show")
'Timer 启动
@@ -532,7 +574,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort()
Next
End Sub, "强行停止下载任务")
@@ -851,10 +893,12 @@ Public Class FormMain
Install:
Try
For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
@@ -871,7 +915,7 @@ Install:
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
@@ -1019,10 +1063,11 @@ Install:
DownloadClient = 4
DownloadOptiFine = 5
DownloadForge = 6
DownloadFabric = 7
DownloadLiteLoader = 8
DownloadMod = 10
DownloadPack = 11
DownloadNeoForge = 7
DownloadFabric = 8
DownloadLiteLoader = 9
DownloadMod = 11
DownloadPack = 12
SetupLaunch = 0
SetupUI = 1
SetupSystem = 2
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

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 "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.4." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 323 'Release
Public Const VersionCode As Integer = 332 'Release
#Else
Public Const VersionCode As Integer = 325 'Snapshot
Public Const VersionCode As Integer = 333 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -80,13 +80,9 @@ Public Module ModBase
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary>
@@ -1016,7 +1012,7 @@ Public Module ModBase
''' </summary>
Public Function CheckPermission(Path As String) As Boolean
Try
If Path = "" Then Return False
If String.IsNullOrEmpty(Path) Then Return False
If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False
@@ -1108,8 +1104,6 @@ Re:
Dim Retry As Boolean = False
Re:
Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1257,12 +1251,19 @@ Re:
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
For Each FilePath As String In Temp
Dim RetriedFile As Boolean = False
RetryFile:
Try
File.Delete(str)
File.Delete(FilePath)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
Else
Throw
@@ -1273,10 +1274,17 @@ Re:
For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue)
Next
Dim RetriedDir As Boolean = False
RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败")
Else
Throw
@@ -1573,14 +1581,14 @@ Re:
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then
StartPos += Before.Length
StartPos += After.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
@@ -1652,7 +1660,10 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
@@ -2065,15 +2076,16 @@ NextElement:
''' 在新的工作线程中执行代码。
''' </summary>
Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
Dim th As New Thread(
Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
th.Start()
Return th
End Function
@@ -2186,7 +2198,9 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
End If
Log("[System] 正在打开网页:" & Url)
Process.Start(Url)
Catch ex As Exception
@@ -2211,25 +2225,27 @@ NextElement:
''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
''' </summary>
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
RunInThread(Sub()
Dim RetryCount As Integer = 0
RunInThread(
Sub()
Dim RetryCount As Integer = 0
Retry:
Try
RunInUi(Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
Try
RunInUi(
Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
End Sub
''' <summary>
@@ -2448,39 +2464,40 @@ Retry:
Private LogList As New StringBuilder
Private LogWritter As StreamWriter
Public Sub LogStart()
RunInNewThread(Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
RunInNewThread(
Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
End Sub
Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
Public Sub LogFlush()
@@ -2659,7 +2676,7 @@ Retry:
Public Sub FeedbackInfo()
On Error Resume Next
Log("[System] 诊断信息:" & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
@@ -566,38 +566,33 @@ Restart:
End Class
'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
End SyncLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.TryTake(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
@@ -625,15 +620,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
+47 -67
View File
@@ -1,5 +1,4 @@
Imports System.Net
Imports PCL.ModNet
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -207,10 +206,10 @@ RequestFinished:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时,已接收 " & Result.Count & " B(" & Url & ")")
If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException($"获取结果失败({CType(ex, WebException).Status},{ex.Message},{Url})", ex)
Else
Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex)
Throw New WebException($"获取结果失败({If(TypeOf ex Is WebException, CType(ex, WebException).Status & ",", "")}{ex.Message},{Url})", ex)
End If
Finally
Request.Abort()
@@ -341,14 +340,15 @@ Retry:
Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0
For i = 1 To RequestCount
Dim th As New Thread(Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
Dim th As New Thread(
Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
th.Start()
Threads.Add(th)
Thread.Sleep(i * 250)
@@ -382,7 +382,7 @@ RequestFinished:
Dim Resp As WebResponse = Nothing
Dim Req As HttpWebRequest
Try
Req = WebRequest.Create(New Uri(Url))
Req = WebRequest.Create(Url)
Req.Method = Method
Dim SendData As Byte()
If TypeOf Data Is Byte() Then
@@ -418,7 +418,7 @@ RequestFinished:
Throw
Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then
Throw New WebException("连接服务器超时,请检查你的网络环境是否良好(" & Url & ")", ex)
ex = New WebException($"连接服务器超时,请检查你的网络环境是否良好({ex.Message},{Url})", ex)
Else
'获取请求失败的返回
Dim Res As String = ""
@@ -432,10 +432,14 @@ RequestFinished:
End Using
Catch
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
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Catch ex As Exception
Throw New WebException("网络请求失败(" & Url & ")", ex)
ex = New WebException("网络请求失败(" & Url & ")", ex)
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Finally
If DataStream IsNot Nothing Then DataStream.Dispose()
If Resp IsNot Nothing Then Resp.Dispose()
@@ -687,7 +691,7 @@ RequestFinished:
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New List(Of LoaderDownload)
Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload)
''' <summary>
''' 所有下载源。
@@ -880,7 +884,6 @@ RequestFinished:
Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean
@@ -963,7 +966,7 @@ Capture:
Next
'是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads
@@ -979,10 +982,8 @@ StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
'链表处理
If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
@@ -1139,11 +1140,9 @@ NotSupportRange:
End If
SyncLock LockCount
Info.Source.FailCount = 0
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount = 0
Next
End SyncLock
For Each Task In Tasks
Task.FailCount = 0
Next
End SyncLock
NetManager.DownloadDone += RealDataCount
SyncLock LockDone
@@ -1197,11 +1196,9 @@ SourceBreak:
'状态变更
SyncLock LockCount
Info.Source.FailCount += 1
SyncLock LockTasks
For Each Task In Tasks
Task.FailCount += 1
Next
End SyncLock
For Each Task In Tasks
Task.FailCount += 1
Next
End SyncLock
Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
@@ -1306,7 +1303,7 @@ Retry:
'合并文件
If IsNoSplit Then
'仅有一个线程,从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件")
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件,长度:" & SmailFileCache.Count)
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray)
@@ -1343,7 +1340,7 @@ Retry:
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 合并文件失败,下载线程细节:")
Log($"[Download] {LocalName} 文件校验失败,下载线程细节:")
For Each Th As NetThread In Threads
Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
Next
@@ -1396,10 +1393,8 @@ Retry:
''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载
SyncLock LockTasks
Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub
End SyncLock
Tasks.TryTake(CausedByTask)
If Tasks.Any Then Exit Sub
'确认中断
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
@@ -1429,11 +1424,9 @@ Retry:
NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
End SyncLock
SyncLock LockTasks
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
End SyncLock
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
End Sub
End Class
@@ -1859,15 +1852,10 @@ Retry:
Try
While True
Thread.Sleep(20)
'若已完成,则清空
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock LockFiles
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then Files.Clear() '若已完成,则清空
AllFiles = Files.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
@@ -1965,9 +1953,7 @@ Retry:
If Files(File.LocalPath).State >= NetState.Finish Then
'该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
Files(File.LocalPath) = File
SyncLock LockRemain
FileRemain += 1
@@ -1978,15 +1964,11 @@ Retry:
'该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件
File = Files(File.LocalPath)
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
End If
Else
'没有该文件
SyncLock File.LockTasks
File.Tasks.Add(Task)
End SyncLock
File.Tasks.Add(Task)
Files.Add(File.LocalPath, File)
SyncLock LockRemain
FileRemain += 1
@@ -2008,14 +1990,12 @@ Retry:
''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </summary>
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
Return True
End If
Next
End SyncLock
For Each Task In LoaderTaskbar
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
Return True
End If
Next
Return False
End Function
@@ -278,7 +278,8 @@
End If
'Tags
Tags = New List(Of String)
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段:https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category
'Mod
Case 406 : Tags.Add("世界元素")
@@ -355,12 +356,12 @@
ModLoaders = New List(Of CompModLoaderType)
For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category
'加载器
'加载器
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
'Mod
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪")
@@ -376,7 +377,7 @@
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
'整合包
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
@@ -385,7 +386,7 @@
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪")
Case "kitchen-sink" : Tags.Add("大杂烩")
Case "lightweight" : Tags.Add("轻量")
'FUTURE: Res
End Select
@@ -629,19 +630,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -947,7 +948,7 @@ Retry:
Try
'获取工程列表
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
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data")
@@ -962,7 +963,7 @@ Retry:
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = Storage.CurseForgeOffset
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex
CurseForgeFailed = True
End Try
@@ -977,7 +978,7 @@ Retry:
Sub()
Try
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
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits")
@@ -995,7 +996,7 @@ Retry:
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = Storage.ModrinthOffset
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
End Try
@@ -1021,7 +1022,7 @@ Retry:
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有符合条件的结果")
Throw New Exception("没有搜索结果")
End If
End If
ElseIf [Error] IsNot Nothing Then
@@ -1253,7 +1254,9 @@ Retry:
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}).Distinct().ToList()
Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
@@ -1287,11 +1290,10 @@ Retry:
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Any() Then
If CType(Data("files"), JArray).Any() Then '可能为空
Dim File As JToken = Data("files")(0)
FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")}
DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Hash = File("hashes")("sha1")
End If
'Dependencies
@@ -1320,6 +1322,7 @@ Retry:
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
@@ -1426,9 +1429,9 @@ Retry:
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
TargetProject = CompProjectCache(ProjectId)
ElseIf FromCurseForge Then 'CurseForge
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"))
TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
Else 'Modrinth
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8))
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If
'获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId)
@@ -1436,13 +1439,13 @@ Retry:
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If
Else
'Modrinth
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
@@ -1456,11 +1459,10 @@ Retry:
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods",
Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
"POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
Else
Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
Accept:="application/json", IsJson:=True)
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
End If
For Each Project In Projects
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
@@ -697,8 +697,8 @@ NextStack:
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -881,7 +881,10 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
Dim FileEncoding As Encoding = GetEncoding(OutputFile)
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
End If
Next
'导出报告
@@ -8,9 +8,13 @@
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -220,7 +224,7 @@
End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
Catch ex As Exception
Throw New Exception("版本列表解析失败", ex)
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
End Sub
''' <summary>
@@ -237,7 +241,7 @@
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Minecraft BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -288,6 +292,7 @@
''' </summary>
Public Value As List(Of DlOptiFineListEntry)
End Structure
Public Class DlOptiFineListEntry
''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
@@ -359,29 +364,33 @@
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Try
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("OptiFine 官方源版本列表解析失败(" & Result & ")", ex)
End Try
End Sub
''' <summary>
@@ -407,7 +416,7 @@
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("OptiFine BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -485,15 +494,61 @@
#Region "DlForgeVersion | Forge 版本列表"
Public Class DlForgeVersionEntry
Public MustInherit Class DlForgelikeEntry
Public IsNeoForge As Boolean
''' <summary>
''' 完整的版本名,如 “14.22.1.2478”。
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Version As String
Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary>
''' Forge:MC 版本是否小于 1.13。
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary>
Public VersionName As String
''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。
''' </summary>
Public Inherit As String
End Class
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary>
@@ -511,58 +566,21 @@
''' </summary>
Public Category As String
''' <summary>
''' 版本分支。若无分支则为 Nothing。
''' </summary>
Public Branch As String = Nothing
''' <summary>
''' 是否为新版 Forge。(即为 Minecraft 1.13+)
''' </summary>
Public ReadOnly Property IsNewType As Boolean
Get
Return Version.Split(".")(0) >= 20
End Get
End Property
''' <summary>
''' 构建数。
''' </summary>
Public ReadOnly Property Build As Integer
Get
Dim Version = Me.Version.Split(".")
If Version(0) < 15 Then
Return Version(Version.Count - 1)
Else
Return Version(Version.Count - 1) + 10000
End If
End Get
End Property
''' <summary>
''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
''' </summary>
Public ReadOnly Property FileVersion As String
Get
Return Version & If(Branch Is Nothing, "", "-" & Branch)
End Get
End Property
''' <summary>
''' 即将下载的文件全名。
''' </summary>
Public ReadOnly Property FileName As String
Get
Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
End Get
End Property
''' <summary>
''' 文件扩展名。
''' </summary>
Public ReadOnly Property FileSuffix As String
Get
If Category = "installer" Then
Return "jar"
Else
Return "zip"
End If
End Get
End Property
Public FileVersion As String
Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Version.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'为 DlForgelikeEntry 提供所有信息
IsNeoForge = False
VersionName = Version
Me.Version = New Version(Version)
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
''' <summary>
@@ -596,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -620,8 +640,6 @@
'分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02"
@@ -651,13 +669,13 @@
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Catch ex As Exception
Throw New Exception("版本信息提取失败(" & VersionCode & ")", ex)
Throw New Exception("Forge 官方源版本信息提取失败(" & VersionCode & ")", ex)
End Try
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -667,7 +685,9 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -700,20 +720,17 @@
End Select
Next
'获取 Entry
Dim Inherit As String = Loader.Input
Dim Branch As String = Token("branch")
Dim Name As String = Token("version")
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'基础信息获取
Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name}
Dim Entry = New DlForgeVersionEntry(Name, Branch, Loader.Input) With {.Hash = Hash, .Category = Category, .IsRecommended = Recommended = Name}
Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
'添加项
Versions.Add(Entry)
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -721,6 +738,132 @@
#End Region
#Region "DlNeoForgeList | NeoForge 版本列表"
Public Structure DlNeoForgeListResult
''' <summary>
''' 数据来源名称,如“Official”,“BMCLAPI”。
''' </summary>
Public SourceName As String
''' <summary>
''' 是否为官方的实时数据。
''' </summary>
Public IsOfficial As Boolean
''' <summary>
''' 所有版本的列表。已经按从新到老排序。
''' </summary>
Public Value As List(Of DlNeoForgeListEntry)
End Structure
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
Public IsBeta As Boolean
''' <summary>
''' API 使用的原始版本字符串,如 “20.4.30-beta”、“1.20.1-47.1.99”(Legacy)。
''' </summary>
Public ApiName As String
''' <summary>
''' 文件在官网的基础地址,不包含后缀。
''' </summary>
Public ReadOnly Property UrlBase As String
Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get
End Property
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
Version = New Version(ApiName.Before("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
End Class
''' <summary>
''' NeoForge 版本列表,主加载器。
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
}, Loader.IsForceRestarting)
End Select
End Sub
''' <summary>
''' NeoForge 版本列表,官方源。
''' </summary>
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "NeoForge 官方源",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge 官方源版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
''' <summary>
''' NeoForge 版本列表,BMCLAPI。
''' </summary>
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "BMCLAPI",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge BMCLAPI 版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions
End Function
#End Region
#Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult
@@ -741,6 +884,7 @@
''' </summary>
Public OfficialError As Exception
End Structure
Public Class DlLiteLoaderListEntry
''' <summary>
''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
@@ -820,7 +964,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -848,7 +992,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -906,7 +1050,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -921,7 +1065,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -939,30 +1083,121 @@
#End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Public Function DlSourceResourceGet(Original As String) As String()
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
MojangBase
}
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
}
End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String()
Public Function DlSourceLibraryGet(Original As String) As String()
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
MojangBase
}
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Public Function DlSourceModGet(Original As String) As String
Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
MojangBase
}
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
}
End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 6
Public JavaListCacheVersion As Integer = 7
''' <summary>
''' 目前所有可用的 Java。
@@ -220,6 +220,8 @@
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList
@@ -240,21 +242,25 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
End If
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
UserJava.Check()
@@ -546,7 +552,7 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -665,34 +671,18 @@ Wait:
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
If IsFullSearch OrElse
FolderInfo.Parent.Name.ToLower = "users" OrElse
SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse
SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse
SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse
SearchEntry.Contains("soft") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse
SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse
SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse
SearchEntry.Contains("game") OrElse SearchEntry.Contains("file") OrElse SearchEntry.Contains("data") OrElse
SearchEntry.Contains("jvm") OrElse SearchEntry.Contains("服务") OrElse SearchEntry.Contains("server") OrElse
SearchEntry.Contains("客户") OrElse SearchEntry.Contains("client") OrElse SearchEntry.Contains("整合") OrElse
SearchEntry.Contains("应用") OrElse SearchEntry.Contains("运行") OrElse SearchEntry.Contains("前置") OrElse
SearchEntry.Contains("mojang") OrElse SearchEntry.Contains("官启") OrElse SearchEntry.Contains("新建文件夹") OrElse
SearchEntry.Contains("eclipse") OrElse SearchEntry.Contains("microsoft") OrElse SearchEntry.Contains("hotspot") OrElse
SearchEntry.Contains("runtime") OrElse SearchEntry.Contains("x86") OrElse SearchEntry.Contains("x64") OrElse
SearchEntry.Contains("forge") OrElse SearchEntry.Contains("原版") OrElse SearchEntry.Contains("optifine") OrElse
SearchEntry.Contains("官方") OrElse SearchEntry.Contains("启动") OrElse SearchEntry.Contains("hmcl") OrElse
SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse
SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse
SearchEntry.Contains("version") OrElse SearchEntry.Contains("baka") OrElse SearchEntry.Contains("pcl") OrElse
SearchEntry.Contains("zulu") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127d64ec6") OrElse '官启文件夹
SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名
SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
@@ -113,10 +113,18 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}
If Setup.Get("LaunchArgumentRam") Then
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
'内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Case 1 '开启
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
Case 2 '关闭
End Select
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
@@ -217,7 +225,7 @@ NextInner:
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.net/a/LTCat")
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
End Sub, "Donate")
@@ -502,10 +510,8 @@ NextInner:
If Input.OAuthRefreshToken = "" Then
'无 RefreshToken
Relogin:
Dim OAuthCode As String = MsLoginStep1(Data, ClientId)
If OAuthCode = "Cancel" Then
Exit Sub
End If
Dim OAuthCode As String = MsLoginStep1(Data)
If OAuthCode = "Cancel" Then Exit Sub
If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.2
OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
@@ -802,43 +808,21 @@ LoginFinish:
End Try
End Function
'微软登录步骤 1:获取 DeviceCode 并显示验证提示
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult), ClientId As String) As String
If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码(会自动复制到剪贴板)并登录微软账户,然后允许 PCL2 访问相关信息。" & vbCrLf & "设备代码有时效性,若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") = 1 Then
McLaunchLog("开始微软登录步骤 1")
Dim DeviceCode As String
Dim UserCode As String
Dim VerifyUri As String
Dim ExpiresIn As String
Dim Request As String = "client_id=" & ClientId & "&" & "scope=XboxLive.signin%20offline_access"
Dim Result As String = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST", Request, "application/x-www-form-urlencoded", 2)
Dim ResultJson As JObject = GetJson(Result)
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
'微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1")
OpenWebsite(FormLoginOAuth.LoginUrl1)
Dim Result As String =
MyMsgBoxInput("等待网页登录",
"登录完成后,网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行!" & vbCrLf &
"如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
If Result Is Nothing Then
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
Else
Return "Cancel"
Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If
End Function
@@ -895,19 +879,112 @@ LoginFinish:
Return {"Cancel", ""}
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
Private Function MsLoginStep3(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 3")
Dim Request As String = "{
""Properties"": {
""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": ""d=" & AccessToken & """
},
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
""Properties"": {
""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": """ & AccessToken & """
},
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}" 'TODO: 新版登录改为 ""RpsTicket"": ""d=" & AccessToken & """
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result)
@@ -1064,7 +1141,7 @@ LoginFinish:
Case 3
'使用正版用户名
Try
If Not SkinName = "" Then
If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
@@ -1075,8 +1152,8 @@ LoginFinish:
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
End Select
Return Uuid
@@ -1194,7 +1271,7 @@ LoginFinish:
'统一通行证检测
If Setup.Get("LoginType") = McLoginType.Nide Then
'至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If
SyncLock JavaLock
@@ -1221,12 +1298,12 @@ LoginFinish:
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101"
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) Then
JavaCode = "8u101"
If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1271,25 +1348,40 @@ LoginFinish:
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
Dim BaseDir As String = GetJavaWrapperDir()
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper"))
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug)
Try
File.Delete(WrapperPath)
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex As Exception
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成")
WrapperPath = BaseDir & "\JavaWrapper2.jar"
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
End Try
End If
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息")
End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath
End Function
Private ExtractJavaWrapperLock As New Object
''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
If PathAppdata.IsASCII() Then
If (Path & "PCL").IsASCII() Then
Return Path & "PCL"
ElseIf PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\")
ElseIf PathTemp.IsASCII() Then
Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
Return PathTemp.TrimEnd("\")
Else
Log("[Java] Wrapper:AppData 路径与 Temp 路径中均包含非 ASCII 字符,换用 ProgramData 目录")
Return OsDrive & "ProgramData\PCL"
End If
End Function
@@ -1765,7 +1857,6 @@ NextVersion:
{
""authenticationDatabase"": {
""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": {
""66666555554444433333222221111100"": {
@@ -1796,7 +1887,6 @@ NextVersion:
{
""authenticationDatabase"": {
""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": {
""66666555554444433333222221111100"": {
@@ -1872,16 +1962,12 @@ NextVersion:
End Try
'离线皮肤 Alex 警告
Try
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If
Catch ex As Exception
Log(ex, "检查离线皮肤失效失败")
End Try
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If
'离线皮肤资源包
Try
@@ -2123,6 +2209,8 @@ IgnoreCustomSkin:
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数
StartInfo.StandardErrorEncoding = Encoding.UTF8
StartInfo.StandardOutputEncoding = Encoding.UTF8
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
@@ -151,7 +151,7 @@ Public Module ModMinecraft
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 29
Public Const McVersionCacheVersion As Integer = 30
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -290,7 +290,7 @@ Public Module ModMinecraft
Public ReadOnly Property Modable As Boolean
Get
If Not IsLoaded Then Load()
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse Version.HasNeoForge OrElse
DisplayType = McVersionCardType.API '#223
End Get
End Property
@@ -345,7 +345,7 @@ Public Module ModMinecraft
End If
Next
End If
'从 Forge Arguments 中获取版本号
'从 Forge / NeoForge Arguments 中获取版本号
If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then
Dim Mark As Boolean = False
For Each Argument In JsonObject("arguments")("game")
@@ -565,6 +565,7 @@ Recheck:
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
End Try
Catch ex As Exception
Log($"[Minecraft] 传入的版本 json 文件内容(共 {Text.Length} 字符,最多输出前 5000 字符):{vbCrLf}{Text.Substring(0, 5000)}")
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
End Try
Try
@@ -665,7 +666,7 @@ Recheck:
Try
Dim JsonObjCheck = JsonObject
Catch ex As Exception
Log(ex, "版本 json 可用性检查失败(" & Path & ")")
Log(ex, "版本 JSON 可用性检查失败(" & Path & ")")
JsonText = ""
JsonObject = Nothing
Info = ex.Message
@@ -715,8 +716,8 @@ Recheck:
'OptiFine
If RealJson.Contains("optifine") Then
State = McVersionState.OptiFine
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
Version.HasOptiFine = True
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
End If
'LiteLoader
If RealJson.Contains("liteloader") Then
@@ -727,14 +728,20 @@ Recheck:
'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对
If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then
State = McVersionState.Fabric
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
Version.HasFabric = True
ElseIf RealJson.Contains("minecraftforge") Then
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
ElseIf RealJson.Contains("minecraftforge") AndAlso Not RealJson.Contains("net.neoforge") Then
State = McVersionState.Forge
Version.HasForge = True
Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本")
Version.HasForge = True
ElseIf RealJson.Contains("net.neoforge") Then
'1.20.1 JSON 范例:"--fml.forgeVersion", "47.1.99"
'1.20.2+ JSON 范例:"--fml.neoForgeVersion", "20.6.119-beta"
State = McVersionState.NeoForge
Version.HasNeoForge = True
Version.NeoForgeVersion = If(RegexSeek(RealJson, "(?<=orgeVersion"",[^""]*?"")[^""]+(?="",)"), "未知版本")
End If
Version.IsApiLoaded = True
End Select
@@ -752,6 +759,8 @@ ExitDataLoad:
Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge
Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.NeoForge
Logo = PathImage & "Blocks/NeoForge.png"
Case McVersionState.Fabric
Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine
@@ -780,7 +789,7 @@ ExitDataLoad:
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
@@ -813,6 +822,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader)
WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionNeoForge", Version.NeoForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain)
@@ -852,6 +862,7 @@ ExitDataLoad:
OptiFine
Old
Forge
NeoForge
LiteLoader
Fabric
End Enum
@@ -903,6 +914,17 @@ ExitDataLoad:
''' </summary>
Public ForgeVersion As String = ""
'NeoForge
''' <summary>
''' 该版本是否安装了 NeoForge。
''' </summary>
Public HasNeoForge As Boolean = False
''' <summary>
''' NeoForge 版本号,如 21.0.2-beta、47.1.79。
''' </summary>
Public NeoForgeVersion As String = ""
'Fabric
''' <summary>
@@ -929,6 +951,7 @@ ExitDataLoad:
Public Overrides Function ToString() As String
ToString = ""
If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion)
If HasNeoForge Then ToString += ", NeoForge" & If(NeoForgeVersion = "未知版本", "", " " & NeoForgeVersion)
If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion)
If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion)
If HasLiteLoader Then ToString += ", LiteLoader"
@@ -955,15 +978,15 @@ ExitDataLoad:
Else
Throw New Exception("无效的 Fabric 版本:" & ForgeVersion)
End If
ElseIf HasForge Then
If ForgeVersion = "未知版本" Then Return 0
Dim SubVersions = ForgeVersion.Split(".")
ElseIf HasForge OrElse HasNeoForge Then
If ForgeVersion = "未知版本" AndAlso NeoForgeVersion = "未知版本" Then Return 0
Dim SubVersions = If(HasForge, ForgeVersion.Split("."), NeoForgeVersion.Split("."))
If SubVersions.Length = 4 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3))
ElseIf SubVersions.Length = 3 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2))
Else
Throw New Exception("无效的 Forge 版本:" & ForgeVersion)
Throw New Exception("无效的 Neo/Forge 版本:" & ForgeVersion)
End If
ElseIf HasOptiFine Then
If OptiFineVersion = "未知版本" Then Return 0
@@ -1175,6 +1198,7 @@ OnLoaded:
Dim VersionInfo As New McVersionInfo With {
.FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""),
.ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""),
.NeoForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionNeoForge", ""),
.OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""),
.HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False),
.SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1),
@@ -1183,9 +1207,10 @@ OnLoaded:
.McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1),
.IsApiLoaded = True
}
VersionInfo.HasFabric = VersionInfo.FabricVersion.Count > 1
VersionInfo.HasForge = VersionInfo.ForgeVersion.Count > 1
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Count > 1
VersionInfo.HasFabric = VersionInfo.FabricVersion.Any()
VersionInfo.HasForge = VersionInfo.ForgeVersion.Any()
VersionInfo.HasNeoForge = VersionInfo.NeoForgeVersion.Any()
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Any()
Version.Version = VersionInfo
End If
@@ -1273,7 +1298,7 @@ OnLoaded:
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool)
'筛选 API 版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.NeoForge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
'将老版本预先分类入不常用,只剩余原版、快照、OptiFine
Dim VersionUseful As New List(Of McVersion)
@@ -1407,7 +1432,7 @@ OnLoaded:
End Function)
End If
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
Function(Left As McVersion, Right As McVersion)
@@ -1417,6 +1442,8 @@ OnLoaded:
Else
If Left.Version.HasFabric Xor Right.Version.HasFabric Then
Return Left.Version.HasFabric
ElseIf Left.Version.HasNeoForge Xor Right.Version.HasNeoForge Then
Return Left.Version.HasNeoForge
ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then
Return Left.Version.HasForge
ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then
@@ -1649,7 +1676,7 @@ OnLoaded:
Return _Url
End Get
Set(value As String)
'孤儿 Forge 作者喜欢把没有的 URL 写个空字符串
'孤儿 Forge 作者喜欢把没有 URL 的写个空字符串
_Url = If(String.IsNullOrWhiteSpace(value), Nothing, value)
End Set
End Property
@@ -1666,15 +1693,6 @@ OnLoaded:
End Get
End Property
''' <summary>
''' 原 Json 中 Name 项最后一部分的版本号。
''' </summary>
Public ReadOnly Property Version As String
Get
Dim Splited = OriginalName.Split(":")
Return Splited(Splited.Count - 1)
End Get
End Property
''' <summary>
''' 原 Json 中的 Name 项。
''' </summary>
Public OriginalName As String
@@ -1755,7 +1773,7 @@ OnLoaded:
'根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then
If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
@@ -1840,13 +1858,14 @@ OnLoaded:
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End If
@@ -1880,15 +1899,25 @@ OnLoaded:
'去重
Dim ResultArray As New Dictionary(Of String, McLibToken)
Dim GetVersion =
Function(Token As McLibToken) As String
'测试例:
'D:\Minecraft\test\libraries\net\neoforged\mergetool\2.0.0\mergetool-2.0.0-api.jar
'D:\Minecraft\test\libraries\org\apache\commons\commons-collections4\4.2\commons-collections4-4.2.jar
'D:\Minecraft\test\libraries\com\google\guava\guava\31.1-jre\guava-31.1-jre.jar
Return GetFolderNameFromPath(GetPathFromFullPath(Token.LocalPath))
End Function
For i = 0 To BasicArray.Count - 1
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString
If ResultArray.ContainsKey(Key) Then
If BasicArray(i).Version <> ResultArray(Key).Version AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)}")
Dim BasicArrayVersion As String = GetVersion(BasicArray(i))
Dim ResultArrayVersion As String = GetVersion(ResultArray(Key))
If BasicArrayVersion <> ResultArrayVersion AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion})")
ResultArray.Add(Key & GetUuid(), BasicArray(i))
Else
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)},已忽略其中之一")
If VersionSortBoolean(BasicArray(i).Version, ResultArray(Key).Version) Then
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion}),已忽略其中之一")
If VersionSortBoolean(BasicArrayVersion, ResultArrayVersion) Then
ResultArray(Key) = BasicArray(i)
End If
End If
@@ -1948,6 +1977,7 @@ OnLoaded:
End If
End If
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
@@ -1997,8 +2027,14 @@ OnLoaded:
If Token.Url IsNot Nothing Then
'获取 Url 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Token.Url.Contains(".tsrg") Then
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings(#4425)
End If
If Token.Url.Contains("maven") Then
Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven"))
End If
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
@@ -2015,7 +2051,7 @@ OnLoaded:
'普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
End If
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next
'去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
@@ -887,7 +887,7 @@ Finished:
ModList.Add(ModEntry)
'读取 Comp 缓存
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
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
@@ -923,20 +923,15 @@ Finished:
Throw
End Try
End Sub
'联网加载 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)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
@@ -957,7 +952,7 @@ Finished:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -978,7 +973,7 @@ Finished:
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
Dim ModrinthProject = CType(GetJson(DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject
@@ -990,7 +985,7 @@ Finished:
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods
@@ -1027,7 +1022,7 @@ Finished:
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -1050,12 +1045,12 @@ Finished:
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
@@ -1071,7 +1066,8 @@ Finished:
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
@@ -1092,7 +1088,7 @@ Finished:
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
@@ -1136,10 +1132,21 @@ Finished:
If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash & McVersion) = Entry.ToJson()
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新下边栏(#4377)
RunInUi(Sub() FrmVersionMod?.RefreshBottomBar())
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
#If DEBUG Then
''' <summary>
@@ -1271,4 +1278,4 @@ Finished:
End Function
#End If
End Module
End Module
@@ -12,9 +12,10 @@ Public Module ModModpack
RunInThread(Sub() ModpackInstall(File))
End Sub
''' <summary>
''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。
''' 安装一个给定的整合包文件,返回启动的安装加载器,如果未成功启动则返回 Nothing。
''' 必须在工作线程执行。
''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
@@ -25,6 +26,7 @@ Public Module ModModpack
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
'从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +37,6 @@ Public Module ModModpack
End If
End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
@@ -45,6 +46,7 @@ Public Module ModModpack
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
@@ -55,54 +57,52 @@ Public Module ModModpack
End If
End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next
Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Return Nothing
End If
End Try
'执行对应的安装方法
Select Case PackType
Case 0
Log("[ModPack] 整合包种类:CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1
Log("[ModPack] 整合包种类:HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2
Log("[ModPack] 整合包种类:MMC")
InstallPackMMC(File, Archive, ArchiveBaseFolder)
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类:MCBBS")
InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Case 4
Log("[ModPack] 整合包种类:Modrinth")
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9
Log("[ModPack] 整合包种类:压缩包")
Archive.Dispose()
Archive = Nothing
InstallPackCompress(File, ArchiveBaseFolder)
Return InstallPackCompress(File, ArchiveBaseFolder)
Case Else
If ShowHint Then
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
Else
Log("[ModPack] 未能识别该整合包的种类,无法安装!")
End If
Return False
Return Nothing
End Select
Return True
Catch ex As Exception
Log(ex, "准备安装整合包失败", LogLevel.Feedback)
Return False
Return Nothing
Finally
If Archive IsNot Nothing Then Archive.Dispose()
End Try
@@ -159,7 +159,8 @@ Retry:
#Region "不同类型整合包的安装方法"
'CurseForge
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
@@ -167,22 +168,23 @@ Retry:
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
Return Nothing
End Try
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
@@ -190,20 +192,29 @@ Retry:
'Forge 指定
If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
Exit Sub
Return Nothing
End If
Try
Log("[ModPack] 整合包 Forge 版本:" & Id)
ForgeVersion = Id.Split("-")(1)
ForgeVersion = Id.Replace("forge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Try
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
NeoForgeVersion = Id.Replace("neoforge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Split("-")(1)
FabricVersion = Id.Replace("fabric-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
@@ -271,19 +282,23 @@ Retry:
'建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断是资源包还是 Mod
Dim IsResourcePack As Boolean
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String
If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
File.FileName.EndsWithF(".jar", True) Then
TargetFolder = "mods"
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks"
Else
TargetFolder = "shaderpacks"
End If
Else
IsResourcePack = False
TargetFolder = "mods"
End If
'实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -301,10 +316,11 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -335,14 +351,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -350,11 +362,11 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'Modrinth
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
@@ -363,11 +375,12 @@ Retry:
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower
@@ -376,47 +389,50 @@ Retry:
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
Exit Sub
Return Nothing
End Select
Next
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If
Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If
Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {})
@@ -433,8 +449,10 @@ Retry:
End Select
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next
If FileList.Any Then
@@ -447,10 +465,11 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -481,14 +500,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -496,25 +511,26 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub
End Function
'HMCL
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(Json("name"), "")
Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
@@ -535,7 +551,7 @@ Retry:
'构造加载器
If Json("gameVersion") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -543,7 +559,7 @@ Retry:
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -571,14 +587,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -587,10 +599,11 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'MMC
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
@@ -598,14 +611,14 @@ Retry:
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
@@ -665,7 +678,7 @@ Retry:
'构造版本安装请求
If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
@@ -676,16 +689,18 @@ Retry:
Request.MinecraftName = Component("version")
Case "net.minecraftforge"
Request.ForgeVersion = Component("version")
Case "net.neoforged"
Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
End Select
Next
'构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -698,14 +713,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -713,10 +724,12 @@ Retry:
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
Return Loader
End Function
'MCBBS
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
@@ -724,14 +737,17 @@ Retry:
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
Return Nothing
End Try
'获取版本名
Dim PackName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
@@ -752,7 +768,7 @@ Retry:
'构造加载器
If Json("addons") Is Nothing Then
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons")
@@ -760,11 +776,11 @@ Retry:
Next
If Not Addons.ContainsKey("game") Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub
Return Nothing
End If
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub
Return Nothing
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -772,10 +788,11 @@ Retry:
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -788,14 +805,10 @@ Retry:
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -803,28 +816,36 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
'普通压缩包
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
'获取解压路径
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub
If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return Nothing
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Return Nothing
'要求显示名称
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
'解压
Hint("正在解压压缩包……")
UnpackFiles(TargetFolder, FileAddress, Nothing)
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder, NewName, False)
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish)
End Sub
Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
New LoaderTask(Of String, Integer)("安装压缩包",
Sub()
UnpackFiles(TargetFolder, FileAddress, Nothing)
PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
End Sub)
})
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
#End Region
+30 -20
View File
@@ -21,28 +21,38 @@
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏"
If Data(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Else
Data(0) = McVersionCurrent.Name
End If
End If
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
@@ -394,6 +394,7 @@ EndHint:
Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack
+16 -6
View File
@@ -69,16 +69,25 @@
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键播放,右键播放下一曲。"
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
@@ -115,13 +124,14 @@
''' </summary>
Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then
Hint("播放列表中仅有一首歌曲!")
MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
MusicRefreshUI()
End If
MusicRefreshUI()
End Sub
#End Region
+8 -8
View File
@@ -10,6 +10,8 @@ Friend Module ModSecret
'在开源内容的注册表键与普通内容的注册表键隔离
Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
Public Const OAuthClientId As String = ""
Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级
@@ -41,9 +43,9 @@ Friend Module ModSecret
Environment.[Exit](Result.Cancel)
End If
'开源版本提示
MyMsgBox($"该版本中不包含以下特性:
- 微软账户登录:需要 Client ID(你可以创建并申请一个,然后添加到 McLoginMsStart 方法中)
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中)
MyMsgBox($"该版本中无法使用以下特性:
- CurseForge API 调用:需要你自行申请 API Key,然后添加到 SecretHeadersSign 方法中
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
@@ -90,7 +92,6 @@ Friend Module ModSecret
#Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String)
'只处理以 {CDN} 结尾的链接
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function
@@ -98,26 +99,24 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/"
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub
''' <summary>
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Request.UserAgent = "PCL2/" & VersionStandardCode
End If
Request.Referer = "http://" & VersionCode & ".pcl2.server/"
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub
@@ -253,6 +252,7 @@ Friend Module ModSecret
Return False
End Function
Public Function DonateCodeInput() As Boolean?
Return Nothing
End Function
#End Region
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.7.4.0")>
<Assembly: AssemblyFileVersion("2.7.4.0")>
<Assembly: AssemblyVersion("2.8.4.0")>
<Assembly: AssemblyFileVersion("2.8.4.0")>
<Assembly: NeutralResourcesLanguage("")>
File diff suppressed because it is too large Load Diff
@@ -43,6 +43,12 @@
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -56,7 +62,7 @@
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next
'清空当前
PanMain.Children.Clear()
@@ -87,7 +93,7 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -170,24 +170,25 @@
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
Sub()
If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -197,7 +198,7 @@
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'Mod 下载;整合包另存为
'Mod、资源包下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
@@ -211,10 +212,10 @@
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
@@ -230,7 +231,7 @@
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
@@ -260,10 +261,11 @@
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
Dim SelectedVersion = SuitableVersions.OrderBy(
Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
@@ -33,7 +33,7 @@
' PanMain.Children.Insert(0, CardWarn)
'End If
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 Forge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -55,10 +55,6 @@
Card.StackInstall()
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadForge(sender.Tag)
End Sub
'介绍栏
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://files.minecraftforge.net")
@@ -20,6 +20,7 @@
<StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" />
<Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions>
@@ -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" />
</Grid>
</local:MyCard>
<local:MyCard Title="NeoForge" Height="40" Margin="0,15,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
<Grid x:Name="PanNeoForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgNeoForge" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/NeoForge.png" />
<TextBlock x:Name="LabNeoForge" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="Fabric" Height="40" Margin="0,15,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
<Grid x:Name="PanFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -178,6 +197,7 @@
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadNeoForge" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadLiteLoader" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" />
@@ -10,6 +10,7 @@
DlOptiFineListLoader.Start()
DlLiteLoaderListLoader.Start()
DlFabricListLoader.Start()
DlNeoForgeListLoader.Start()
'重载预览
TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")}
@@ -26,6 +27,7 @@
LoadLiteLoader.State = DlLiteLoaderListLoader
LoadFabric.State = DlFabricListLoader
LoadFabricApi.State = DlFabricApiLoader
LoadNeoForge.State = DlNeoForgeListLoader
LoadOptiFabric.State = DlOptiFabricLoader
End Sub
@@ -51,6 +53,7 @@
CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True
CardNeoForge.IsSwaped = True
CardFabric.IsSwaped = True
CardFabricApi.IsSwaped = True
CardOptiFabric.IsSwaped = True
@@ -80,32 +83,36 @@
AniStart({
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10),
AaCode(Sub()
PanBack.ScrollToHome()
TextSelectName.Validate()
OptiFine_Loaded()
LiteLoader_Loaded()
Forge_Loaded()
Fabric_Loaded()
FabricApi_Loaded()
OptiFabric_Loaded()
SelectReload()
End Sub, After:=True),
AaCode(
Sub()
PanBack.ScrollToHome()
TextSelectName.Validate()
OptiFine_Loaded()
LiteLoader_Loaded()
Forge_Loaded()
NeoForge_Loaded()
Fabric_Loaded()
FabricApi_Loaded()
OptiFabric_Loaded()
SelectReload()
End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub()
PanMinecraft.Visibility = Visibility.Collapsed
PanBack.IsHitTestVisible = True
'初始化 Binding
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True)
AaCode(
Sub()
PanMinecraft.Visibility = Visibility.Collapsed
PanBack.IsHitTestVisible = True
'初始化 Binding
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnNeoForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardNeoForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
End Sub,, True)
}, "FrmDownloadInstall SelectPageSwitch", True)
End Sub
Public Sub ExitSelectPage()
@@ -213,6 +220,26 @@
End If
End Sub
'NeoForge
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private Sub SetNeoForgeInfoShow(IsShow As String)
If PanNeoForgeInfo.Tag = IsShow Then Exit Sub
PanNeoForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 100, 90)
}, "SetNeoForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 100)
}, "SetNeoForgeInfoShow")
End If
End Sub
'Fabric
Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String)
@@ -277,7 +304,7 @@
''' <summary>
''' 重载已选择的项目的显示。
''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True
'主预览
@@ -338,9 +365,30 @@
Else
BtnForgeClear.Visibility = Visibility.Visible
ImgForge.Visibility = Visibility.Visible
LabForge.Text = SelectedForge.Version
LabForge.Text = SelectedForge.VersionName
LabForge.Foreground = ColorGray1
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
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed
@@ -411,9 +459,16 @@
HintFabricAPI.Visibility = Visibility.Collapsed
End If
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
HintOptiFabric.Visibility = Visibility.Visible
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Visible
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
Else
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso
(SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then
@@ -434,6 +489,7 @@
SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing
SelectedForge = Nothing
SelectedNeoForge = Nothing
SelectedFabric = Nothing
SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing
@@ -449,7 +505,10 @@
Name += "-Fabric " & SelectedFabric.Replace("+build", "")
End If
If SelectedForge IsNot Nothing Then
Name += "-Forge_" & SelectedForge.Version
Name += "-Forge_" & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Name += "-NeoForge_" & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader"
@@ -468,7 +527,10 @@
Info += ", Fabric " & SelectedFabric.Replace("+build", "")
End If
If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.Version
Info += ", Forge " & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Info += ", NeoForge " & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader"
@@ -487,6 +549,8 @@
Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/NeoForge.png"
ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then
@@ -554,6 +618,12 @@
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
@@ -624,6 +694,7 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFineGetError() As String
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容
@@ -659,10 +730,12 @@
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
Forge.Version.After(".") >= OptiFine.RequiredForgeVersion)
If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0
Else 'XXXX
Return Forge.Version.Revision >= OptiFine.RequiredForgeVersion
End If
End Function
'限制展开
@@ -685,11 +758,12 @@
Next
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Versions = Sort(Versions,
Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
'可视化
PanOptiFine.Children.Clear()
For Each Version In Versions
@@ -706,6 +780,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded()
Forge_Loaded()
NeoForge_Loaded()
CardOptiFine.IsSwaped = True
SelectReload()
End Sub
@@ -715,6 +790,7 @@
CardOptiFine.IsSwaped = True
e.Handled = True
Forge_Loaded()
NeoForge_Loaded()
SelectReload()
End Sub
@@ -800,6 +876,7 @@
Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
@@ -829,16 +906,15 @@
If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList
Versions = Sort(Versions, Function(a, b) a.Version > b.Version).Where(
Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList()
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
@@ -866,6 +942,67 @@
#End Region
#Region "NeoForge 列表"
''' <summary>
''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadNeoForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本"
If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message
If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then
Return Nothing
Else
Return "没有可用版本"
End If
End Function
'限制展开
Private Sub CardNeoForge_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardNeoForge.PreviewSwap
If LoadNeoForgeGetError() IsNot Nothing Then e.Handled = True
End Sub
''' <summary>
''' 尝试重新可视化 NeoForge 版本列表。
''' </summary>
Private Sub NeoForge_Loaded() Handles LoadNeoForge.StateChanged
Try
'获取版本列表
If DlNeoForgeListLoader.State <> LoadState.Finished Then Exit Sub
Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = SelectedMinecraftId).ToList
If Not Versions.Any() Then Exit Sub
'可视化
PanNeoForge.Children.Clear()
NeoForgeDownloadListItemPreload(PanNeoForge, Versions, AddressOf NeoForge_Selected, False)
For Each Version In Versions
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", LogLevel.Feedback)
End Try
End Sub
'选择与清除
Private Sub NeoForge_Selected(sender As MyListItem, e As EventArgs)
SelectedNeoForge = sender.Tag
CardNeoForge.IsSwaped = True
OptiFine_Loaded()
SelectReload()
End Sub
Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp
SelectedNeoForge = Nothing
CardNeoForge.IsSwaped = True
e.Handled = True
OptiFine_Loaded()
SelectReload()
End Sub
#End Region
#Region "Fabric 列表"
''' <summary>
@@ -877,7 +1014,7 @@
For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
Return Nothing
End If
Next
@@ -1064,6 +1201,7 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
@@ -1109,7 +1247,8 @@
PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected))
Next
'自动选择 OptiFabric
If Not AutoSelectedOptiFabric Then
If Not AutoSelectedOptiFabric AndAlso
Not (SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15")) Then '1.14~15 不自动选择
AutoSelectedOptiFabric = True
Log($"[Download] 已自动选择 OptiFabric:{CType(PanOptiFabric.Children(0), MyListItem).Title}")
OptiFabric_Selected(PanOptiFabric.Children(0), Nothing)
@@ -1141,7 +1280,7 @@
End Sub
Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf &
"因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
@@ -1157,6 +1296,7 @@
.MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine,
.ForgeEntry = SelectedForge,
.NeoForgeEntry = SelectedNeoForge,
.FabricVersion = SelectedFabric,
.FabricApi = SelectedFabricApi,
.OptiFabric = SelectedOptiFabric,
@@ -43,39 +43,47 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem x:Name="ItemNeoForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="NeoForge"
LogoScale="0.95" Logo="M544.6 921.2l-23.7 32.6c14.1 10.2 33.3 10.2 47.5 0l-23.7-32.6zM114.6 608.5l-23.9 32.5 0.2 0.1 23.6-32.6z m-12.0-38.0l38.3 12.7v-0.2l-38.3-12.4z m49.2-152.6l-38.4-12.4 38.4 12.4zM250.2 114.4l-37.6-14.6a40.2 40.2 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.0 29.9 0.2-0.2-27.2-29.7z m11.7-4.5V63.0v40.4z m11.7 4.5l28.0-29.0a40.5 40.5 0 0 0-0.8-0.8l-27.2 29.8z m4.4 7.3l-38.6 11.7a40.5 40.5 0 0 0 0.2 0.7l38.3-12.4zM381.0 417.7l-38.4 12.5a40.3 40.3 0 0 0 38.4 27.8v-40.3z m327.0 0v40.3c17.5 0 32.9-11.2 38.4-27.8L708.1 417.7z m98.5-303.3l-37.6-14.6a38.4 38.4 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.1 29.9 0.1-0.2-27.2-29.7z m11.7-4.5v0z m11.7 4.5l28.0-29.0a38.4 38.4 0 0 0-0.8-0.8l-27.2 29.8z m4.3 7.3l-38.6 11.7a47.5 47.5 0 0 0 0.2 0.7l38.4-12.4z m98.5 303.3l-38.4 12.4 0.1 0.5 38.2-12.9z m51.2 151.9l38.7-11.3a34.5 34.5 0 0 0-0.5-1.6l-38.1 12.9z m-37.8 5.2l-430.0 312.6 47.5 65.3 429.9-312.6-47.5-65.3z m-382.5 312.6L138.3 575.8l-47.5 65.3L520.9 953.9l47.3-65.3zM138.5 576a6.4 6.4 0 0 1 2.3 3.2l-76.9 24.5c4.7 14.9 14.1 28.0 26.7 37.3l47.8-65.0z m2.3 3.2a6.4 6.4 0 0 1 0 4.0L64.1 557.9a74.3 74.3 0 0 0-0.2 45.8l76.9-24.5z m0 3.7l49.2-152.6-76.8-24.8L64.0 558.2l76.8 24.8z m49.2-152.5l98.5-303.3-76.8-25.0L113.3 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9L227.6 78.0a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6A57.7 57.7 0 0 0 266.4 63.0v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.3 57.3 0 0 0-15.0-24.5l-56.1 58.0z m-5.8-9.2l98.4 302.5 76.8-25.0-98.5-302.5-76.8 25.0z m136.8 330.4H708.1V377.5H381.2v80.7z m365.4-27.8l98.5-303.3-76.8-25.0L669.6 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9l-54.1-59.9a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6a57.7 57.7 0 0 0-38.9-15.1v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.4 57.4 0 0 0-14.9-24.5l-56.1 58.0z m-5.8-9.2l98.5 303.3 76.8-25.0-98.5-303.3-76.8 25.0z m98.6 303.8l51.2 151.9 76.5-25.8-51.2-151.9-76.5 25.8z m50.7 150.2a6.5 6.5 0 0 1 0.1-4.0l75.6 28.1c5.5-14.9 6.2-31.3 1.6-46.7l-77.5 22.6z m0.1-4.0a6.4 6.4 0 0 1 2.4-3.2l43.8 67.8c13.4-8.7 23.6-21.5 29.2-36.4l-75.6-28.1z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="7" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="8" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="9" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="10" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
<local:MyIconButton Tag="9" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="11" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="12" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="12" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel>
</local:MyPageLeft>
@@ -10,7 +10,7 @@
''' <summary>
''' 勾选事件改变页面。
''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -31,6 +31,9 @@
Case FormMain.PageSubType.DownloadForge
If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge
Return FrmDownloadForge
Case FormMain.PageSubType.DownloadNeoForge
If FrmDownloadNeoForge Is Nothing Then FrmDownloadNeoForge = New PageDownloadNeoForge
Return FrmDownloadNeoForge
Case FormMain.PageSubType.DownloadLiteLoader
If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader
Return FrmDownloadLiteLoader
@@ -69,17 +72,19 @@
FrmMain.PageRight = Target
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit()
AniStart({
AaCode(Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
AaCode(
Sub()
CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit()
FrmMain.PanMainRight.Child = FrmMain.PageRight
FrmMain.PageRight.Opacity = 0
End Sub, 130),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
FrmMain.PageRight.Opacity = 1
FrmMain.PageRight.PageOnEnter()
End Sub, 30, True)
}, "PageLeft PageChange")
End Sub
#End Region
@@ -91,6 +96,7 @@
DlClientListLoader.Start(IsForceRestart:=True)
DlOptiFineListLoader.Start(IsForceRestart:=True)
DlForgeListLoader.Start(IsForceRestart:=True)
DlNeoForgeListLoader.Start(IsForceRestart:=True)
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
DlFabricListLoader.Start(IsForceRestart:=True)
DlFabricApiLoader.Start(IsForceRestart:=True)
@@ -117,6 +123,9 @@
Case FormMain.PageSubType.DownloadForge
DlForgeListLoader.Start(IsForceRestart:=True)
ItemForge.Checked = True
Case FormMain.PageSubType.DownloadNeoForge
DlNeoForgeListLoader.Start(IsForceRestart:=True)
ItemNeoForge.Checked = True
Case FormMain.PageSubType.DownloadLiteLoader
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
ItemLiteLoader.Checked = True
@@ -154,12 +163,14 @@
ItemOptiFine.Visibility = Visibility.Visible
ItemFabric.Visibility = Visibility.Visible
ItemForge.Visibility = Visibility.Visible
ItemNeoForge.Visibility = Visibility.Visible
ItemLiteLoader.Visibility = Visibility.Visible
RunInThread(Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
'折叠手动安装
Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp
@@ -170,14 +181,16 @@
LabHand.Visibility = Visibility.Collapsed
ItemClient.Visibility = Visibility.Collapsed
ItemOptiFine.Visibility = Visibility.Collapsed
ItemNeoForge.Visibility = Visibility.Collapsed
ItemFabric.Visibility = Visibility.Collapsed
ItemForge.Visibility = Visibility.Collapsed
ItemLiteLoader.Visibility = Visibility.Collapsed
RunInThread(Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
End Class
@@ -38,7 +38,7 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 LiteLoader 版本列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -33,6 +33,8 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -40,12 +40,14 @@
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
@@ -89,11 +91,12 @@
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] Mod 切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
#Region "搜索"
@@ -0,0 +1,27 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadNeoForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.19+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
EventType="打开网页" EventData="https://neoforged.net/" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 NeoForge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,34 @@
Public Class PageDownloadNeoForge
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlNeoForgeListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict = DlNeoForgeListLoader.Output.Value.GroupBy(Function(d) d.Inherit).OrderByDescending(Function(g) g.Key).
ToDictionary(Function(g) g.Key, Function(g) g.ToList())
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlNeoForgeListEntry)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 13}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
End Class
@@ -13,7 +13,7 @@
'归类
Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry))
Dict.Add("快照版本", New List(Of DlOptiFineListEntry))
For VersionCode As Integer = 30 To 0 Step -1
For VersionCode As Integer = 50 To 0 Step -1
Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry))
Next
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
@@ -42,14 +42,10 @@
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 OptiFine 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadOptiFine(sender.Tag)
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/")
End Sub
@@ -32,6 +32,8 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -59,7 +61,7 @@
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
@@ -39,12 +39,14 @@
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.2)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
@@ -241,7 +241,8 @@ Retry:
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -21,6 +21,27 @@
'加载版本
RunInNewThread(
Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
'确认自动安装
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Setup.Set("LaunchFolderSelect", "$.minecraft\")
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If
End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +56,27 @@
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Dim InstallLoader = ModpackInstall(PackInstallPath)
If InstallLoader Is Nothing Then
Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
Else
Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
End If
End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
@@ -619,7 +650,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候"
FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
@@ -27,15 +27,16 @@
''' 刷新自定义主页。
''' </summary>
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
RunInNewThread(
Sub()
Try
SyncLock RefreshLock
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub
Private Sub RefreshReal()
Dim Content As String = ""
@@ -155,7 +156,6 @@ Download:
Else
Log(ex, $"联网下载自定义主页失败({Address})")
End If
Address = ""
End Try
End Sub
@@ -204,7 +204,7 @@ Download:
End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI,最终内容长度:{Content.Count}")
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Try
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
@@ -71,9 +71,9 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")))
OpenWebsite(If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")))
Else
Dim Website As String = If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
Dim Website As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If
End Sub
@@ -58,19 +58,21 @@
Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存
Setup.Set("CacheAuthName", "")
RunInThread(Sub()
Try
Dim Data As McLoginServer = GetLoginData()
Data.ForceReselectProfile = True
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", LogLevel.Hint)
End Try
End Sub)
RunInThread(
Sub()
Try
Dim Data As McLoginServer = GetLoginData()
Data.ForceReselectProfile = True
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", LogLevel.Hint)
End Try
End Sub)
End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "")
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -39,14 +39,15 @@
Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")}
Dim Result As McLoginMs = Nothing
RunInUiWait(Sub()
If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then
Result = New McLoginMs
Else
Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem
Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title}
End If
End Sub)
RunInUiWait(
Sub()
If FrmLoginMs.ComboAccounts.SelectedIndex = 0 Then
Result = New McLoginMs
Else
Dim Item As MyListItem = FrmLoginMs.ComboAccounts.SelectedItem
Result = New McLoginMs With {.OAuthRefreshToken = Item.Tag, .UserName = Item.Title}
End If
End Sub)
Return Result
End Function
''' <summary>
@@ -29,7 +29,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.net/a/LTCat" />
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid>
</local:MyCard>
@@ -55,7 +55,7 @@
<local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" />
<local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" />
<local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" />
<local:MyListItem Title="DoodleHuang" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了部分很难找到的 Minecraft 版本与一些技术支持!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 中国 Mod 下载镜像源和帮助库图床!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" />
<local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" />
<local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" />
@@ -75,7 +75,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
</Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/DoodleHuang.png" Grid.Row="3" Margin="3">
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/z0z0r4.png" Grid.Row="3" Margin="3">
<Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip>
@@ -104,138 +104,91 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者">
<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">
<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="shyzysa" />
<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="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="leon" />
<TextBlock Width="120" Margin="0,1.5" Text="clnb" />
<TextBlock Width="120" Margin="0,1.5" Text="123" />
<TextBlock Width="120" Margin="0,1.5" Text="lihaoran0313" />
<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="冷月溪影" />
<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="Akn123" />
<TextBlock Width="120" Margin="0,1.5" Text="Dfkeit" />
<TextBlock Width="120" Margin="0,1.5" Text="CloudLonngLee" />
<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="夜也" />
<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="空染" />
<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="帝王尬笑" />
<TextBlock Width="120" Margin="0,1.5" Text="DarkKCat" />
<TextBlock Width="120" Margin="0,1.5" Text="我将如闪电般归来" />
<TextBlock Width="120" Margin="0,1.5" Text="TSLOLY" />
<TextBlock Width="120" Margin="0,1.5" Text="JackX" />
<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="Vaincre_VV" />
<TextBlock Width="120" Margin="0,1.5" Text="小明爱睡觉" />
<TextBlock Width="120" Margin="0,1.5" Text="YHLin" />
<TextBlock Width="120" Margin="0,1.5" Text="翁yy" />
<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="Quittskii" />
<TextBlock Width="120" Margin="0,1.5" Text="W2erty" />
<TextBlock Width="120" Margin="0,1.5" Text="Chris_Dream" />
<TextBlock Width="120" Margin="0,1.5" Text="sanrenxin" />
<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="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="tianguaren" />
<TextBlock Width="120" Margin="0,1.5" Text="bitlogi" />
<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="于书墨" />
<TextBlock Width="120" Margin="0,1.5" Text="御坂1354号" />
<TextBlock Width="120" Margin="0,1.5" Text="t7fihb8" />
<TextBlock Width="120" Margin="0,1.5" Text="44.5GB" />
<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="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="小烨爱吃尖椒鸡" />
<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="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" />
<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="GhostZiLie" />
<TextBlock Width="120" Margin="0,1.5" Text="靈曦蠡醯" />
<TextBlock Width="120" Margin="0,1.5" Text="zzdr" />
<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="fill" />
<TextBlock Width="120" Margin="0,1.5" Text="法老" />
<TextBlock Width="120" Margin="0,1.5" Text="aleafsautumn" />
<TextBlock Width="120" Margin="0,1.5" Text="聪明的凉生" />
<TextBlock Width="120" Margin="0,1.5" Text="干嘛1337" />
<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="Raper_Sulin" />
<TextBlock Width="120" Margin="0,1.5" Text="vv" />
<TextBlock Width="120" Margin="0,1.5" Text="QuinnL" />
<TextBlock Width="120" Margin="0,1.5" Text="pigeno" />
<TextBlock Width="120" Margin="0,1.5" Text="whx61" />
<TextBlock Width="120" Margin="0,1.5" Text="peoprem" />
<TextBlock Width="120" Margin="0,1.5" Text="慕言" />
<TextBlock Width="120" Margin="0,1.5" Text="白雾云-白少" />
<TextBlock Width="120" Margin="0,1.5" Text="S0CK" />
<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="DsxiaKsxia" />
<TextBlock Width="120" Margin="0,1.5" Text="lucca" />
<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="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="king" />
<TextBlock Width="120" Margin="0,1.5" Text="zzhm" />
<TextBlock Width="120" Margin="0,1.5" Text="半自动M9716" />
<TextBlock Width="120" Margin="0,1.5" Text="MMIAO780" />
<TextBlock Width="120" Margin="0,1.5" Text="7930" />
<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="a酱" />
<TextBlock Width="240" Margin="0,1.5" Text="Pedlar Mayweather" />
<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="lawaass" />
<TextBlock Width="120" Margin="0,1.5" Text="scz" />
<TextBlock Width="120" Margin="0,1.5" Text="tiredl" />
<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="PIGEON" />
<TextBlock Width="120" Margin="0,1.5" Text="Redio" />
<TextBlock Width="120" Margin="0,1.5" Text="无垠星海" />
<TextBlock Width="120" Margin="0,1.5" Text="Z10" />
<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="LG.神梦" />
<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="qianlan" />
<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="小比登T^T" />
<TextBlock Width="120" Margin="0,1.5" Text="北川兔兔" />
<TextBlock Width="120" Margin="0,1.5" Text="q_q!!!" />
<TextBlock Width="120" Margin="0,1.5" Text="eric" />
<TextBlock Width="120" Margin="0,1.5" Text="Min" />
<TextBlock Width="120" Margin="0,1.5" Text="JTOPfujo》" />
<TextBlock Width="120" Margin="0,1.5" Text="CZALIZI" />
<TextBlock Width="120" Margin="0,1.5" Text="outsider" />
<TextBlock Width="120" Margin="0,1.5" Text="Kimmo" />
<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="chsero" />
<TextBlock Width="120" Margin="0,1.5" Text="幽梦瞳鸭" />
<TextBlock Width="120" Margin="0,1.5" Text="Thankscrazy" />
</WrapPanel>
<Grid Height="35">
@@ -245,7 +198,7 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.net/a/LTCat" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
@@ -254,12 +207,12 @@
<local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True">
<StackPanel Margin="25,39,23,20">
<TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件会汇报自己的版本名与版本号,以统计用户数量与各版本的用户数量占比。除此之外,本软件不会上传您的任何信息。&#13;若您能提供未经外部修改的本软件本体上传隐私信息的确凿证据,开发者会向您支付 PCL 开发所获全部净收入。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件的 User Agent 中包含启动器的版本号,以统计各版本的用户数量。&#13;除此之外,本软件不会向开发者上传任何其他信息。" TextWrapping="Wrap" />
<TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱: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">
<local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" />
<local:MyButton Text="查看源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
<local:MyButton Text="开源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</StackPanel>
</StackPanel>
</local:MyCard>
@@ -19,7 +19,7 @@
End Sub
Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click
OpenWebsite("https://afdian.net/a/bangbang93")
OpenWebsite("https://afdian.com/a/bangbang93")
End Sub
Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click
OpenWebsite("https://www.mcmod.cn")
@@ -27,7 +27,7 @@
Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click
ClipboardSet(UniqueAddress)
End Sub
Private Sub DonateCodeInput() Handles BtnDonateInput.Click
Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput()
End Sub
@@ -38,17 +38,21 @@
CardName = "常规版本"
Case McVersionCardType.API
Dim IsForgeExists As Boolean = False
Dim IsNeoForgeExists As Boolean = False
Dim IsFabricExists As Boolean = False
Dim IsLiteExists As Boolean = False
For Each Version As McVersion In Card.Value
If Version.Version.HasFabric Then IsFabricExists = True
If Version.Version.HasLiteLoader Then IsLiteExists = True
If Version.Version.HasForge Then IsForgeExists = True
If Version.Version.HasNeoForge Then IsNeoForgeExists = True
Next
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) > 1 Then
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then
CardName = "可安装 Mod"
ElseIf IsForgeExists Then
CardName = "Forge 版本"
ElseIf IsNeoForgeExists Then
CardName = "NeoForge 版本"
ElseIf IsLiteExists Then
CardName = "LiteLoader 版本"
Else
@@ -210,8 +214,8 @@
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub
'修改此代码时,同时修改 PageVersionOverall 中的代码
Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion)
'修改此代码时,同时修改 PageVersionOverall 中的代码
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder
@@ -108,6 +108,7 @@
{"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", 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)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -163,6 +164,7 @@
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)},
@@ -7,9 +7,9 @@
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,皮肤预览与 Steve/Alex/自定义 选项暂时仅保证对 1.19.2 以前的版本有效!" IsWarn="False" Margin="0,0,0,10" />
<local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" IsWarn="True" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -206,10 +206,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49)
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If
'设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -259,7 +257,6 @@
End If
If RamTextLeft <> Left Then
RamTextLeft = Left
'If AniControlEnabled = 0 Then
Select Case Left
Case 0
AniStart({
@@ -280,22 +277,6 @@
AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100)
}, "SetupLaunch Ram TextLeft")
End Select
'Else
' Select Case Left
' Case 0
' LabRamUsed.Opacity = 0
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0
' Case 1
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 0
' LabRamUsedTitle.Opacity = 0.7
' Case 2
' LabRamUsed.Opacity = 1
' LabRamTotal.Opacity = 1
' LabRamUsedTitle.Opacity = 0.7
' End Select
'End If
End If
'右侧
Dim Right As Integer
@@ -404,15 +385,14 @@ PreFin:
RamGive = (Value - 12) * 0.5 + 1.5
ElseIf Value <= 33 Then
RamGive = (Value - 25) * 1 + 8
ElseIf Value <= 41 Then
RamGive = (Value - 33) * 2 + 16
Else
RamGive = (Value - 41) * 4 + 32
RamGive = (Value - 33) * 2 + 16
End If
End If
'若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive)
Return RamGive
'封顶 32G
Return Math.Min(32, RamGive)
End Function
#End Region
@@ -557,8 +537,8 @@ PreFin:
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化耗时较长,这会拖慢游戏的启动过程,建议仅在电脑内存不充裕时开启此选项。" & vbCrLf &
"如果你在使用机械硬盘,这还可能会导致一小段时间的严重卡顿。" &
If MyMsgBox("内存优化会显著延长启动耗时,建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘,这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
@@ -20,6 +20,8 @@
<RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="27" />
<RowDefinition Height="27" />
<RowDefinition Height="Auto" />
@@ -31,32 +33,38 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" />
<local:MyComboBoxItem Content="在官方源加载缓慢时改用镜像源(平衡)" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本为最新,但加载非常缓慢)" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本最新,但加载缓慢)" />
</local:MyComboBox>
<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"
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 信息获取" Margin="0,0,25,0" />
<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 的默认文件名中,中文译名应该放在哪个位置">
<local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" />
<local:MyComboBoxItem Content="译名位于文件名开头:遗物-relics-0.1.14" />
<local:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" />
<local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="4" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
<TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="6" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" />
<TextBlock VerticalAlignment="Center" Grid.Row="5" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
<TextBlock VerticalAlignment="Center" Grid.Row="7" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="7" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" />
<local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2"
<TextBlock VerticalAlignment="Top" Grid.Row="9" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,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="10" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" />
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="11" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2"
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="12" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" />
</Grid>
@@ -93,7 +101,8 @@
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="5" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" />
@@ -116,15 +125,23 @@
<local:ValidateFolderPath UseMinecraftCharCheck="False" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,5,0,0">
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,12,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemSettingExp" MinWidth="140" Text="导出设置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemSettingImp" MinWidth="140" Text="导入设置" Padding="13,0" Margin="0,0,20,0" />
</Grid>
<Grid Height="35" Grid.Row="7" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
</Grid>
</Grid>
</local:MyCard>
@@ -35,7 +35,10 @@
'重复加载部分
PanBack.ScrollToHome()
#If Not BETA Then
#If BETA Then
PanDonate.Visibility = Visibility.Collapsed
#Else
PanDonate.Visibility = Visibility.Visible
ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)"
#End If
@@ -56,6 +59,7 @@
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion")
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert")
@@ -90,6 +94,7 @@
Setup.Reset("ToolDownloadKeepModpack")
Setup.Reset("ToolDownloadIgnoreQuilt")
Setup.Reset("ToolDownloadCert")
Setup.Reset("ToolDownloadMod")
Setup.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese")
@@ -117,7 +122,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, 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)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
@@ -212,4 +217,15 @@
End Try
End Function
#Region "导出 / 导入设置"
Private Sub BtnSystemSettingExp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingExp.Click
Hint("该功能尚在开发中!")
End Sub
Private Sub BtnSystemSettingImp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingImp.Click
Hint("该功能尚在开发中!")
End Sub
#End Region
End Class
@@ -41,8 +41,8 @@
'设置解锁
If Not RadioLauncherTheme8.IsEnabled Then LabLauncherTheme8Copy.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁。" & vbCrLf & "右键打开赞助页面,如果觉得 PCL 做得还不错就支持一下吧 =w=!"
RadioLauncherTheme8.ToolTip = "累积赞助达到 ¥23.33 后,在爱发电私信发送【解锁码】以解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在 Issue 标记为 [已完成] 后回复 Issue 要求解锁(右键打开反馈页面)" & vbCrLf & "· 向帮助库提交 Pull Request,在龙猫合并后解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在反馈标记为 [完成] 后回复 Issue 要求解锁" & vbCrLf & "· 向帮助库提交 Pull Request,在龙猫合并后解锁"
If Not RadioLauncherTheme9.IsEnabled Then LabLauncherTheme9Copy.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁(右键打开反馈页面)" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
RadioLauncherTheme9.ToolTip = "· 反馈一个 Bug,在标记为 [完成] 后回复识别码要求解锁" & vbCrLf & "· 提交一个 Pull Request,在合并后回复识别码要求解锁"
'极客蓝的处理在 ThemeCheck 中
End Sub
@@ -83,7 +83,11 @@
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
TextCustomNet.Text = Setup.Get("UiCustomNet")
@@ -360,27 +364,28 @@ Refresh:
End Sub
Private Sub BtnMusicClear_Click(sender As Object, e As EventArgs) Handles BtnMusicClear.Click
If MyMsgBox("即将删除背景音乐文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
RunInThread(Sub()
Hint("正在删除背景音乐……")
'停止播放音乐
MusicNAudio = Nothing
MusicWaitingList = New List(Of String)
MusicAllList = New List(Of String)
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(Path & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Finish)
Catch ex As Exception
Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
End Try
Try
Directory.CreateDirectory(Path & "PCL\Musics")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Hint("正在删除背景音乐……")
'停止播放音乐
MusicNAudio = Nothing
MusicWaitingList = New List(Of String)
MusicAllList = New List(Of String)
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(Path & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Finish)
Catch ex As Exception
Log(ex, "删除背景音乐失败", LogLevel.Msgbox)
End Try
Try
Directory.CreateDirectory(Path & "PCL\Musics")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", LogLevel.Msgbox)
End Try
End Sub)
End If
End Sub
Private Sub CheckMusicStart_Change() Handles CheckMusicStart.Change
@@ -423,9 +428,9 @@ Refresh:
RadioLauncherTheme5Gray.Opacity -= 0.23
RadioLauncherTheme5.Opacity += 0.23
AniStart({
AaOpacity(RadioLauncherTheme5Gray, 1, 1000),
AaOpacity(RadioLauncherTheme5, -1, 1000)
}, "ThemeUnlock")
AaOpacity(RadioLauncherTheme5Gray, 1, 1000),
AaOpacity(RadioLauncherTheme5, -1, 1000)
}, "ThemeUnlock")
If RadioLauncherTheme5Gray.Opacity < 0.08 Then
ThemeUnlock(5, UnlockHint:="隐藏主题 玄素黑 已解锁!")
AniStop("ThemeUnlock")
@@ -433,7 +438,7 @@ Refresh:
End If
End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse LabLauncherTheme11Click.ToolTip.ToString.Contains("点击") Then
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then
If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
@@ -446,7 +451,7 @@ Refresh:
End If
End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
OpenWebsite("https://afdian.net/a/LTCat")
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
PageOtherLeft.TryFeedback()
@@ -659,23 +664,15 @@ Refresh:
'公开预览版
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.net/a/LTCat")
OpenWebsite("https://afdian.com/a/LTCat")
End Sub
'滑动条
Private Sub SliderLoad()
SliderMusicVolume.GetHintText = Function(Value As Integer)
Return Math.Ceiling(Value * 0.1) & "%"
End Function
SliderLauncherOpacity.GetHintText = Function(Value As Integer)
Return Math.Round(40 + Value * 0.1) & "%"
End Function
SliderLauncherHue.GetHintText = Function(Value As Integer)
Return Value & "°"
End Function
SliderLauncherSat.GetHintText = Function(Value As Integer)
Return Value & "%"
End Function
SliderMusicVolume.GetHintText = Function(v) Math.Ceiling(v * 0.1) & "%"
SliderLauncherOpacity.GetHintText = Function(v) Math.Round(40 + v * 0.1) & "%"
SliderLauncherHue.GetHintText = Function(v) v & "°"
SliderLauncherSat.GetHintText = Function(v) v & "%"
SliderLauncherDelta.GetHintText = Function(Value As Integer)
If Value > 90 Then
Return "+" & (Value - 90)
@@ -694,12 +691,8 @@ Refresh:
Return Value - 20
End If
End Function
SliderBackgroundOpacity.GetHintText = Function(Value As Integer)
Return Math.Round(Value * 0.1) & "%"
End Function
SliderBackgroundBlur.GetHintText = Function(Value As Integer)
Return Value & " 像素"
End Function
SliderBackgroundOpacity.GetHintText = Function(v) Math.Round(v * 0.1) & "%"
SliderBackgroundBlur.GetHintText = Function(v) v & " 像素"
End Sub
End Class
@@ -60,11 +60,9 @@ Public Class PageSpeedLeft
End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try
SyncLock LoaderTaskbarLock
For Each Loader In LoaderTaskbar.ToList
TaskRefresh(Loader)
Next
End SyncLock
For Each Loader In LoaderTaskbar.ToList
TaskRefresh(Loader)
Next
Catch ex As Exception
Log(ex, "下载管理右栏监视出错", LogLevel.Feedback)
End Try
@@ -197,13 +195,11 @@ Public Class PageSpeedLeft
Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 由于下载管理卡片关闭,{Loader.Name} 已移出任务列表")
End SyncLock
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort())
Dim LoaderName = If(Loader Is Nothing, "null", Loader.Name)
RightCards.Remove(LoaderName)
LoaderTaskbar.TryTake(Loader)
Log($"[Taskbar] 关闭下载管理卡片:{LoaderName},且移出任务列表")
RunInThread(Sub() Loader?.Abort())
End Sub
'如果已经失败,再刷新一次,修改成失败的控件
If Loader.State = LoadState.Failed Then
@@ -7,7 +7,8 @@
<Grid>
<Grid x:Name="PanAllBack">
<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:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage">
<Grid Margin="15,15,0,15" Height="35">
@@ -24,6 +25,17 @@
</Grid>
</local:MyCard>
<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" />
</local:MyCard>
</StackPanel>
@@ -4,6 +4,11 @@
Private IsLoad As Boolean = False
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()
AniControlEnabled += 1
@@ -27,6 +32,8 @@
Public Sub RefreshList(Optional ForceReload As Boolean = False)
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表")
ViewModType = ViewType.All
BtnTypeAll.Checked = True
PanBack.ScrollToHome()
SearchBox.Text = ""
End If
@@ -125,33 +132,81 @@
''' 刷新结果显示。
''' </summary>
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()
For Each TargetMod In Mods
For Each TargetMod In ShowMods
PanList.Children.Add(ModItems(TargetMod.RawFileName))
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()
End Sub
''' <summary>
''' 刷新卡片标题。
''' </summary>
Private Sub RefreshTitle()
Dim Mods = PanList.Children.Cast(Of MyLocalModItem).Select(Function(i) i.Entry).ToList
Dim Counter = {0, 0, 0}
For Each ModEntity As McMod In Mods
Counter(ModEntity.State) += 1
Next
Dim TypeList As New List(Of String)
If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled))
If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable))
If Counter(McMod.McModState.Fine) > 0 Then TypeList.Insert(0, If(TypeList.Any, "启用 ", "") & Counter(McMod.McModState.Fine))
If Not IsSearching Then
PanListBack.Title = "Mod 列表 (" & Join(TypeList, ",") & ")"
ElseIf TypeList.Any() Then
PanListBack.Title = "搜索结果 (" & Join(TypeList, ",") & ")"
PanListBack.Title = "Mod 列表 - "
ElseIf PanList.Children.Count > 0 Then
PanListBack.Title = "搜索结果 - "
Else
PanListBack.Title = "无搜索结果"
PanListBack.Title = "无搜索结果 - "
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 Region
@@ -192,10 +247,14 @@
''' 全选。
''' </summary>
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
If SelectedMods.Count < PanList.Children.Count Then
ChangeAllSelected(True)
Dim CurrentSelected As Integer = 0
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
ChangeAllSelected(False)
ChangeCurrentSelected(False)
End If
End Sub
@@ -229,7 +288,7 @@
'改变下边栏状态
Private ShownCount As Integer = 0
Private Sub RefreshBottomBar()
Public Sub RefreshBottomBar()
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
@@ -256,6 +315,7 @@
'更新显示状态
If AniControlEnabled = 0 Then
If Selected Then
PanListBack.Margin = New Thickness(0, 0, 0, 95)
'仅在数量增加时播放出现/跳跃动画
If ShownCount >= NewCount Then
ShownCount = NewCount
@@ -272,6 +332,7 @@
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
PanListBack.Margin = New Thickness(0, 0, 0, 15)
'不重复播放隐藏动画
If ShownCount = 0 Then Return
ShownCount = 0
@@ -301,7 +362,7 @@
Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1
SelectedMods.Clear()
For Each Item As MyLocalModItem In PanList.Children
For Each Item As MyLocalModItem In ModItems.Values.ToList
Item.Checked = Value
If Value Then SelectedMods.Add(Item.Entry.RawFileName)
Next
@@ -309,6 +370,22 @@
'更新下边栏 UI
RefreshBottomBar()
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
Dim CacheAniControlEnabled = AniControlEnabled
AniControlEnabled = 0
@@ -316,7 +393,26 @@
AniControlEnabled += CacheAniControlEnabled
End Sub
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 Region
@@ -328,6 +424,7 @@
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)),
Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False)
RefreshResult(McModLoader.Output)
End Sub
Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True
@@ -607,8 +704,10 @@
If ModEntry.Comp IsNot Nothing Then
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge, If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))}})
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge,
If(PageVersionLeft.Version.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any)))}})
Else
'获取信息
Dim ContentLines As New List(Of String)
@@ -22,7 +22,7 @@
</Grid.ColumnDefinitions>
<TextBlock Grid.Row="0" Grid.ColumnSpan="4" Margin="0,0,0,9" HorizontalAlignment="Center" Text="该版本不可使用 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle Grid.Row="1" Grid.ColumnSpan="4" HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge 或 Fabric 等 Mod 加载器才能使用 Mod,请在下载页面重新安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本,并注意 Forge 在版本选择列表中的图标为铁砧,Fabric 的图标为丝绸。" TextWrapping="Wrap" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge、Fabric 等 Mod 加载器才能使用 Mod,请在下载页面安装这些版本。&#xa;如果你已经安装过了 Mod 加载器,那么你很可能选择了错误的版本,请点击版本选择按钮切换版本。" TextWrapping="Wrap" />
<local:MyButton Grid.Row="3" Grid.Column="1" Height="35" HorizontalAlignment="Center" x:Name="BtnDownload" MinWidth="140" Text="转到下载页面" Margin="10,10,10,0" Padding="13,0" ColorType="Highlight" />
<local:MyButton Grid.Row="3" Grid.Column="2" Height="35" HorizontalAlignment="Center" x:Name="BtnVersion" MinWidth="140" Text="版本选择" Margin="10,10,10,0" Padding="13,0" />
</Grid>
@@ -37,6 +37,7 @@
<local:MyComboBoxItem Content="红石灯(关)" Tag="pack://application:,,,/images/Blocks/RedstoneLampOff.png" />
<local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" />
<local:MyComboBoxItem Content="布料(Fabric)" Tag="pack://application:,,,/images/Blocks/Fabric.png" />
<local:MyComboBoxItem Content="狐狸(NeoForge)" Tag="pack://application:,,,/images/Blocks/NeoForge.png" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType">
@@ -127,6 +127,8 @@
'重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName)
'清理 ini 缓存
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
'遍历重命名所有文件与文件夹
For Each Entry As DirectoryInfo In New DirectoryInfo(NewPath).EnumerateDirectories
If Not Entry.Name.Contains(OldName) Then Continue For
@@ -282,26 +284,24 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中,请稍候!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
Hint("正在处理中,请稍候!", HintType.Critical)
Exit Sub
Next
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
Loader.OnStateChanged =
Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -312,8 +312,8 @@
End Sub
'删除版本
'修改此代码时,同时修改 PageSelectRight 中的代码
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
'修改此代码时,同时修改 PageSelectRight 中的代码
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
@@ -321,6 +321,7 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
@@ -77,6 +77,22 @@
<local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="VersionRamCustom" MaxValue="49" Value="13" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid>
<Grid Margin="0,5,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Margin="0,6,30,0" Text="启动游戏前进行内存优化" Grid.Row="1" Grid.Column="1" HorizontalAlignment="Left" />
<local:MyComboBox x:Name="ComboRamOptimize" Margin="10,0,0,0" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="2" Tag="VersionRamOptimize">
<local:MyComboBoxItem Content="使用全局设置" IsSelected="True" />
<local:MyComboBoxItem Content="开启" />
<local:MyComboBoxItem Content="关闭" />
</local:MyComboBox>
</Grid>
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
<Grid.ColumnDefinitions>
<ColumnDefinition x:Name="ColumnRamUsed" Width="4.7*"/>
@@ -51,6 +51,7 @@
'游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Version:=PageVersionLeft.Version)
'服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version)
@@ -95,6 +96,7 @@
Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamOptimize", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version)
@@ -130,7 +132,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change
@@ -163,10 +165,8 @@
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12
ElseIf RamTotal <= 16 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25
ElseIf RamTotal <= 32 Then
SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33
Else
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49)
SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 16) / 2) + 33, 41)
End If
'设置文本
LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" &
@@ -351,15 +351,14 @@ PreFin:
RamGive = (Value - 12) * 0.5 + 1.5
ElseIf Value <= 33 Then
RamGive = (Value - 25) * 1 + 8
ElseIf Value <= 41 Then
RamGive = (Value - 33) * 2 + 16
Else
RamGive = (Value - 41) * 4 + 32
RamGive = (Value - 33) * 2 + 16
End If
End If
'若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(PageVersionLeft.Version)) Then RamGive = Math.Min(1, RamGive)
Return RamGive
'封顶 32G
Return Math.Min(32, RamGive)
End Function
#End Region
@@ -38,7 +38,7 @@
<DefineDebug>false</DefineDebug>
<DefineTrace>false</DefineTrace>
<IncrementalBuild>true</IncrementalBuild>
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -55,7 +55,7 @@
<DefineTrace>false</DefineTrace>
<IncrementalBuild>false</IncrementalBuild>
<Optimize>true</Optimize>
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -100,7 +100,7 @@
<SignManifests>false</SignManifests>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -111,7 +111,7 @@
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -129,7 +129,7 @@
</AssemblyOriginatorKeyFile>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'">
<OutputPath>D:\Minecraft\程序\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DefineConstants>RELEASE,BY_UPDATE</DefineConstants>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
@@ -244,6 +244,9 @@
<Compile Include="Pages\PageDownload\PageDownloadCompDetail.xaml.vb">
<DependentUpon>PageDownloadCompDetail.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadNeoForge.xaml.vb">
<DependentUpon>PageDownloadNeoForge.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb">
<DependentUpon>PageDownloadPack.xaml</DependentUpon>
</Compile>
@@ -494,6 +497,10 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageDownload\PageDownloadNeoForge.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageDownload\PageDownloadPack.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
@@ -869,7 +876,6 @@
<Resource Include="Images\Heads\bangbang93.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\DoodleHuang.png" />
<Resource Include="Images\Heads\wiki.png" />
</ItemGroup>
<ItemGroup>
@@ -923,6 +929,11 @@
<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" />
</Project>
+20 -14
View File
@@ -79,7 +79,11 @@
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 后面添加一条竖线(|),竖线后填写服务器 IP,即可在启动该版本的同时自动进入服务器。" />
<local:MyButton Margin="0,4,0,0" Width="250" Height="35"
Text="启动 1.12.2 并进入 Hypixel" EventType="启动游戏" EventData="1.12.2|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
Text="启动 1.20.1 并进入 Hypixel" EventType="启动游戏" EventData="1.20.1|mc.hypixel.net" ToolTip="服务器 IP:mc.hypixel.net" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="在 EventData 中填写 \current,表示启动当前被选中的游戏版本,同样可以在后面填写服务器 IP。" />
<local:MyButton Margin="0,4,0,10" Width="250" Height="35"
Text="启动当前选中版本并进入 Hypixel" EventType="启动游戏" EventData="\current|mc.hypixel.net" ToolTip="启动当前版本" />
</StackPanel>
</local:MyCard>
@@ -144,7 +148,7 @@
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</StackPanel>
<!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
@@ -180,28 +184,30 @@
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="PCL 内置了一些 Minecraft 方块与物品图片,可以直接使用。"/>
<StackPanel Orientation="Horizontal" Margin="10,8,0,15" Height="30">
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 命令方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 圆石 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Cobblestone.png"/>
<!-- 金块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GoldBlock.png"/>
<!-- 草方块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Grass.png"/>
<!-- 草径 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/GrassPath.png"/>
<!-- 铁砧 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Anvil.png"/>
<!-- 红石块 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneBlock.png"/>
<!-- 红石灯(亮) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOn.png"/>
<!-- 红石灯(灭) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/RedstoneLampOff.png"/>
<!-- 鸡蛋 -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/>
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Egg.png"/>
<!-- 布料(Fabric 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/Fabric.png"/>
<!-- 狐狸(NeoForge 图标) -->
<Image Width="30" Margin="5,0,0,0" Source="pack://application:,,,/images/Blocks/NeoForge.png"/>
</StackPanel>
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
Text="使用时,将上方对应行的 Source 复制到 MyListItem 的 Logo 属性处即可。"/>
@@ -264,7 +270,7 @@
<local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid>
</StackPanel>
</local:MyCard>
Binary file not shown.
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/)
[![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=666666&color=1a7f37)](https://github.com/Hex-Dragon/PCL2/issues)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.net/@LTCat)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.com/@LTCat)
<br/>
@@ -16,7 +16,7 @@ PCL 的代码绝大多数其实都是几年前学生时代的产物了……那
## 相关内容
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
- [程序下载](https://afdian.net/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [程序下载](https://afdian.com/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
<br/>
Binary file not shown.