This commit is contained in:
LTCat
2026-10-17 03:39:13 +08:00
parent 9dcb799fb0
commit ade6e04c6e
65 changed files with 6989 additions and 2643 deletions
+28 -20
View File
@@ -6,12 +6,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.13.1.1" '显示用版本名
Public Const VersionBaseName As String = "2.14.0.0" '显示用版本名
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If RELEASE Then
Public Const VersionCode As Integer = 408 '正式版
Public Const VersionCode As Integer = 411 '正式版
#Else
Public Const VersionCode As Integer = 410 '快照版
Public Const VersionCode As Integer = 412 '快照版
#End If
'版本信息
@@ -47,7 +47,7 @@ Public Module ModBase
''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary>
Public PathTemp As String = If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
Public PathTemp As String = PathUtils.AddSlashSuffix(If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).Replace("/", "\"))
''' <summary>
''' 当前程序的语言。
''' </summary>
@@ -75,7 +75,7 @@ Public Module ModBase
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.Upper.First & ":\" '#3799
Public OsDrive As String = Environment.GetLogicalDrives().First(Function(p) Directory.Exists(p)) '#3799
Public ReadOnly Property ModeDebug As Boolean
Get
@@ -576,7 +576,7 @@ Public Module ModBase
Try
If String.IsNullOrEmpty(Folder) Then Return False
Folder = PathUtils.AddSlashSuffix(Folder)
If Folder.EndsWithF(":\System Volume Information\") OrElse Folder.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Folder.EndsWithF(":\System Volume Information\", True) OrElse Folder.EndsWithF(":\$RECYCLE.BIN\", True) Then Return False
If Not DirectoryUtils.Exists(Folder) Then Return False
Dim TestFilePath As String = $"{Folder}CheckPermission{GetUuid()}.txt"
FileUtils.Write(TestFilePath, "临时文件,用于检测该文件夹的权限是否正常。")
@@ -593,7 +593,7 @@ Public Module ModBase
Public Sub CheckPermissionWithException(Folder As String)
If String.IsNullOrWhiteSpace(Folder) Then Throw New ArgumentNullException("文件夹名不能为空!")
Folder = PathUtils.AddSlashSuffix(Folder)
If Folder.EndsWithF(":\System Volume Information\") OrElse Folder.EndsWithF(":\$RECYCLE.BIN\") Then Throw New UnauthorizedAccessException("没有对系统文件夹的权限!")
If Folder.EndsWithF(":\System Volume Information\", True) OrElse Folder.EndsWithF(":\$RECYCLE.BIN\", True) Then Throw New UnauthorizedAccessException("没有对系统文件夹的权限!")
If Not DirectoryUtils.Exists(Folder) Then Throw New DirectoryNotFoundException("文件夹不存在!")
Dim TestFilePath As String = $"{Folder}CheckPermission{GetUuid()}.txt"
FileUtils.Write(TestFilePath, "临时文件,用于检测该文件夹的权限是否正常。")
@@ -788,7 +788,7 @@ Public Module ModBase
''' <summary>
''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
''' </summary>
Public PathPure As Lazy(Of String) = New Lazy(Of String)(
Public PathPure As New Lazy(Of String)(
Function()
If Paths.Base.IsAsciiOnly() Then
Return Paths.Base & "PCL\"
@@ -845,6 +845,12 @@ Public Module ModBase
Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000
End Function
''' <summary>
''' 获取十进制 Unix 时间戳。
''' </summary>
Public Function ToUnixTimestampUtc(Time As Date) As Long
Return (Time.ToUniversalTime().Ticks - 621355968000000000) / 10000000
End Function
''' <summary>
''' 时间戳转化为日期。
''' </summary>
Public Function GetDate(timeStamp As Integer) As Date
@@ -1021,20 +1027,22 @@ Public Module ModBase
''' <summary>
''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
''' </summary>
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True, Optional SuccessHint As String = "")
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
RunInThread(
Sub()
RunInUi(
Sub()
Try
My.Computer.Clipboard.Clear()
If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
If ShowSuccessHint Then Hint(If(String.IsNullOrEmpty(SuccessHint), "已成功复制!", SuccessHint), HintType.Green)
Catch ex As Exception
Logger.Error(ex, behavior:=LogBehavior.None)
Hint("复制失败,可能由于剪贴板被其他程序占用!", HintType.Red)
End Try
End Sub)
Try
Retrier.Attempt(delay:=Function(Attempt) TimeSpan.FromMilliseconds(200), maxAttempts:=4, isRetryAllowed:=Function(ex) True, action:=
Sub()
RunInUiWait(
Sub()
My.Computer.Clipboard.Clear()
If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
End Sub)
End Sub)
If ShowSuccessHint Then Hint("已成功复制!", HintType.Green)
Catch ex As Exception
Logger.Error(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogBehavior.Toast)
End Try
End Sub)
End Sub
''' <summary>
@@ -1396,7 +1396,7 @@ FinishExCatch:
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
If Input IsNot Nothing Then Files = New ConcurrentQueue(Of NetFile)(CType(Input, IEnumerable(Of NetFile)))
'去重
Files = New ConcurrentQueue(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
Files = New ConcurrentQueue(Of NetFile)(Files.DistinctBy(Function(a) PathUtils.ForCompare(a.LocalPath).Lower()))
'设置剩余文件数
SyncLock FileRemainLock
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
@@ -1421,7 +1421,7 @@ FinishExCatch:
Next
If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!")
File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.Lower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath)
If Not File.LocalPath.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath)
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath)
DirectoryUtils.Create(PathUtils.RemoveLastPart(File.LocalPath)) '创建目标文件夹
Next
@@ -1519,7 +1519,7 @@ FinishExCatch:
Select(Function(FolderName) (FolderName, File.LocalPath.IndexOfF(FolderName, True))).
Where(Function(kv) kv.Item2 >= 0).ToList
If Not TypeIndexes.Any Then
If File.LocalName.EndsWithF(".jar") Then
If PathUtils.GetExtension(File.LocalName) = "jar" Then
TypeIndexes.Add(("\versions\", 1)) '总是对 jar 进行版本文件检查,以包括另存为 jar 的情况
Else
Return Nothing
@@ -1547,7 +1547,7 @@ FinishExCatch:
Case "versions\"
'版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders
For Each Candidate In DirectoryUtils.EnumerateFiles(VersionFolder, searchPattern:="*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
For Each Candidate In DirectoryUtils.EnumerateFiles(VersionFolder, searchPattern:="*." & PathUtils.GetExtension(File.LocalPath))
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
@@ -382,7 +382,7 @@ Public Class ValidateFolderPath
Public Overrides Function Validate(Str As String) As String
'去除尾部斜线,统一为 \
Str = Str.Replace("/", "\")
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
If Not PathUtils.RemoveSlashSuffix(Str).EndsWithF(":") Then Str = PathUtils.RemoveSlashSuffix(Str)
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If LengthCheck <> "" Then Return LengthCheck
@@ -92,7 +92,7 @@ Public Class CrashAnalyzer
'尝试视作压缩包解压
Try
Dim Info = FileUtils.GetInfo(FilePath)
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
If Info.Exists AndAlso Info.Length > 0 AndAlso Not PathUtils.GetExtension(FilePath) = "jar" Then
FileUtils.ExtractToDirectory(FilePath, TempFolder & "Temp\")
Logger.Info($"已解压导入的日志文件:{FilePath}")
GoTo Extracted
@@ -163,9 +163,9 @@ Extracted:
Else
TargetType = AnalyzeFileType.ExtraLogFile
End If
ElseIf MatchName.EndsWithF(".log", True) Then
ElseIf PathUtils.GetExtension(MatchName) = "log" Then
TargetType = AnalyzeFileType.ExtraLogFile
ElseIf MatchName.EndsWithF(".txt", True) Then
ElseIf PathUtils.GetExtension(MatchName) = "txt" Then
TargetType = AnalyzeFileType.ExtraReportFile
Else
Logger.Info($"{MatchName} 分类为 Ignore")
@@ -242,8 +242,6 @@ Public Module ModDownload
DlPreferMojang = DeltaTime < 4000
Logger.Info($"Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'MC 更新提示
@@ -438,7 +436,7 @@ Public Module ModDownload
.FileName = If(Name(i).ContainsIgnoreCase("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).AfterFirst(" ").Replace(" ", "_")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -581,7 +579,7 @@ Public Module ModDownload
If Version <> other.Version Then
Return Version.CompareTo(other.Version)
Else
Return CompareVersion(VersionName, other.VersionName)
Return McUtils.CompareVersion(VersionName, other.VersionName)
End If
End Function
End Class
@@ -18,7 +18,7 @@ Public Module ModJava
'强制选择的 Java
Dim SelectedJavaSetting = Settings.Get(Of String)("LaunchArgumentJavaSelect")
Dim SelectedJava = If(SelectedJavaSetting.StartsWithF("{"), SelectedJavaSetting.DeserializeJson(Of JObject)()("Path").ToString, "")
Dim Match = OldJavaList.FirstOrDefault(Function(j) j.Folder.Equals(SelectedJava, StringComparison.OrdinalIgnoreCase))
Dim Match = OldJavaList.FirstOrDefault(Function(j) PathUtils.IsSame(j.Folder, SelectedJava))
If Match IsNot Nothing Then
OldJavaList.Remove(Match)
OldJavaList.Insert(0, Match)
@@ -78,7 +78,7 @@ Public Module ModJava
Return
End If
'不再移除它
Configs.JavaRemovedList.Edit(Sub(ByRef List) List.RemoveIf(Function(f) f.Equals(NewJava.Folder, StringComparison.OrdinalIgnoreCase)))
Configs.JavaRemovedList.Edit(Sub(ByRef List) List.RemoveIf(Function(f) PathUtils.IsSame(f, NewJava.Folder)))
'加入列表顶部
Configs.JavaList.Edit(
Sub(ByRef List)
@@ -150,16 +150,16 @@ Public Module ModJava
End Sub
'原版 26-:通过版本号判断
If (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(Instance.Version.Vaild AndAlso Instance.Version.Vanilla >= New Version(20, 0, 5)) Then
If (Not Instance.Version.Valid AndAlso Instance.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(Instance.Version.Valid AndAlso Instance.Version.Vanilla >= New Version(20, 0, 5)) Then
'1.20.5+(24w14a+):至少 Java 21
AddConstraint(ValueRange(Of Version).AtLeast(New Version(21, 0)))
ElseIf (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(Instance.Version.Vaild AndAlso Instance.Version.Vanilla.Major >= 18) Then
ElseIf (Not Instance.Version.Valid AndAlso Instance.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(Instance.Version.Valid AndAlso Instance.Version.Vanilla.Major >= 18) Then
'1.18 pre2+:至少 Java 17
AddConstraint(ValueRange(Of Version).AtLeast(New Version(17, 0)))
ElseIf (Not Instance.Version.Vaild AndAlso Instance.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(Instance.Version.Vaild AndAlso Instance.Version.Vanilla.Major >= 17) Then
ElseIf (Not Instance.Version.Valid AndAlso Instance.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(Instance.Version.Valid AndAlso Instance.Version.Vanilla.Major >= 17) Then
'1.17+ (21w19a+):至少 Java 16
AddConstraint(ValueRange(Of Version).AtLeast(New Version(16, 0)))
ElseIf Instance.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
@@ -185,7 +185,7 @@ Public Module ModJava
End If
'OptiFine 检测
If Instance.Version.HasOptiFine AndAlso Instance.Version.Vaild Then '不管非标准版本
If Instance.Version.HasOptiFine AndAlso Instance.Version.Valid Then '不管非标准版本
If Instance.Version.Vanilla.Major < 7 Then
'<1.7:至多 Java 8
AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
@@ -199,11 +199,11 @@ Public Module ModJava
End If
'Forge 检测(部分测试结果见 #8432)
If Instance.Version.HasForge Then
If Instance.Version.ModLoaders.HasFlagF(ModLoaders.Forge) Then
If Instance.Version.Vanilla >= New Version(6, 0, 1) AndAlso Instance.Version.Vanilla <= New Version(7, 0, 2) Then
'1.6.1 - 1.7.2:必须 Java 7
AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(7, 0), New Version(8, 0)))
ElseIf Instance.Version.Vanilla.Major <= 12 OrElse Not Instance.Version.Vaild Then '非标准版本
ElseIf Instance.Version.Vanilla.Major <= 12 OrElse Not Instance.Version.Valid Then '非标准版本
'<=1.12:Java 8
AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
ElseIf Instance.Version.Vanilla.Major <= 14 Then
@@ -212,38 +212,38 @@ Public Module ModJava
ElseIf Instance.Version.Vanilla.Major = 15 Then
'1.15:Java 8 - 15
AddConstraint(ValueRange(Of Version).ClosedOpen(New Version(8, 0), New Version(16, 0)))
ElseIf CompareVersionGE(Instance.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", Instance.Version.Forge) Then
ElseIf McUtils.CompareVersionGE(Instance.Version.ModLoaderVersions(ModLoaders.Forge), "34.0.0") AndAlso McUtils.CompareVersionGE("36.2.25", Instance.Version.ModLoaderVersions(ModLoaders.Forge)) Then
'1.16.3~5,Forge 34.0.0 ~ 36.2.25:最高 Java 8u320
AddConstraint(ValueRange(Of Version).AtMost(New Version(8, 0, 320)))
ElseIf CompareVersionGE(Instance.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999999.999999", Instance.Version.Forge) Then
ElseIf McUtils.CompareVersionGE(Instance.Version.ModLoaderVersions(ModLoaders.Forge), "36.2.26") AndAlso McUtils.CompareVersionGE("36.999999.999999", Instance.Version.ModLoaderVersions(ModLoaders.Forge)) Then
'1.16.5,Forge 36.2.26+,<37.0.0:最高 Java 23
AddConstraint(ValueRange(Of Version).LessThan(New Version(24, 0)))
ElseIf CompareVersionGE(Instance.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", Instance.Version.Forge) Then
ElseIf McUtils.CompareVersionGE(Instance.Version.ModLoaderVersions(ModLoaders.Forge), "37.0.0") AndAlso McUtils.CompareVersionGE("37.0.79", Instance.Version.ModLoaderVersions(ModLoaders.Forge)) Then
'1.17.1,Forge 37.0.0 ~ 37.0.79:最高 Java 16
AddConstraint(ValueRange(Of Version).LessThan(New Version(17, 0)))
ElseIf Instance.Version.Vanilla.Major = 18 AndAlso Instance.Version.HasOptiFine Then '#305
'1.18:若安装了 OptiFine,最高 Java 18
AddConstraint(ValueRange(Of Version).LessThan(New Version(19, 0)))
ElseIf CompareVersionGE(Instance.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", Instance.Version.Forge) Then
ElseIf McUtils.CompareVersionGE(Instance.Version.ModLoaderVersions(ModLoaders.Forge), "45.0.21") AndAlso McUtils.CompareVersionGE("45.0.65", Instance.Version.ModLoaderVersions(ModLoaders.Forge)) Then
'1.19.4,Forge 45.0.21 ~ 45.0.65:最高 Java 19
AddConstraint(ValueRange(Of Version).LessThan(New Version(20, 0)))
ElseIf CompareVersionGE(Instance.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", Instance.Version.Forge) Then
ElseIf McUtils.CompareVersionGE(Instance.Version.ModLoaderVersions(ModLoaders.Forge), "45.0.66") AndAlso McUtils.CompareVersionGE("47.4.8", Instance.Version.ModLoaderVersions(ModLoaders.Forge)) Then
'1.19.4~1.20.1,Forge 45.0.66 ~ 47.4.8:最高 Java 21
AddConstraint(ValueRange(Of Version).LessThan(New Version(22, 0)))
End If
End If
'NeoForge 检测
If Instance.Version.HasNeoForge Then
If Instance.Version.ModLoaders.HasFlagF(ModLoaders.NeoForge) Then
If Instance.Version.Vanilla = New Version(20, 0, 1) OrElse
(CompareVersionGE("20.2.62-beta", Instance.Version.NeoForge) AndAlso Not Instance.Version.NeoForge.Contains("25w14craftmine")) Then
(McUtils.CompareVersionGE("20.2.62-beta", Instance.Version.ModLoaderVersions(ModLoaders.NeoForge)) AndAlso Not Instance.Version.ModLoaderVersions(ModLoaders.NeoForge).Contains("25w14craftmine")) Then
'1.20.1,以及 1.20.2 的 20.2.62-beta 之前:最高 Java 21
AddConstraint(ValueRange(Of Version).LessThan(New Version(22, 0)))
End If
End If
'Fabric 检测
If Instance.Version.HasFabric AndAlso Instance.Version.Vaild Then '不管非标准版本
If Instance.Version.ModLoaders.HasFlagF(ModLoaders.Fabric) AndAlso Instance.Version.Valid Then '不管非标准版本
If Instance.Version.Vanilla.Major >= 15 AndAlso Instance.Version.Vanilla.Major <= 16 Then
'1.15 - 1.16:Java 8+
AddConstraint(ValueRange(Of Version).AtLeast(New Version(8, 0)))
@@ -251,15 +251,14 @@ Public Module ModJava
'1.18+:Java 17+
AddConstraint(ValueRange(Of Version).AtLeast(New Version(17, 0)))
End If
If Instance.Version.Fabric <> "未知版本" AndAlso
CompareVersion(Instance.Version.Fabric, "0.17.0") < 0 Then
If Instance.Version.ModLoaderVersions(ModLoaders.Fabric) <> "未知版本" AndAlso McUtils.CompareVersion(Instance.Version.ModLoaderVersions(ModLoaders.Fabric), "0.17.0") < 0 Then
'Fabric Loader 0.16.x 及更早版本的 Mixin/ASM 不兼容 Java 25
AddConstraint(ValueRange(Of Version).LessThan(New Version(25, 0)))
End If
End If
'LiteLoader 检测
If Instance.Version.HasLiteLoader AndAlso Instance.Version.Vaild Then '不管非标准版本
If Instance.Version.ModLoaders.HasFlagF(ModLoaders.LiteLoader) AndAlso Instance.Version.Valid Then '不管非标准版本
'最高 Java 8
AddConstraint(ValueRange(Of Version).LessThan(New Version(9, 0)))
End If
@@ -411,9 +410,9 @@ Public Module ModJava
Dim Components = DownloadListWorker.LastResult
'确定要下载的目标 Java
Dim JavaToDownload As JavaDownloadInfo = If(
Components.FirstOrDefault(Function(Comp) Comp.Java("version")("name").ToString = RecommendedComponent), '优先选择指定的 Component
Components.FirstOrDefault(Function(Comp) Range.Contains(Comp.JavaVersion)))
Dim JavaToDownload As JavaDownloadInfo = Components.FirstOrDefault(
Function(Comp) Comp.Java("version")("name").ToString = RecommendedComponent, '优先选择指定的 Component
Function(Comp) Range.Contains(Comp.JavaVersion))
If JavaToDownload Is Nothing Then
Logger.Warn($"Mojang 提供的 Java 列表中没有合适的 Java,无法自动下载")
'提示需要手动下载 Java
@@ -48,7 +48,7 @@ Public Module ModLaunch
End Try
'检查版本
CurrentLaunchOptions.Instance.Load()
If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
If CurrentLaunchOptions.Instance.State = McInstance.McInstanceState.Error Then
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:{CurrentLaunchOptions.Instance.Info}", HintType.Red)
Return False
End If
@@ -57,6 +57,10 @@ Public Module ModLaunch
FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False)
End If
If McInstanceSelected IsNot Nothing AndAlso McInstanceLock.IsLocked(McInstanceSelected) Then
Hint($"版本 {McInstanceSelected.Name} 正在被修改,请稍后再启动!", HintType.Red)
Return False
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面(否则就可以在启动中切换 McInstanceSelected 了)
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
@@ -70,7 +74,12 @@ Public Module ModLaunch
''' </summary>
Public Sub McLaunchLog(Text As String, Optional Level As LogLevel = LogLevel.Info)
Text = FilterUserName(FilterAccessToken(Text, "*"), "*")
If ModeDebug Then RunInUi(Sub() FrmLaunchRight.LabLog.Text += $"{vbCrLf}[{Date.Now:HH':'mm':'ss'.'fff}] {Text}")
If ModeDebug Then
RunInUi(
Sub()
FrmLaunchRight.LabLog.AppendText($"[{Date.Now:HH':'mm':'ss'.'fff}] {Text}{vbCrLf}")
End Sub)
End If
Logger.Log(Text, Level)
End Sub
@@ -196,25 +205,6 @@ NextInner:
End Try
End Sub
''' <summary>
''' 取消正在进行的游戏启动。
''' </summary>
Public Sub McLaunchCancel()
If McLaunchLoaderReal IsNot Nothing Then
McLaunchLoaderReal.Cancel()
McLaunchLog("已取消启动")
Try
If McLaunchWatcher IsNot Nothing Then
McLaunchWatcher.Kill()
ElseIf McLaunchProcess IsNot Nothing Then
If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill()
End If
Catch ex As Exception
Logger.Error(ex, "取消启动结束进程失败", LogBehavior.Toast)
End Try
End If
End Sub
#End Region
#Region "内存优化"
@@ -249,7 +239,7 @@ NextInner:
'检查版本
If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
McInstanceSelected.Load()
If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题:" & McInstanceSelected.Info)
If McInstanceSelected.State = McInstance.McInstanceState.Error Then Throw New Exception("Minecraft 存在问题:" & McInstanceSelected.Info)
'检查输入信息
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
@@ -557,7 +547,7 @@ NextInner:
'检查是否已经登录完成
Dim ExpiresAt = Settings.Get(Of Long)("CacheMsV2Expires")
If Not Data.IsForceRestarting AndAlso '不要求强行重启
ExpiresAt > 0 AndAlso ExpiresAt > GetUnixTimestampUtc() AndAlso 'AccessToken 尚未过期
ExpiresAt > 0 AndAlso ExpiresAt > ToUnixTimestampUtc(Date.UtcNow) AndAlso 'AccessToken 尚未过期
Input.UserName = Settings.Get(Of String)("CacheMsV2Name") Then
Data.Output = New McLoginResult With {
.Name = Input.UserName, .Type = "Microsoft",
@@ -1052,7 +1042,7 @@ Retry:
Dim ResultJson As JObject = Result.DeserializeJson()
Return (
ResultJson("access_token").ToString,
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 3600) '提前 1 小时视作过期
End Function
'微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
Private Sub MsLoginStep5(AccessToken As String)
@@ -1382,16 +1372,11 @@ NextInstance:
'Log4j 漏洞防御参数
Args.Add("-Dlog4j2.formatMsgNoLookups=true")
'编码(#4700、#5892、#5909、#6934、#8950)
Dim EncodingName As String
Select Case McLaunchJavaSelected.Version.Major
Case Is >= 21 'Java 21+ 会固定使用 UTF-8
EncodingName = "UTF-8"
Case Is >= 18 'Java 18~20 时,启动 MC 时会添加 COMPAT 参数,因此 Java 会回退到 native.encoding
EncodingName = McLaunchJavaSelected.NativeEncodingName
Case Else 'Java 17- 时,直接使用 file.encoding
EncodingName = McLaunchJavaSelected.FileEncodingName
End Select
'编码(#4700、#5892、#5909、#6934、#8950、#9241)
Dim UseCompatEncoding = McLaunchJavaSelected.Version.Major >= 18
Dim EncodingName = If(UseCompatEncoding,
McLaunchJavaSelected.NativeEncodingName, 'Java 18+ 会添加 COMPAT,因此 Java 会回退到 native.encoding
McLaunchJavaSelected.FileEncodingName) 'Java 17- 直接使用 file.encoding
Try
McLaunchEncoding = Encoding.GetEncoding(If(EncodingName.Equals("GBK", StringComparison.OrdinalIgnoreCase), "GB18030", EncodingName))
Catch ex As Exception
@@ -1405,7 +1390,7 @@ NextInstance:
Dim StderrArgName = If(McLaunchJavaSelected.Version.Major < 19, "sun.stderr.encoding", "stderr.encoding")
If Not Args.Any(Function(a) a.StartsWithF($"-D{StdoutArgName}=")) Then Args.Add($"-D{StdoutArgName}={LaunchEncodingName}")
If Not Args.Any(Function(a) a.StartsWithF($"-D{StderrArgName}=")) Then Args.Add($"-D{StderrArgName}={LaunchEncodingName}")
If McLaunchJavaSelected.Version.Major >= 18 AndAlso McLaunchJavaSelected.Version.Major < 21 Then Args.Add("-Dfile.encoding=COMPAT") '使用 COMPAT 防止部分 Mod 配置文件不兼容 UTF-8
If UseCompatEncoding AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") '防止老版本 MC 与部分 Mod 不兼容 UTF-8
'为 JLW 添加 -jar,它必须放在最后
If UseJLW Then
@@ -1465,7 +1450,8 @@ NextInstance:
Arg &= " " & CustomArg
'把 OptiFineForgeTweaker 放在参数的末尾
If (McInstanceSelected.Version.HasForge OrElse McInstanceSelected.Version.HasLiteLoader) AndAlso McInstanceSelected.Version.HasOptiFine Then
If (McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.Forge) OrElse McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.LiteLoader)) AndAlso
McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.OptiFineAsMod Then
If Arg.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
McLaunchLog("发现正确的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
@@ -1520,10 +1506,10 @@ NextInstance:
Private Iterator Function McLaunchArgumentsReplace(Arguments As List(Of String)) As IEnumerable(Of (Key As String, Value As String))
'基础参数
Yield ("${classpath_separator}", ";")
Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
Yield ("${natives_directory}", PathUtils.RemoveSlashSuffix(GetNativesFolder()))
Yield ("${library_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
Yield ("${libraries_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
Yield ("${pure_directory}", PathPure.Value.TrimEnd("\"c)) '由 PCL 添加,这会允许在分割参数并去重后再替换路径,防止路径中的特殊字符影响参数分割和去重
Yield ("${pure_directory}", PathUtils.RemoveSlashSuffix(PathPure.Value)) '由 PCL 添加,这会允许在分割参数并去重后再替换路径,防止路径中的特殊字符影响参数分割和去重
Yield ("${launcher_name}", "PCL")
Yield ("${launcher_version}", VersionCode)
Yield ("${version_name}", McInstanceSelected.Name)
@@ -1568,9 +1554,8 @@ NextInstance:
Case Else
TargetSize = New Size(854, 480)
End Select
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍(#3463)
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.Forge) Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍(#3463)
McLaunchLog($"已应用窗口大小过大修复(Java 版本:{McLaunchJavaSelected.Version})")
TargetSize.Width /= DPI / 96
TargetSize.Height /= DPI / 96
@@ -1694,7 +1679,7 @@ NextInstance:
End Try
For Each Entry In Zip.Entries
Dim FileName As String = Entry.FullName
If FileName.EndsWithF(".dll", True) Then
If PathUtils.GetExtension(FileName) = "dll" Then
'实际解压文件的步骤
Dim FilePath As String = Target & FileName
ExistFiles.Add(FilePath)
@@ -1738,8 +1723,9 @@ NextInstance:
''' <summary>
''' 获取 Natives 文件夹路径,以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
Public Function GetNativesFolder(Optional Instance As McInstance = Nothing) As String
If Instance Is Nothing Then Instance = McInstanceSelected
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(Instance.PathVersion)) & Instance.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
Result = Paths.AppData & ".minecraft\bin\natives\"
If Not Result.IsAsciiOnly() Then
@@ -1865,7 +1851,7 @@ NextInstance:
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not DirectoryUtils.Exists(McInstanceSelected.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Settings.Get(Of Boolean)("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.Lower)
If Not McInstanceSelected.Version.Vaild OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
If Not McInstanceSelected.Version.Valid OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
'将最后两位改为大写,前面的部分保留
RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).Upper
End If
@@ -1908,53 +1894,40 @@ NextInstance:
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
Select Case McInstanceSelected.Version.Vanilla.Major
Case 0, 1, 2, 3, 4, 5
'更早的版本没有资源包
McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
GoTo IgnoreCustomSkin
Case 6, 7, 8
PackFormat = 1
Case 9, 10
PackFormat = 2
Case 11, 12
PackFormat = 3
Case 13, 14
PackFormat = 4
Case 15
PackFormat = 5
Case 16
PackFormat = 6
Case 17
PackFormat = 7
Case 18
If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
PackFormat = 8
Else
PackFormat = 9
End If
Case 19
If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
PackFormat = 9
Else
PackFormat = 12
End If
Case 20
If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
PackFormat = 15
Else
PackFormat = 17
End If
Case Else '快照版是 9999
PackFormat = 17
'https://zh.minecraft.wiki/w/数据包#数据包版本
End Select
McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
If McInstanceSelected.Version.Vanilla.Major < 6 Then
McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
GoTo IgnoreCustomSkin
End If
Dim PackVersionJToken As JToken = McInstanceSelected.JsonVersion?("pack_version")
If TypeOf PackVersionJToken Is JObject Then PackVersionJToken = DirectCast(PackVersionJToken, JObject)("resource") '从 1.17 开始,可以从 pack_version.resource 获取资源包版本
Dim PackVersion As Integer = Val(PackVersionJToken?.ToString)
If PackVersion <= 0 Then '没有对应字段的老版本 MC,或兜底
Select Case McInstanceSelected.Version.Vanilla.Major
Case 6, 7, 8
PackVersion = 1
Case 9, 10
PackVersion = 2
Case 11, 12
PackVersion = 3
Case 13, 14
PackVersion = 4
Case 15
PackVersion = 5
Case 16
PackVersion = If(McInstanceSelected.Version.Vanilla.Build <= 1, 5, 6)
Case 17
PackVersion = 7
Case 18
PackVersion = 8
Case Else '旧版快照可能没有可用的资源包格式声明
PackVersion = 17
End Select
End If
McLaunchLog($"正在构建自定义皮肤资源包,版本号 {PackVersion},MC 版本 {McInstanceSelected.Version.Vanilla}")
'准备文件
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackVersion & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(Paths.AppDataThenName & "CustomSkin.png")
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
File diff suppressed because it is too large Load Diff
@@ -74,7 +74,7 @@ Public Module ModModpack
Catch ex As Exception
If ex.GetDisplay(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then
ElseIf PathUtils.GetExtension(File) = "rar" Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
Else
Throw New Exception("打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", ex)
@@ -119,8 +119,8 @@ Public Module ModModpack
''' 对路径末尾是否为 \ 没有要求。
''' </summary>
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase)
If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\"
If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\"
OverridesFolder = PathUtils.AddSlashSuffix(OverridesFolder)
VersionFolder = PathUtils.AddSlashSuffix(VersionFolder)
'复制文件
If DirectoryUtils.Exists(OverridesFolder) Then
Logger.Info($"处理整合包覆写文件夹:{OverridesFolder} → {VersionFolder}")
@@ -174,25 +174,25 @@ Public Module ModModpack
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
Dim VersionFolder As String = PathUtils.AddSlashSuffix(Path.Combine(McFolderSelected, "versions", InstanceName) & "\")
'获取 Mod API 版本信息
Dim TargetVersion As New McVersion
TargetVersion.VanillaName = Json("minecraft")("version").ToString
Dim TargetVersion As New McVersion(Json("minecraft")("version").ToString)
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
Logger.Info($"整合包 Forge 版本:{Id}")
TargetVersion.Forge = Id.Replace("forge-", "")
TargetVersion.ModLoaderVersions(ModLoaders.Forge) = Id.Replace("forge-", "")
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Logger.Info($"整合包 NeoForge 版本:{Id}")
TargetVersion.NeoForge = Id.Replace("neoforge-", "")
TargetVersion.ModLoaderVersions(ModLoaders.NeoForge) = Id.Replace("neoforge-", "")
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Logger.Info($"整合包 Fabric 版本:{Id}")
TargetVersion.Fabric = Id.Replace("fabric-", "")
TargetVersion.ModLoaderVersions(ModLoaders.Fabric) = Id.Replace("fabric-", "")
Else
NotifyIncompatibleLoader(Id)
End If
@@ -202,12 +202,12 @@ Public Module ModModpack
Dim InstallLoaders As New List(Of LoaderBase)
Dim OverrideHome As String = If(Json("overrides"), "")
If OverrideHome <> "" Then
Dim OverridesFolder As String = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
If Not PathUtils.IsParentOf(InstallTemp, OverridesFolder) Then Throw New Exception("整合包的 overrides 路径超出了解压目录,请向整合包作者反馈此问题!")
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{McFolderSelected}versions\{InstanceName}", Task)
CopyOverrideDirectory(OverridesFolder, VersionFolder, Task)
End Sub) With {
.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End If
@@ -293,7 +293,7 @@ Public Module ModModpack
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
If Not File.DownloadAvailable Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\",
FileList.Add(Id, File.ToNetFile(PathUtils.AddSlashSuffix(Path.Combine(VersionFolder, TargetFolder)),
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders))
Task.Progress += 1 / (1 + ModList.Count)
Next
@@ -307,15 +307,9 @@ Public Module ModModpack
End If
'构造加载器
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
Dim Target As New McComponents(TargetVersion.VanillaName, TargetVersion.ModLoaderVersions)
Dim MergeLoaders = McInstallLoadersGet(New McInstallRequest With {
.NewInstanceName = InstanceName, .InstanceFolder = VersionFolder, .Components = Target})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
@@ -323,7 +317,6 @@ Public Module ModModpack
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -337,10 +330,10 @@ Public Module ModModpack
FileUtils.Delete(MapFile)
Next
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件:{Target}")
FileUtils.Delete(Target)
For Each FileToDelete As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If FileUtils.Exists(FileToDelete) Then
Logger.Info($"删除原始整合包文件:{FileToDelete}")
FileUtils.Delete(FileToDelete)
End If
Next
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
@@ -358,7 +351,7 @@ Public Module ModModpack
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.VersionFolder)
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
Return Loader
@@ -376,20 +369,21 @@ Public Module ModModpack
End Try
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息
Dim TargetVersion As New McVersion
'TODO: 改为使用类似 InstallPackMMC 中,一个版本名一个字典的方式来存储它,不要用 Unknown
Dim TargetVersion As New McVersion("Unknown")
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.Lower
Case "minecraft"
TargetVersion.VanillaName = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
TargetVersion.Forge = Entry.Value.ToString
Logger.Info($"整合包 Forge 版本:{TargetVersion.Forge}")
TargetVersion.ModLoaderVersions(ModLoaders.Forge) = Entry.Value.ToString
Logger.Info($"整合包 Forge 版本:{TargetVersion.ModLoaderVersions(ModLoaders.Forge)}")
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
TargetVersion.NeoForge = Entry.Value.ToString
Logger.Info($"整合包 NeoForge 版本:{TargetVersion.NeoForge}")
TargetVersion.ModLoaderVersions(ModLoaders.NeoForge) = Entry.Value.ToString
Logger.Info($"整合包 NeoForge 版本:{TargetVersion.ModLoaderVersions(ModLoaders.NeoForge)}")
Case "fabric-loader" 'eg. 0.14.14
TargetVersion.Fabric = Entry.Value.ToString
Logger.Info($"整合包 Fabric 版本:{TargetVersion.Fabric}")
TargetVersion.ModLoaderVersions(ModLoaders.Fabric) = Entry.Value.ToString
Logger.Info($"整合包 Fabric 版本:{TargetVersion.ModLoaderVersions(ModLoaders.Fabric)}")
Case Else
NotifyIncompatibleLoader(Entry.Name)
End Select
@@ -402,18 +396,15 @@ Public Module ModModpack
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
Dim VersionFolder As String = Path.Combine(McFolderSelected, "versions", InstanceName) & "\"
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.5))
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(InstallTemp & ArchiveBaseFolder & "overrides", VersionFolder, Task)
CopyOverrideDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", VersionFolder, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
@@ -436,8 +427,8 @@ Public Module ModModpack
Urls = ResourceVersion.ParseModrinthTrackArguments(Urls,
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders).ToList 'Modrinth 来源追踪信息
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = Path.Combine(McFolderSelected, "versions", InstanceName, File("path").ToString().TrimStart(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar))
If Not PathUtils.IsParentOf($"{McFolderSelected}versions\{InstanceName}\", TargetPath) Then
Dim TargetPath As String = Path.Combine(VersionFolder, File("path").ToString().TrimStart(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar))
If Not PathUtils.IsParentOf(VersionFolder, TargetPath) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!{vbCrLf}目标:{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件:{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New OperationCanceledException
End If
@@ -449,15 +440,10 @@ Public Module ModModpack
End If
'构造加载器
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
Dim Target As New McComponents(TargetVersion.VanillaName, TargetVersion.ModLoaderVersions)
Dim MergeLoaders = McInstallLoadersGet(New McInstallRequest With {
.NewInstanceName = InstanceName, .InstanceFolder = VersionFolder,
.Components = Target})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
@@ -465,7 +451,6 @@ Public Module ModModpack
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -473,10 +458,10 @@ Public Module ModModpack
Logger.Info($"已设置整合包 Logo:{Logo}")
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件:{Target}")
FileUtils.Delete(Target)
For Each FileToDelete As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If FileUtils.Exists(FileToDelete) Then
Logger.Info($"删除原始整合包文件:{FileToDelete}")
FileUtils.Delete(FileToDelete)
End If
Next
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
@@ -494,7 +479,7 @@ Public Module ModModpack
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.VersionFolder)
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
Return Loader
@@ -515,24 +500,21 @@ Public Module ModModpack
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
Dim VersionFolder As String = Path.Combine(McFolderSelected, "versions", InstanceName) & "\"
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", VersionFolder, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
Dim Target As New McComponents(Json("gameVersion").ToString, New Dictionary(Of ModLoaders, String))
Dim MergeLoaders = McInstallLoadersGet(New McInstallRequest With {
.NewInstanceName = InstanceName, .InstanceFolder = VersionFolder,
.Components = Target})
'构造总加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
@@ -546,7 +528,7 @@ Public Module ModModpack
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.VersionFolder)
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
Return Loader
@@ -568,16 +550,22 @@ Public Module ModModpack
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
Dim VersionFolder As String = Path.Combine(McFolderSelected, "versions", InstanceName) & "\"
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim SetupFile As String = VersionFolder & "PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.55))
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
McFolderSelected & "versions\" & InstanceName, Task)
'Prism 优先使用 minecraft/ 而非 .minecraft/(#9272)
Dim MmcGameRoot As String
If DirectoryUtils.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") AndAlso Not DirectoryUtils.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
MmcGameRoot = InstallTemp & ArchiveBaseFolder & ".minecraft"
Else
MmcGameRoot = InstallTemp & ArchiveBaseFolder & "minecraft"
End If
CopyOverrideDirectory(MmcGameRoot, VersionFolder, Task)
'读取 MMC 设置文件(#2655)
Try
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
@@ -611,7 +599,7 @@ Public Module ModModpack
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", VersionFolder & "PCL\Logo.png")
Logger.Info($"迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If
'JVM 参数
@@ -633,19 +621,20 @@ Public Module ModModpack
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
Dim MinecraftVersion As String = Nothing
Dim ModLoaderVersions As New Dictionary(Of ModLoaders, String)
For Each Component As JObject In PackJson("components")
If Not Component.ContainsKey("uid") Then Continue For
Dim UID As String = Component("uid").ToString
Select Case UID
Case "net.minecraft"
Request.MinecraftName = Component("version")
MinecraftVersion = Component("version")
Case "net.minecraftforge"
Request.ForgeVersion = Component("version")
ModLoaderVersions(ModLoaders.Forge) = Component("version")
Case "net.neoforged"
Request.NeoForgeVersion = Component("version")
ModLoaderVersions(ModLoaders.NeoForge) = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
ModLoaderVersions(ModLoaders.Fabric) = Component("version")
Case Else
If UID.StartsWithF("org.lwjgl") Then '#8210
Logger.Info($"已跳过 LWJGL 项:{UID}")
@@ -655,7 +644,10 @@ Public Module ModModpack
End Select
Next
'构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
Dim Target As New McComponents(MinecraftVersion, ModLoaderVersions)
Dim MergeLoaders = McInstallLoadersGet(New McInstallRequest With {
.NewInstanceName = InstanceName, .InstanceFolder = VersionFolder,
.Components = Target})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
@@ -670,7 +662,7 @@ Public Module ModModpack
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.VersionFolder)
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
Return Loader
@@ -695,16 +687,15 @@ Public Module ModModpack
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
Dim VersionFolder As String = Path.Combine(McFolderSelected, "versions", InstanceName) & "\"
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim SetupFile As String = VersionFolder & "PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(InstallTemp & ArchiveBaseFolder & "overrides", VersionFolder, Task)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
Dim LaunchInfo As JObject = Json("launchInfo")
@@ -723,16 +714,26 @@ Public Module ModModpack
Hint("PCL 不支持安装 Quilt 整合包!", HintType.Red)
Throw New OperationCanceledException
End If
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.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)
Dim ModLoaderVersions As New Dictionary(Of ModLoaders, String)
If Addons.ContainsKey("forge") Then ModLoaderVersions(ModLoaders.Forge) = Addons("forge")
If Addons.ContainsKey("neoforge") Then ModLoaderVersions(ModLoaders.NeoForge) = Addons("neoforge")
If Addons.ContainsKey("fabric") Then ModLoaderVersions(ModLoaders.Fabric) = Addons("fabric")
Dim OptiFineEntry As JObject = Nothing
If Addons.ContainsKey("optifine") Then
Dim MinecraftVersion = Addons("game")
If MinecraftVersion.EndsWithF(".0") Then MinecraftVersion = MinecraftVersion.Substring(0, MinecraftVersion.Length - 2)
Dim OptiFineFileSuffix = "_HD_" & Addons("optifine").AfterLast("HD_") & ".jar"
'从镜像源拉取 OptiFine 列表
If DlOptiFineListBmclapiLoader.State <> LoadState.Finished Then DlOptiFineListBmclapiLoader.WaitForExit()
Dim Entry = DlOptiFineListBmclapiLoader.Output.Value.FirstOrDefault(
Function(v) v.Inherit = MinecraftVersion AndAlso v.FileName.EndsWithF(OptiFineFileSuffix))
If Entry Is Nothing Then Throw New Exception($"OptiFine 列表中没有整合包所需的 OptiFine {Addons("optifine")}(Minecraft {Addons("game")})")
OptiFineEntry = JObject.FromObject(Entry)
End If
Dim Target As New McComponents(Addons("game"), ModLoaderVersions, OptiFineEntry)
Dim MergeLoaders = McInstallLoadersGet(New McInstallRequest With {
.NewInstanceName = InstanceName, .InstanceFolder = VersionFolder,
.Components = Target})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
@@ -748,7 +749,7 @@ Public Module ModModpack
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
Loader.Start(Request.VersionFolder)
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
Return Loader
@@ -319,6 +319,8 @@ Public Module ModWatcher
GetClassName(hwnd, str, str.Capacity)
Dim ClassName As String = str.ToString
If Not (ClassName = "GLFW30" OrElse ClassName = "SDL_app" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
'SDL 会先创建隐藏窗口,待初始化完成后才显示(#9073)
If ClassName = "SDL_app" AndAlso Not IsWindowVisible(hwnd) Then Return
'获取窗口标题名
str = New StringBuilder(512)
GetWindowText(hwnd, str, str.Capacity)
@@ -347,6 +349,7 @@ Public Module ModWatcher
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (hWnd As Integer, str As String) As Boolean
Private Declare Function ShowWindow Lib "user32" (hWnd As IntPtr, cmdWindow As UInteger) As Boolean
Private Declare Function IsWindowVisible Lib "user32" (hWnd As IntPtr) As Boolean
Private Declare Function GetWindowThreadProcessId Lib "user32" (hWnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
'崩溃处理
+27 -10
View File
@@ -1,6 +1,9 @@
#Region "附加属性"
Imports PCL.FormMain
''' <summary>
''' 用于在 XAML 中初始化列表对象。
''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象,因此需要一个包装类,然后在 XAML 中显式初始化。
@@ -272,9 +275,23 @@ Public Class CustomEvent
Hint(Arg0.Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Arg1)))
Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange(
EnumUtils.FromString(Of FormMain.PageType)(Arg0),
If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Arg1))))
RunInUi(
Sub()
Dim TargetPage = EnumUtils.FromString(Of PageType)(Arg0)
If TargetPage = PageType.InstanceSetup Then
If McInstanceSelected Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Red)
Return
End If
If McInstanceLock.IsLocked(McInstanceSelected) Then
Hint("该版本正在被修改,暂时无法进入版本设置!", HintType.Red)
Return
End If
PageInstanceLeft.Instance = McInstanceSelected
End If
FrmMain.PageChange(TargetPage,
If(Args.Length = 1, PageSubType.Default, EnumUtils.FromString(Of PageSubType)(Arg1)))
End Sub)
Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall())
@@ -295,7 +312,7 @@ Public Class CustomEvent
Case 2
PageOtherTest.StartCustomDownload(Arg0, Arg1)
Case Else
PageOtherTest.StartCustomDownload(Arg0, Arg(1), Args(2))
PageOtherTest.StartCustomDownload(Arg0, Args(1), Args(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Arg0, "未知")
@@ -304,16 +321,16 @@ Public Class CustomEvent
Case EventType.修改设置, EventType.写入设置
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
Settings.SetSafe(Arg0, Arg1, Instance:=McInstanceSelected)
If Args.Length = 2 Then Hint($"已写入设置:{Arg0} → {Arg1}", HintType.Green)
Settings.SetSafe(Arg0, Args(1), Instance:=McInstanceSelected)
If Args.Length = 2 Then Hint($"已写入设置:{Arg0} → {Args(1)}", HintType.Green)
Case EventType.修改变量, EventType.写入变量
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
Try
RegistryUtils.Write($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{Arg0}", Arg1)
If Args.Length = 2 Then Hint($"已写入变量:{Arg0} → {Arg1}", HintType.Green)
RegistryUtils.Write($"HKEY_CURRENT_USER\Software\{RegFolder}", $"CustomEvent{Arg0}", Args(1))
If Args.Length = 2 Then Hint($"已写入变量:{Arg0} → {Args(1)}", HintType.Green)
Catch ex As Exception
Logger.Warn(ex, $"写入变量失败:{Arg0} → {Arg1}", LogBehavior.Toast)
Logger.Warn(ex, $"写入变量失败:{Arg0} → {Args(1)}", LogBehavior.Toast)
End Try
Case EventType.加入房间
@@ -353,7 +370,7 @@ Public Class CustomEvent
Dim RawFileName As String
Try
RawFileName = PathUtils.GetLastPart(RelativeUrl)
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
If Not PathUtils.GetExtension(RawFileName) = "json" Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
"例如:" & vbCrLf &
+8 -7
View File
@@ -414,6 +414,7 @@ EndHint:
Public FrmInstanceModDisabled As PageInstanceModDisabled
Public FrmInstanceSetup As PageInstanceSetup
Public FrmInstanceExport As PageInstanceExport
Public FrmDownloadModify As PageDownloadModify
'资源信息分页声明
Public FrmDownloadResourceDetail As PageDownloadResourceDetail
@@ -510,7 +511,7 @@ EndHint:
EventData = If(JsonData("EventData"), "")
IsEvent = True
Else
Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
Dim XamlAddress As String = Path.ChangeExtension(FilePath, ".xaml")
If FileUtils.Exists(XamlAddress) Then
XamlContent = FileUtils.ReadAsString(XamlAddress)
IsEvent = False
@@ -596,9 +597,9 @@ EndHint:
'读取自带文件
For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
'跳过非 json 文件与以 . 开头的文件夹
If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
If PathUtils.RemoveLastPart(File).Substring((PathTemp & "Help").Length).Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
'检查忽略列表
Dim RealPath As String = File.Replace(PathTemp & "Help\", "")
Dim RealPath As String = File.Substring((PathTemp & "Help\").Length)
For Each Ignore In IgnoreList
If RealPath.RegexCheck(Ignore) Then
Logger.Trace($"已忽略 {RealPath}:{Ignore}")
@@ -857,10 +858,10 @@ NextFile:
Else
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
End If
Text = Text.Replace("{forge}", Replacer(If(McInstanceSelected.Version.HasForge, McInstanceSelected.Version.Forge, "")))
Text = Text.Replace("{fabric}", Replacer(If(McInstanceSelected.Version.HasFabric, McInstanceSelected.Version.Fabric, "")))
Text = Text.Replace("{neoforge}", Replacer(If(McInstanceSelected.Version.HasNeoForge, McInstanceSelected.Version.NeoForge, "")))
Text = Text.Replace("{liteloader}", Replacer(If(McInstanceSelected.Version.HasLiteLoader, "true", "")))
Text = Text.Replace("{forge}", Replacer(If(McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.Forge), McInstanceSelected.Version.ModLoaderVersions(ModLoaders.Forge), "")))
Text = Text.Replace("{fabric}", Replacer(If(McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.Fabric), McInstanceSelected.Version.ModLoaderVersions(ModLoaders.Fabric), "")))
Text = Text.Replace("{neoforge}", Replacer(If(McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.NeoForge), McInstanceSelected.Version.ModLoaderVersions(ModLoaders.NeoForge), "")))
Text = Text.Replace("{liteloader}", Replacer(If(McInstanceSelected.Version.ModLoaders.HasFlagF(ModLoaders.LiteLoader), "true", "")))
Else
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
+1 -1
View File
@@ -320,7 +320,7 @@ Public Module ModMusic
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Red)
Thread.Sleep(1000000000)
End If
If Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
If Not ({"wav", "mp3", "flac"}.Contains(PathUtils.GetExtension(MusicCurrent))) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & PathUtils.GetLastPart(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else
@@ -25,7 +25,7 @@ Public Class LocalResourceFile
End Get
End Property
''' <summary>
''' 假若该资源未被禁用时,文件的文件名。
''' 假若该资源未被禁用时,文件的文件名。包含 .jar/.litemod 等后缀。
''' </summary>
Public ReadOnly Property EnabledName As String
Get
@@ -57,7 +57,7 @@ Public Class LocalResourceFile
Public Property Display As String
Get
If _Display Is Nothing Then _Display = ProjectVersion?.Display
If _Display Is Nothing Then _Display = PathUtils.GetFileNameWithoutExtension(File.FullName)
If _Display Is Nothing Then _Display = PathUtils.GetFileNameWithoutExtension(EnabledName)
Return _Display
End Get
Set(value As String)
@@ -238,7 +238,7 @@ Public Class LocalResourceFile
Private _CurseForgeHash As UInteger?
''' <summary>
''' 获取用于 Modrinth 信息获取的 Hash 值(SHA1)。
''' 获取用于 Modrinth 信息获取的 Hash 值(SHA1)。固定为小写。
''' </summary>
Public ReadOnly Property ModrinthHash As String
Get
@@ -269,7 +269,7 @@ Public Class LocalResourceFile
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim Target = TryCast(obj, LocalResourceFile)
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
Return Target IsNot Nothing AndAlso PathUtils.IsSame(File.FullName, Target.File.FullName)
End Function
#End Region
@@ -24,11 +24,10 @@ Public Module LocalResourceLoaders
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of String)
If DirectoryUtils.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower
For Each File In DirectoryUtils.EnumerateFiles(Loader.Input, True)
If File.BeforeLast("\").Lower & "\" <> RawName Then
If Not PathUtils.IsSame(PathUtils.RemoveLastPart(File), Loader.Input) Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.ModLoaders.HasFlagF(ModLoaders.Forge) AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
PathUtils.GetLastPart(PathUtils.RemoveLastPart(File)) = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For
@@ -36,12 +35,9 @@ Public Module LocalResourceLoaders
End If
Static IsModFile As Func(Of String, Boolean) =
Function(FullName As String)
If FullName Is Nothing OrElse Not FullName.Contains(".") Then Return False
FullName = FullName.Lower
If FullName.EndsWithF(".jar", True) OrElse FullName.EndsWithF(".zip", True) OrElse FullName.EndsWithF(".litemod", True) OrElse
FullName.EndsWithF(".jar.disabled", True) OrElse FullName.EndsWithF(".zip.disabled", True) OrElse FullName.EndsWithF(".litemod.disabled", True) OrElse
FullName.EndsWithF(".jar.old", True) OrElse FullName.EndsWithF(".zip.old", True) OrElse FullName.EndsWithF(".litemod.old", True) Then Return True
Return False
If FullName Is Nothing Then Return False
If {"disabled", "old"}.Contains(PathUtils.GetExtension(FullName)) Then FullName = PathUtils.GetFileNameWithoutExtension(FullName)
Return {"jar", "zip", "litemod"}.Contains(PathUtils.GetExtension(FullName))
End Function
If IsModFile(File) Then ModFileList.Add(File)
Next
@@ -271,7 +267,7 @@ Public Module LocalResourceLoaders
Dim EntryVersion As String = Entry("gameVersion")
Return EntryVersion IsNot Nothing AndAlso EntryVersion = VanillaVersion
End Function).
MaxByAll(Function(Entry) Entry("gameVersion").ToString, New VersionComparer) '只保留最新的 MC 版本
MaxByAll(Function(Entry) Entry("gameVersion").ToString, Comparer(Of String).Create(Function(x, y) McUtils.CompareVersion(x, y))) '只保留最新的 MC 版本
For Each Entry In LatestFiles
Dim FileId = Entry("fileId").ToObject(Of Integer)
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of LocalResourceFile)
@@ -184,11 +184,11 @@ Public Class ResourceProject
If Not NewFile.DownloadAvailable Then Continue For
ModLoaders = ModLoaders Or NewFile.ModLoaders
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
If Not GameVersions.Any(Function(v) McVersion.IsStandardFormat(v)) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
If Not McVersion.IsStandardFormat(File("gameVersion")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
@@ -99,12 +99,12 @@ Public Class ResourceSearcher
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & StringUtils.UrlEscape(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
'facets=[["categories:'game-mechanics'"],["categories:forge","categories:fabric"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
Facets.Add($"[""categories:'{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("',categories:'")}'""]")
Facets.Add($"[""categories:{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join(""",""categories:")}""]")
End If
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
@@ -378,21 +378,19 @@ NextPage:
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlagF(Request.Type) Then Continue For
If Not String.IsNullOrEmpty(Request.Tag) AndAlso
Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了,只能从 json 判
If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
ProjectList.Add(Project)
Next
Dim Facets As New List(Of String)
If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
Facets.Add($"[""categories:'{Request.ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("'"",""categories:'")}'""]")
End If
If Not String.IsNullOrEmpty(Request.GameVersion) Then Facets.Add($"[""versions:'{Request.GameVersion}'""]")
If ProjectList.Any AndAlso Facets.Any Then
Facets.Add("[""project_id:" & ProjectList.Select(Function(p) p.Id).Join(""",""project_id:") & """]")
Dim FilterUrl As String = $"https://api.modrinth.com/v2/search?limit={Math.Min(ProjectList.Count, 100)}&facets=[" & String.Join(",", Facets) & "]"
Logger.Info($"开始 Modrinth 直接获取筛选:{FilterUrl}")
Dim MatchedIds As New List(Of String)
For Each JsonEntry As JObject In DlModRequest(FilterUrl)("hits")
MatchedIds.Add(JsonEntry("project_id").ToString)
Next
If ProjectList.Any AndAlso Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
Not String.IsNullOrEmpty(Request.GameVersion) Then
Dim ProjectIds = ProjectList.Select(Function(p) p.Id).Join(""",""project_id:")
Dim Loaders = Request.ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join(""",""categories:")
Dim FilterUrl = $"https://api.modrinth.com/v2/search?limit={ProjectList.Count}&facets=" &
$"[[""project_id:{ProjectIds}""],[""categories:{Loaders}""],[""versions:{Request.GameVersion}""]]"
Dim MatchedIds = DlModRequest(FilterUrl)("hits").Select(Function(h) h("project_id").ToString).ToList
ProjectList.KeepIf(Function(p) MatchedIds.Contains(p.Id))
End If
'更新结果
@@ -90,7 +90,7 @@ Public Class ResourceVersion
''' </summary>
Public DownloadUrls As List(Of String)
''' <summary>
''' 对应文件的 SHA1 或 MD5。
''' 对应文件的 SHA1 或 MD5。固定为小写。
''' </summary>
Public Hash As String = Nothing
''' <summary>
@@ -127,8 +127,9 @@ Public Class ResourceVersion
.DownloadCount = Data("downloadCount")
.FileName = Data("fileName")
.Size = Data("fileLength")
.Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
If .Hash Is Nothing Then .Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
If .Size = 0 Then .Size = -1 'CurseForge 可能错误地返回 0 尺寸(#9104)
.Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")?.ToString().Lower()
If .Hash Is Nothing Then .Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")?.ToString().Lower()
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
@@ -145,13 +146,13 @@ Public Class ResourceVersion
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.Lower).ToList
.GameVersions = RawVersions.
Where(Function(v) McVersion.IsFormatFit(v)).
Where(Function(v) McVersion.IsStandardFormat(v)).
Select(Function(v) v.Replace("-snapshot", " 预览版")).
Distinct.ToList
If .GameVersions.IsSingle Then
.GameVersions = .GameVersions.ToList
ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
.GameVersions = .GameVersions.SortByComparison(AddressOf McUtils.CompareVersionGE).ToList
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = { .GameVersions(0)}.ToList '整合包理应只 “支持” 一个版本
Else
.GameVersions = New List(Of String) From {"未知版本"}
@@ -176,7 +177,7 @@ Public Class ResourceVersion
.FileName = File("filename")
.DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
.Size = File("size")
.Hash = File("hashes")("sha1")
.Hash = File("hashes")("sha1")?.ToString.Lower()
End If
'类别与 Loaders
'结果可能混杂着 Mod、数据包和服务端插件
@@ -208,7 +209,7 @@ Public Class ResourceVersion
If .GameVersions.IsSingle Then
'无需处理
ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
.GameVersions = .GameVersions.SortByComparison(AddressOf McUtils.CompareVersionGE).ToList
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = New List(Of String) From { .GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf RawVersions.Any(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")) Then
.GameVersions = RawVersions.Where(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")).ToList
@@ -355,7 +356,7 @@ Public Class ResourceVersion
.Info =
Iterator Function()
If ModLoaders <> ModLoaders.None Then Yield ModLoaders.Flags.Join("、"c)
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
If .Title <> PathUtils.GetFileNameWithoutExtension(FileName) Then Yield PathUtils.GetFileNameWithoutExtension(FileName)
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount.ToString() + " ")}次" 'CurseForge 的下载次数经常错误地返回 0