This commit is contained in:
龙腾猫跃
2025-04-05 18:22:00 +08:00
parent 36cc718efb
commit 16e09c792c
21 changed files with 1718 additions and 682 deletions
+24 -8
View File
@@ -1,10 +1,11 @@
Imports System.Globalization
Imports System.IO.Compression
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports System.Windows.Markup
Imports System.Xaml
Imports Newtonsoft.Json
Public Module ModBase
@@ -12,13 +13,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.9.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.9.2." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.9.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.9.3." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 352 'Release
Public Const VersionCode As Integer = 355 'Release
#Else
Public Const VersionCode As Integer = 353 'Snapshot
Public Const VersionCode As Integer = 354 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1697,6 +1698,7 @@ RetryDir:
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分,裁切尽可能多的内容。
''' 等效于 AfterLast 后接 BeforeFirst。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
@@ -2747,13 +2749,27 @@ Retry:
''' <summary>
''' 将 XML 转换为对应 UI 对象。
''' </summary>
Public Function GetObjectFromXML(Str As String)
Using Stream As New MemoryStream
Public Function GetObjectFromXML(Str As String) As Object
Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
'类型检查
Using Reader As New XamlXmlReader(Stream)
While Reader.Read()
For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider)}
If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 类型。")
If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 值。")
Next
For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListMember} 成员。")
Next
End While
End Using
'实际的加载
Stream.Position = 0
Using Writer As New StreamWriter(Stream)
Writer.Write(Str)
Writer.Flush()
Stream.Position = 0
Return XamlReader.Load(Stream)
Return Markup.XamlReader.Load(Stream)
End Using
End Using
End Function
@@ -150,13 +150,13 @@ Public Class ValidateExcept
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String
Public Sub New()
ErrorMessage = "输入内容不能包含 %!"
ErrorMessage = "输入内容不能包含 %"
End Sub '用于 XAML 初始化
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %!")
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %!")
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = New ObjectModel.Collection(Of String)
Me.ErrorMessage = ErrorMessage
For Each Data As String In Excepts
@@ -185,12 +185,12 @@ Public Class ValidateExceptSame
Public Property IgnoreCase As Boolean = False
Public Sub New()
End Sub
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String)
For Each Data As String In Excepts
Me.Excepts.Add(Data)
@@ -563,8 +563,9 @@ Done:
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If
@@ -674,13 +674,14 @@ Wait:
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
'不应使用网易的 Java:https://github.com/Hex-Dragon/PCL2/issues/1279#issuecomment-2761489121
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.", "启动"}
"4297127d64ec6", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
@@ -220,21 +220,24 @@ NextInner:
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
RunInNewThread(
Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
"如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
Setup.Get("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
End Sub, "Donate")
If CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
RunInNewThread(
Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
"如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
Setup.Get("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
End Sub, "Donate")
End If
#End If
'正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If IsSystemLanguageChinese() Then
RunInNewThread(
Sub()
@@ -1347,6 +1350,12 @@ Retry:
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
McLaunchLog("新版 Game 参数获取成功")
End If
'编码参数(#5818、#5892)
If McLaunchJavaSelected.VersionCode > 8 Then
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments += " -Dfile.encoding=UTF-8"
If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments += " -Dstdout.encoding=UTF-8"
If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments += " -Dstderr.encoding=UTF-8"
End If
'替换参数
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1899,7 +1908,6 @@ NextVersion:
'1.6 ~ 10 :zh_CN 时正常,zh_cn 时自动切换为英文
'1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
IniClearCache(SetupFileAddress) '清除缓存(#2294)
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
@@ -207,53 +207,46 @@ Public Module ModMinecraft
''' </summary>
Public ReadOnly Property PathIndie As String
Get
Return GetPathIndie(Modable)
InitPathIndie(Modable)
Return If(Setup.Get("VersionArgumentIndieV2", Version:=Me), Path, PathMcFolder)
End Get
End Property
''' <summary>
''' 在不加载版本的情况下获取版本隔离目录。
''' 决定该版本是否应该被隔离。
''' </summary>
Public Function GetPathIndie(Modable As Boolean) As String
'决定版本隔离类型
If Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化({Name}):从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
End If
'若版本文件夹下包含 mods 或 saves 文件夹,则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
Log($"[Minecraft] 版本隔离初始化({Name}):版本文件夹下存在 mods 或 saves 文件夹,自动开启")
Public Sub InitPathIndie(Modable As Boolean)
If Not Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then Return
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化({Name}):从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
End If
'若版本文件夹下包含 mods 或 saves 文件夹,则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
Log($"[Minecraft] 版本隔离初始化({Name}):版本文件夹下存在 mods 或 saves 文件夹,自动开启")
Return True
End If
'根据全局的默认设置决定是否隔离
Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Setup.Get("LaunchArgumentIndieV2")})判断")
Select Case Setup.Get("LaunchArgumentIndieV2")
Case 0 '关闭
Return False
Case 1 '仅隔离可安装 Mod 的版本
Return Modable
Case 2 '仅隔离非正式版
Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case 3 '隔离非正式版与可安装 Mod 的版本
Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case Else '隔离所有版本
Return True
End If
'根据全局的默认设置决定是否隔离
Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Setup.Get("LaunchArgumentIndieV2")})判断")
Select Case Setup.Get("LaunchArgumentIndieV2")
Case 0 '关闭
Return False
Case 1 '仅隔离可安装 Mod 的版本
Return Modable
Case 2 '仅隔离非正式版
Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case 3 '隔离非正式版与可安装 Mod 的版本
Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case Else '隔离所有版本
Return True
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
End If
'根据隔离类型决定路径
If Setup.Get("VersionArgumentIndieV2", Version:=Me) Then
Return Path
Else
Return PathMcFolder
End If
End Function
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
End Sub
''' <summary>
''' 该版本的版本文件夹名称。
@@ -1081,7 +1074,7 @@ ExitDataLoad:
ElseIf Name = "24w14potato" Then
Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
ElseIf Name = "25w14craftmine" Then
Return "2025 | 扼杀创造力并不是一件好事,所以我们决定给你机会来创造一切!"
Return "2025 | 你可以合成任何东西——包括合成你的世界!"
Else
Return ""
End If
+16 -7
View File
@@ -873,17 +873,26 @@ NextFile:
End Sub
''' <summary>
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。
''' 这些文件夹无需进行后续清理。
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
''' 若所有缓存位置均没有权限,会抛出异常。
''' </summary>
''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
TryClearTaskTemp()
RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso RequestTaskTempFolder.Contains(" ") Then
RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
End If
Directory.CreateDirectory(RequestTaskTempFolder)
Dim ResultFolder As String
Try
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
Directory.CreateDirectory(ResultFolder)
CheckPermissionWithException(ResultFolder)
Return ResultFolder
Catch
End Try
'使用备用路径
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Directory.CreateDirectory(ResultFolder)
CheckPermission(ResultFolder)
Return ResultFolder
End Function
#End Region
+7 -1
View File
@@ -245,7 +245,12 @@
RunInThread(
Sub()
Log("[Music] 已恢复播放")
MusicNAudio?.Play()
Try
MusicNAudio?.Play()
Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223
MusicNAudio?.Stop()
MusicNAudio?.Play()
End Try
MusicRefreshUI()
End Sub)
Return True
@@ -273,6 +278,7 @@
'开始播放
CurrentWave = New NAudio.Wave.WaveOutEvent()
MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
CurrentWave.Init(Reader)
CurrentWave.Play()
@@ -1,7 +1,5 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net
Imports System.Reflection
Imports System.Security.Cryptography
Friend Module ModSecret